-
Notifications
You must be signed in to change notification settings - Fork 0
/
url.bas
118 lines (92 loc) · 3.1 KB
/
url.bas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
Attribute VB_Name = "url_helper"
Option Explicit
Type URL
Scheme As String
Host As String
Port As Long
URI As String
Query As String
End Type
' returns as type URL from a string
Function ExtractUrl(ByVal strUrl As String) As URL
Dim intPos1 As Integer
Dim intPos2 As Integer
Dim retURL As URL
'1 look for a scheme it ends with ://
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 = "/"
ExtractUrl = retURL
Exit Function
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
ExtractUrl = retURL
End Function
' url encodes a string
Function URLEncode(ByVal str As String) As String
Dim intLen As Integer
Dim X As Integer
Dim curChar As Long
Dim newStr As String
intLen = Len(str)
newStr = ""
For X = 1 To intLen
curChar = Asc(Mid$(str, 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)
Else
newStr = newStr & Chr(curChar)
End If
Next X
URLEncode = newStr
End Function
' decodes a url encoded string
Function UrlDecode(ByVal str As String) As String
Dim intLen As Integer
Dim X As Integer
Dim curChar As String * 1
Dim strCode As String * 2
Dim newStr As String
intLen = Len(str)
newStr = ""
For X = 1 To intLen
curChar = Mid$(str, X, 1)
If curChar = "%" Then
strCode = "&h" & Mid$(str, X + 1, 2)
If IsNumeric(strCode) Then
curChar = Chr(Int(strCode))
Else
curChar = ""
End If
X = X + 2
End If
newStr = newStr & curChar
Next X
UrlDecode = newStr
End Function