I am working on 2 versions.
One is completely dependent on 'win/wininet.bi'.
The other one based on D.J. Peter's 'SNC' --> http://www.freebasic.net/forum/viewtopi ... =7&t=23421
All of the examples are "one and done" and hard coded URL's.
I have slightly modified to be multiple use but do not know how, and no real time to work on, the URL part of it.
URL.bi
Code: Select all
'similar to wininet.bi URL_COMPONENTS
Type URLParts
As String Scheme 'http:// (etc...)
As String Host 'www.xyz.com
As String PathToFile '/somefolder/somepage.html
As String Query '?name1="1"&name2="2"
As Integer Valid 'Host and Scheme must have value to be true
End Type
/'from win/wininit.bi
#define _WININET_
InternetCrackUrl
InternetCreateUrl <-- not sure if need
InternetCanonicalizeUrl <-- URLEncode and URLDecode
InternetCombineUrl
'/
Declare Function UrlSplit(AnyUrl As String) As URLParts '<- calls InternetCrackUrl
Declare Function UrlCombine(BaseUrl As String, PartialUrl As String) As String '<- calls InternetCombineUrl
'encoding is handled by form submission
'Declare Function URLEncode(EncodeMe As String) As String
Declare Function URLDecode(DecodeMe As String) As String
Code: Select all
#Ifdef _WININET_
Function UrlSplit(AnyUrl As String) As URLParts
Dim As URLParts R
Dim As URL_COMPONENTS SplitMe
Dim As ZString * 255 ZHost, ZScheme
Dim As ZString * 1023 ZPath, ZXtra
SplitMe.dwStructSize = SizeOf(URL_COMPONENTS)
SplitMe.dwSchemeLength = 255
SplitMe.lpszScheme = @ZScheme
SplitMe.dwHostNameLength = 255
SplitMe.lpszHostName = @ZHost
SplitMe.dwUrlPathLength = 1023
SplitMe.lpszUrlPath = @ZPath
SplitMe.dwExtraInfoLength = 1023
SplitMe.lpszExtraInfo = @ZXtra
'
R.Valid = InternetCrackUrl(StrPtr(AnyUrl), Len(AnyUrl), 0, @SplitMe)
If R.Valid Then
'transfer to R.
If SplitMe.dwSchemeLength Then R.Scheme = ZScheme
If SplitMe.dwHostNameLength Then R.Host = ZHost
If SplitMe.dwUrlPathLength Then R.PathToFile = ZPath
If SplitMe.dwExtraInfoLength Then R.Query = ZXtra
If Len(R.PathToFile) = 0 Then R.PathToFile = "/" 'not sure if need
EndIf
Return R
End Function
Function UrlCombine(BaseUrl As String, PartialUrl As String) As String
Dim As ZString * INTERNET_MAX_URL_LENGTH FullWantPage
Dim As ULong FWPLen = INTERNET_MAX_URL_LENGTH
Dim As Integer R = InternetCombineUrl(StrPtr(BaseUrl), StrPtr(PartialUrl), @FullWantPage, @FWPLen, 0)
Return FullWantPage
End Function
#Else
'BOTH OF THESE NEED WORKED ON!!!
Function UrlSplit(AnyUrl As String) As URLParts
'Windows has InternetCrackUrl
Dim As URLParts R
Dim As Integer S, F
'
If Left(AnyUrl, 8) = "https://" Then
'secure
R.Scheme = "https"
S = 8
ElseIf Left(AnyUrl, 6) = "ftp://" Then
'ftp
R.Scheme = "ftp"
S = 6
ElseIf Left(AnyUrl, 7) = "http://" Then
'http stated
'R.Protocal = "http"
S = 7
Else
'default
'R.Protocal = "http"
R.Valid = 0
S = 1
EndIf
Dim As String U = Mid(AnyUrl, S)
'
If InStr(U, "/") Then
'check for host and path
EndIf
S = InStr(U, "?")
If S Then
'there is a query and page
Else
'ONLY HOST or PAGE PASSED
'"www.msn.com" or "Page1.html"
R.Host = Mid(U, S)
R.Valid = 1
EndIf
Return R
End Function
Function UrlCombine(BaseUrl As String, PartialUrl As String) As String
'Windows has InternetCombineUrl
'just code to elimate any compile error (function not set ....)
Return ""
End Function
#EndIf
'Reference from wininet.bi
#If 0
'functions start line 550
'URL_COMPONENTS - 345
Type URL_COMPONENTSA
dwStructSize As DWORD
lpszScheme As LPSTR
dwSchemeLength As DWORD
nScheme As INTERNET_SCHEME
lpszHostName As LPSTR
dwHostNameLength As DWORD
nPort As INTERNET_PORT
lpszUserName As LPSTR
dwUserNameLength As DWORD
lpszPassword As LPSTR
dwPasswordLength As DWORD
lpszUrlPath As LPSTR
dwUrlPathLength As DWORD
lpszExtraInfo As LPSTR
dwExtraInfoLength As DWORD
End Type
'encoding is handled in form submission
Function URLEncode(EncodeMe As String) As String
Static As String * 69 an = "abcdefghijklmnopqrstuvwxyz" & _
"ABCDEFGHIJKLMNOPQRSTUVWXYZ" & _
"0123456789/:.&?="
Dim As String url = Trim(EncodeMe)
Dim As Integer nChars = Len(url)
If nChars < 1 Then Return ""
Dim As String encoded, char
For i As Integer = 1 To nChars
char = Mid(url,i,1)
If InStr(an, char) > 0 Then
encoded &= char
Else
encoded &= "%" & LCase(Hex(Asc(char),2))
End If
Next
Return encoded
End Function
#EndIf
Function URLDecode(DecodeMe As String) As String
Dim As String url = Trim(DecodeMe)
Dim As Integer nChars = Len(url)+1
If nChars<2 Then Return ""
Dim As String decoded
Dim As Integer i=1
While i<nChars
Dim As String char = Mid(url,i,1)
If char="%" Then
decoded &= Chr(Val("&H" & Mid(url,i+1,2))):i+=3
Else
decoded &= char : i+=1
End If
Wend
Return decoded
End Function