@@ -332,12 +332,14 @@ End Function
332
332
333
333
''
334
334
' Url encode the given string
335
+ ' Reference: http://www.blooberry.com/indexdot/html/topics/urlencoding.htm
335
336
'
336
337
' @param {Variant} Text The raw string to encode
337
338
' @param {Boolean} [SpaceAsPlus = False] Use plus sign for encoded spaces (otherwise %20)
339
+ ' @param {Boolean} [EncodeUnsafe = True] Encode unsafe characters
338
340
' @return {String} Encoded string
339
341
' --------------------------------------------- '
340
- Public Function UrlEncode (Text As Variant , Optional SpaceAsPlus As Boolean = False ) As String
342
+ Public Function UrlEncode (Text As Variant , Optional SpaceAsPlus As Boolean = False , Optional EncodeUnsafe As Boolean = True ) As String
341
343
Dim UrlVal As String
342
344
Dim StringLen As Long
343
345
@@ -346,34 +348,39 @@ Public Function UrlEncode(Text As Variant, Optional SpaceAsPlus As Boolean = Fal
346
348
347
349
If StringLen > 0 Then
348
350
ReDim Result(StringLen) As String
349
- Dim i As Long , charCode As Integer
350
- Dim Char As String , space As String
351
+ Dim i As Long
352
+ Dim CharCode As Integer
353
+ Dim Char As String
354
+ Dim Space As String
351
355
352
356
' Set space value
353
357
If SpaceAsPlus Then
354
- space = "+"
358
+ Space = "+"
355
359
Else
356
- space = "%20"
360
+ Space = "%20"
357
361
End If
358
362
359
363
' Loop through string characters
360
364
For i = 1 To StringLen
361
365
' Get character and ascii code
362
366
Char = Mid$(UrlVal, i, 1 )
363
- charCode = Asc(Char)
364
- Select Case charCode
365
- Case 97 To 122 , 65 To 90 , 48 To 57 , 45 , 46 , 95 , 126
366
- ' Use original for AZaz09-._~
367
- Result(i) = Char
368
- Case 32
369
- ' Add space
370
- Result(i) = space
371
- Case 0 To 15
372
- ' Convert to hex w/ leading 0
373
- Result(i) = "%0" & Hex(charCode)
367
+ CharCode = Asc(Char)
368
+
369
+ Select Case CharCode
370
+ Case 36 , 38 , 43 , 44 , 47 , 58 , 59 , 61 , 63 , 64
371
+ ' Reserved characters
372
+ Result(i) = "%" & Hex(CharCode)
373
+ Case 32 , 34 , 35 , 37 , 60 , 62 , 91 To 94 , 96 , 123 To 126
374
+ ' Unsafe characters
375
+ If EncodeUnsafe Then
376
+ If CharCode = 32 Then
377
+ Result(i) = Space
378
+ Else
379
+ Result(i) = "%" & Hex(CharCode)
380
+ End If
381
+ End If
374
382
Case Else
375
- ' Convert to hex
376
- Result(i) = "%" & Hex(charCode)
383
+ Result(i) = Char
377
384
End Select
378
385
Next i
379
386
UrlEncode = Join(Result, "" )
@@ -533,18 +540,32 @@ Public Function UrlParts(Url As String) As Dictionary
533
540
"print ""Protocol="" . $url->scheme;" & vbNewLine & _
534
541
"print "" | Host="" . $url->host;" & vbNewLine & _
535
542
"print "" | Port="" . $url->port;" & vbNewLine & _
536
- "print "" | Path="" . $url->path;" & vbNewLine & _
537
- "print "" | Querystring="" . $url->query;" & vbNewLine & _
543
+ "print "" | FullPath="" . $url->full_path;" & vbNewLine & _
538
544
"print "" | Hash="" . $url->frag;" & vbNewLine & _
539
545
"}'"
540
-
546
+
541
547
Results = Split(ExecuteInShell(Command).Output, " | " )
542
548
For Each ResultPart In Results
543
549
EqualsIndex = InStr(1 , ResultPart, "=" )
544
550
Key = Trim(VBA.Mid$(ResultPart, 1 , EqualsIndex - 1 ))
545
551
Value = Trim(VBA.Mid$(ResultPart, EqualsIndex + 1 ))
546
552
547
- Parts.Add Key, Value
553
+ If Key = "FullPath" Then
554
+ ' For properly escaped path and querystring, need to use full_path
555
+ ' But, need to split FullPath into Path...?Querystring
556
+ Dim QueryIndex As Integer
557
+
558
+ QueryIndex = InStr(1 , Value, "?" )
559
+ If QueryIndex > 0 Then
560
+ Parts.Add "Path" , Mid$(Value, 1 , QueryIndex - 1 )
561
+ Parts.Add "Querystring" , Mid$(Value, QueryIndex + 1 )
562
+ Else
563
+ Parts.Add "Path" , Value
564
+ Parts.Add "Querystring" , ""
565
+ End If
566
+ Else
567
+ Parts.Add Key, Value
568
+ End If
548
569
Next ResultPart
549
570
550
571
If AddedProtocol And Parts.Exists("Protocol" ) Then
@@ -792,7 +813,9 @@ Public Function CreateResponseFromCURL(Result As ShellResult, Optional Format As
792
813
Dim ErrorNumber As Long
793
814
794
815
ErrorNumber = Result.ExitCode / 256
795
- If ErrorNumber = 28 Then
816
+ ' 7 - CURLE_COULDNT_CONNECT
817
+ ' 28 - CURLE_OPERATION_TIMEDOUT
818
+ If ErrorNumber = 7 Or ErrorNumber = 28 Then
796
819
Set CreateResponseFromCURL = CreateResponse(StatusCodes.RequestTimeout, "Request Timeout" )
797
820
Else
798
821
LogError "cURL Error: " & ErrorNumber, "RestHelpers.CreateResponseFromCURL"
@@ -1151,7 +1174,7 @@ Public Function ExecuteInShell(Command As String) As ShellResult
1151
1174
End If
1152
1175
1153
1176
Do While feof(File) = 0
1154
- Chunk = VBA.space $(50 )
1177
+ Chunk = VBA.Space $(50 )
1155
1178
Read = fread(Chunk, 1 , Len(Chunk) - 1 , File)
1156
1179
If Read > 0 Then
1157
1180
Chunk = VBA.Left$(Chunk, Read)
0 commit comments