MediaMonkey forum

Code: Select all

Public Function URLEncode(sRawURL)
	logme "* URLEncode has started with parameters " & sRawURL
    Dim iLoop, sRtn, sTmp	
  Const sValidChars = "1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz\/&:"
  Dim url : url = Replace(sRawURL,"+","%2B")
  If UCase(Right(url,6)) = " (THE)" Then
    url = "The "&Left(url,Len(url)-6)
  End If
  If UCase(Right(url,5)) = ", THE" Then
    url = "The "&Left(url,Len(url)-5)
  End If  
  
  If Len(url) > 0 Then
    Dim i : i = 1
    Do While i < Len(url)+1
      Dim s : s = Mid(url,i,1)
      If InStr(1,sValidChars,s,0) = 0 Then
        Dim d : d = Asc(s)
        If d = 32 Or d > 2047 Then
          s = "+"
        Else
          If d < 128 Then
            s = DecToHex(d)
          Else
            s = DecToUtf(d)
          End If
        End If
      Else
        Select Case s
          Case "&"
            s = "%2526"
          Case "/"
            s = "%252F"
          Case "\"
            s = "%5C"
          Case ":"
            s = "%3A"
        End Select
      End If
      URLEncode = URLEncode&s
      i = i + 1
      SDB.ProcessMessages
    Loop
  End If
	
    logme "* URLEncode will return " & sRtn & " and exit"

End Function

Function HexToDec(h)
  HexToDec = 0
  Dim i : i = 0
  For i = Len(h) To 1 Step -1
    Dim d : d = Mid(h,i,1)
    d = Instr("0123456789ABCDEF",UCase(d))-1
    If d >= 0 Then
      HexToDec = HexToDec+(d*(16^(Len(h)-i)))
    Else
      HexToDec = 0
      Exit For
    End If
  Next
End Function

Function DecToBin(intDec)
  DecToBin = ""
  Dim d : d = intDec
  Dim e : e = 1024
  While e >= 1
    If d >= e Then
      d = d - e
      DecToBin = DecToBin&"1"
    Else
      DecToBin = DecToBin&"0"
    End If
    e = e / 2
  Wend
End Function

Function BinToHex(strBin)
  Dim d : d = 0
  Dim i : i = 0
  For i = Len(strBin) To 1 Step -1
    Select Case Mid(strBin,i,1)
      Case "0"
        'do nothing
      Case "1"
        d = d + (2^(Len(strBin)-i))
      Case Else
        BinToHex = "00"
        Exit Function
    End Select
  Next
  BinToHex = DecToHex(d)
End Function

Function DecToHex(d)
  If d < 16 Then
    DecToHex = "0%"&CStr(Hex(d))
  Else
    DecToHex = "%"&CStr(Hex(d))
  End If
End Function

Function DecToUtf(d)
  Dim b : b = DecToBin(d)
  Dim a : a = "110"&Left(b,5)
  b = "10"&Mid(b,6)
  DecToUtf = "%"&BinToHex(a)&"%"&BinToHex(b)
End Function

Code: Select all

            Do
                RNumber = Int(XDict.Count * Rnd)
                logme "ParseXML will now call NotTooSoon with parameters " & XDict.Item(RNumber)
                If Not NotTooSoon(XDict.Item(RNumber)) Then 
                	ParseXML = "E2"
	                logme "** NotTooSoon was False. ParseXML will return E2 and Exit"
	                Exit Do
                End If
                logme "ParseXML will now call sub CheckExist with parameters " & XDict.Item(RNumber) & ", 0, " & out_type
                res = CheckExist(XDict.Item(RNumber), 0, out_type)
                logme "CheckExist returned " & res & " to ParseXML"
                If res <> 0 Then
                	    ParseXML = res & "|§|§|§" & XDict.Item(RNumber)
                	 	logme "** ParseXML will return " & ParseXML
                        Exit Do
                End If

                If i = n Then
                	logme "** ParseXML tried too many times (" & i & "). It will return E2 code and exit"
                    ParseXML = "E2"
                    Exit Do
                End If
                i = i + 1
                TimerLoop = 0
                SDB.ProcessMessages

            Loop

Code: Select all

            Do
                RNumber = Int(XDict.Count * Rnd)
                logme "ParseXML will now call NotTooSoon with parameters " & XDict.Item(RNumber)
                logme "ParseXML will now call sub CheckExist with parameters " & XDict.Item(RNumber) & ", 0, " & out_type
                res = CheckExist(XDict.Item(RNumber), 0, out_type)
                logme "CheckExist returned " & res & " to ParseXML"
                If NotTooSoon(XDict.Item(RNumber)) And res <> 0 Then
                	    ParseXML = res & "|§|§|§" & XDict.Item(RNumber)
                	 	logme "** ParseXML will return " & ParseXML
                        Exit Do
                End If

                If i = n Then
                	logme "** ParseXML tried too many times (" & i & "). It will return E2 code and exit"
                    ParseXML = "E2"
                    Exit Do
                End If
                i = i + 1
                TimerLoop = 0
                SDB.ProcessMessages

            Loop