'
' URL
' version 0.1
' (c) 2011 Stefan Wurzinger
'

#Include Once "general.bi"

Type URL
	Scheme As String
	Host As String
	Port As Long
	URI As String
	Query As String
End Type

Declare Function ExtractUrl(ByRef sUrl As String) As URL
Declare Function URLEncode(ByRef s As Const String) As String
Declare Function UrlDecode(ByRef s As Const String) As String


' returns as type URL from a string
Function ExtractUrl(ByRef sUrl As String) As URL
	Dim strUrl As String = sUrl
	Dim intPos1 As Integer
	Dim intPos2 As Integer
	
	Dim retURL As URL
	
	intPos1 = InStr(strUrl, "://")
	
	If intPos1 > 0 Then
	  retURL.Scheme = Mid(strUrl, 1, intPos1 - 1)
	  strUrl = Mid(strUrl, intPos1 + 3)
	End If
	    
	'2 look for a port
	intPos1 = InStr(strUrl, ":")
	intPos2 = InStr(strUrl, "/")
	
	If intPos1 > 0 And intPos1 < intPos2 Then
	  ' a port is specified
	  retURL.Host = Mid(strUrl, 1, intPos1 - 1)
	  
	  If (IsNumeric(Mid(strUrl, intPos1 + 1, intPos2 - intPos1 - 1))) Then
	    retURL.Port = CInt(Mid(strUrl, intPos1 + 1, intPos2 - intPos1 - 1))
	  End If
	ElseIf intPos2 > 0 Then
    retURL.Host = Mid(strUrl, 1, intPos2 - 1)
	Else
	  retURL.Host = strUrl
	  retURL.URI = "/"
	  
	  Return retURL
	End If
	
	strUrl = Mid(strUrl, intPos2)
	
	' find a question mark ?
	intPos1 = InStr(strUrl, "?")
	
	If intPos1 > 0 Then
	  retURL.URI = Mid(strUrl, 1, intPos1 - 1)
	  retURL.Query = Mid(strUrl, intPos1 + 1)
	Else
	  retURL.URI = strUrl
	End If
	
	return retURL
End Function


'URL Encoding replaces “unsafe” characters with ‘%’ followed by their hex equivalent.
'Characters which need not be escaped are defined in RFC3986 (which replaced RFC2396).
'They are the 7-bit ASCII alphanumerics and the characters “-._~”. Unicode characters
'and 8-bit ASCII characters are normally first encoded using UTF-8, as defined in RFC2279. 

' url encodes a string
Function URLEncode(ByRef s As Const String) As String
	Dim intLen As Integer
	Dim X As Integer
	Dim curChar As Integer
	Dim newStr As String
	intLen = Len(s)
	newStr = ""
	For X = 1 To intLen
	  curChar = Asc(Mid(s, X, 1))
	  
	  If (curChar < 48 Or curChar > 57) And _
	     (curChar < 65 Or curChar > 90) And _
	     (curChar < 97 Or curChar > 122) Then
	    newStr = newStr & "%" & Hex(curChar, 2)
	  Else
	  	newStr = newStr & Chr(curChar)
	  End If
	Next X
	
	return newStr
End Function

' decodes a url encoded string
Function UrlDecode(ByRef s As Const String) As String
	Dim intLen As Integer
	Dim X As Integer
	Dim curChar As String * 1
	Dim strCode As String * 4
	
	Dim newStr As String
	
	intLen = Len(s)
	newStr = ""
	
	For X = 1 To intLen
	  curChar = Mid(s, X, 1)
	  
	 	'RFC2396 (no Unicode or UTF8, space encoded as ‘+’)
	  If curChar = "+" Then
	  	curChar = " "
	  ElseIf curChar = "%" Then
	    strCode = "&h" & Mid(s, X + 1, 2)
	    If IsNumeric(strCode) Then
	      curChar = Chr(Val(strCode))
	    Else
	      curChar = ""
	    End If
	    X = X + 2
	  End If
	  
	  newStr = newStr & curChar
	Next X
	
	UrlDecode = newStr
End Function

