by Friso Kluitenberg (2 Submissions)
Category: Miscellaneous
Compatability: Visual Basic 4.0 (32-bit)
Difficulty: Unknown Difficulty
Originally Published: Thu 9th August 2007
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Parses http headers, and converint to absolute url, etc
VBcoders
Public Function GetHeader(ByRef rDat As String, ByRef header As String) As String ', "header"
'//On Error GoTo sEnd:
Dim Pos1 As Integer, Pos2 As Integer
header = header & ": "
Pos1 = InStr(1, LCase$(rDat), header) + Len(header)
If Pos1 = Len(header) Then Exit Function '//no header found
Pos2 = InStr(Pos1, LCase$(rDat), vbCrLf)
If Pos2 = 0 Then Exit Function
GetHeader = Mid(rDat, Pos1, Pos2 - Pos1)
sEnd:
End Function
Public Function GetRequestHost(ByRef ReqHeader As String) As String
Dim Pos1 As Integer
Dim tTemp As String
Pos1 = InStr(ReqHeader, " ") + 1
tTemp = Mid(ReqHeader, Pos1, InStr(Pos1, ReqHeader, " ") - Pos1)
If InStr(LCase$(tTemp), "http://") = 1 Then
tTemp = Mid(tTemp, 8)
End If
Pos1 = InStr(tTemp, "/")
If Pos1 < 1 Then '//no path found,
GetRequestHost = tTemp
Exit Function
Else
GetRequestHost = Mid(tTemp, 1, Pos1 - 1)
Exit Function
End If
End Function
Public Function GetRequestPath(ByRef sHtml As String) As String
Dim Pos1 As Integer
Dim tTemp As String
Pos1 = InStr(sHtml, " ") + 1
tTemp = Mid(sHtml, Pos1, InStr(Pos1, sHtml, " ") - Pos1)
If InStr(LCase$(tTemp), "http://") = 1 Then
tTemp = Mid(tTemp, 8)
End If
Pos1 = InStr(tTemp, "/")
If Pos1 < 1 Then '//no path found,
tTemp = "/"
Exit Function
Else
GetRequestPath = Mid(tTemp, Pos1)
End If
Pos1 = InStr(tTemp, "?")
If Pos1 < 1 Then
Exit Function
Else
GetRequestPath = Mid(tTemp, 1, Pos1 - 1)
Exit Function
End If
End Function