Dim TearHttpHeader()
Redim TearHttpHeader(1,0)
TearHTTPHeaderCnt = -1


Sub TearHttpAddHeader(ByVal TearHttpAddHeaderName, ByVal TearHttpAddHeaderValue)
  If (LCase(Trim (TearHttpAddHeaderName)) <> "user-agent") And (LCase(Trim (TearHttpAddHeaderName)) <> "content-length") And (LCase(Trim(TearHttpAddHeaderName)) <> "content-type") Then
    TearHTTPHeaderChanged = False
    For TearHttpAddHeaderI = 0 To TearHTTPHeaderCnt
      If TearHTTPHeader(0,TearHttpAddHeaderI) = TearHttpAddHeaderName Then
        TearHTTPHeader(1,TearHttpAddHeaderI) = TearHttpAddHeaderValue
    &nb sp;   TearHTTPHeaderChanged = True
      End If
      Exit For
    Next
    If (TearHTTPHeaderChanged = False) Then
      TearHTTPHeaderCnt = TearHTTPHeaderCnt + 1
      If (TearHTTPHeaderCnt >= 0) Then
        Redim Preserve TearHTTPHeader(1,TearHTTPHeaderCnt)
      End If
      TearHTTPHeader (0,TearHTTPHeaderCnt) = TearHttpAddHeaderName
    &n bsp; TearHTTPHeader(1,TearHTTPHeaderCnt) = TearHttpAddHeaderValue
    End If
  End If
End Sub


Sub TearHttpRemoveHeader(ByVal TearHttpRemoveHeaderName)
  For TearHttpRemoveHeaderI = 0 To TearHTTPHeaderCnt
    If (TearHTTPHeader(0,TearHttpRemoveHeaderI) = TearHttpRemoveHeaderName) Then
      For TearHttpRemoveHeaderJ = TearHttpRemoveHeaderI To (TearHTTPHeaderCnt -1)
        TearHTTPHeader(0,TearHttpRemoveHeaderJ) = TearHTTPHeader(0,(TearHttpRemoveHeaderJ +1))
        TearHTTPHeader(1,TearHttpRemoveHeaderJ) = TearHTTPHeader(1,(TearHttpRemoveHeaderJ +1))
      Next
      TearHTTPHeaderCnt = TearHTTPHeaderCnt - 1
      If (TearHTTPHeaderCnt >= 0) Then
        Redim Preserve TearHTTPHeader(1,TearHTTPHeaderCnt)
      End If
      Exit For
    End If
  Next
End Sub


Function TearHTTP(ByVal TearHTTPURL, ByVal TearHTTPPostData)
  TearHTTPProtocol = "HTTP"
  TearHTTPVersion = "1.0"
  TearHTTPTimeout = 10000
  TearHTTPServer = ""
  TearHTTPPort = 0
  TearHTTPDocument = "/"
  TearHTTPSendString = ""
  TearHTTPSend = ""
  If (LCase(Left (TearHTTPURL,7)) = "http://") Then
    TearHTTPURL = Mid(TearHTTPURL, 8 , (Len(TearHTTPURL) - 7))
  End If
  If (InStr(1, TearHTTPURL, "/" , vbBinaryCompare) = 0) Then
    TearHTTPServer = TearHTTPURL
    TearHTTPDocument = "/"
  Else
    TearHTTPServer = Mid(TearHTTPURL, 1, (InStr(1, TearHTTPURL, "/" , vbBinaryCompare) -1))
    TearHTTPDocument = Mid(TearHTTPURL, InStr(1, TearHTTPURL, "/" , vbBinaryCompare), (Len(TearHTTPURL) - (InStr(1, TearHTTPURL, "/" , vbBinaryCompare) -1)))
  End If
  If (InStr (1, TearHTTPServer, ":" , vbBinaryCompare) = 0) Then
    TearHTTPPort = 80
    TearHTTPServer = TearHTTPServer
  Else
    TearHTTPPort = Mid (TearHTTPServer, (InStr(1, TearHTTPServer, ":" , vbBinaryCompare) + 1), (Len (TearHTTPServer) - (InStr(1, TearHTTPServer, "/" , vbBinaryCompare) -1)))
    TearHTTPServer = Mid(TearHTTPServer, 1, (InStr(1, TearHTTPServer, ":" , vbBinaryCompare) -1))
  End If
  If (InStr (1, TearHTTPDocument, "?" , vbBinaryCompare) <> 0) Then
    TearHTTPSendString = Mid(TearHTTPDocument, (InStr(1, TearHTTPDocument, "?" , vbBinaryCompare) + 1), (Len(TearHTTPDocument) - (InStr(1, TearHTTPDocument, "?" , vbBinaryCompare) -1)))
    TearHTTPDocument = Mid (TearHTTPDocument, 1, (InStr(1, TearHTTPDocument, "?" , vbBinaryCompare) -1))
  End If
  If (TearHTTPPostData <> "") Then
    TearHTTPMethod = "POST"
  Else
    TearHTTPMethod = "GET"
  End If
  TearHTTPSend = TearHTTPMethod
  TearHTTPSend = TearHTTPSend & " " & TearHTTPDocument
  If (TearHTTPSendString <> "") Then
    TearHTTPSend = TearHTTPSend & "?" & TearHTTPSendString
  End IF
  TearHTTPSend = TearHTTPSend & " " & TearHTTPProtocol & "/" & TearHTTPVersion
  TearHTTPSend = TearHTTPSend & Chr(13) & Chr(10)
  TearHTTPSend = TearHTTPSend & "User-Agent" & ": " & "msd TearHTTP 1.0 (thanks to dimac)"
  TearHTTPSend = TearHTTPSend & Chr(13) & Chr(10)
  For TearHTTPHeaderI = 0 To TearHTTPHeaderCnt
    TearHTTPSend = TearHTTPSend & TearHTTPHeader(0,TearHTTPHeaderI) & ": " & TearHTTPHeader(1,TearHTTPHeaderI) & Chr(13) & Chr(10)
  Next
  If (TearHTTPPostData <> "") Then
    TearHTTPSend = TearHTTPSend & "Content-Length" & ": " & Len(TearHTTPPostData) & Chr(13) & Chr(10)
    TearHTTPSend = TearHTTPSend & "Content-Type" & ": " & "application/x-www-form-urlencoded" & Chr(13) & Chr(10)
    TearHTTPSend = TearHTTPSend & Chr(13) & Chr(10)
    TearHTTPSend = TearHTTPSend & TearHTTPPostData & Chr(13) & Chr(10)
  End If
  Set Socket = WScript.CreateObject("Socket.TCP")
  Socket.Host = TearHTTPServer & ":" & TearHTTPPort
  Socket.TimeOut = TearHTTPTimeout
  Socket.Open()
  Socket.SendText(TearHTTPSend)
  Socket.WaitForDisconnect()
  TearHTTP = Socket.Buffer
  Socket.Close()
  Set Socket = Nothing
End Function


Function HTTPResponse(ByVal toHTTPResponse, ByVal whichHTTPResponse)
  HTTPResponseDelimiter = Chr(13) & Chr(10) & Chr(13) & Chr(10)
  If (InStr(1, toHTTPResponse, HTTPResponseDelimiter, vbBinaryCompare) <> 0) Then
    Select Case whichHTTPResponse
    Case 0 'Header
      HTTPResponse = Mid(toHTTPResponse, 1, (InStr(1, toHTTPResponse, HTTPResponseDelimiter , vbBinaryCompare) -1))
    Case 1 'Body
      HTTPResponse = Mid(toHTTPResponse, (InStr(1, toHTTPResponse, HTTPResponseDelimiter , vbBinaryCompare) + Len (HTTPResponseDelimiter)), (Len(toHTTPResponse) - (InStr(1, toHTTPResponse, HTTPResponseDelimiter , vbBinaryCompare) -1)))
    End Select
  End If
End Function
 
Call TearHttpAddHeader("x- msd1","just")
Call TearHttpAddHeader("x-msd2","kidding")
Call TearHttpRemoveHeader("x-msd1")
output = TearHTTP("http://www.msd.net:80/default.asp? GetVar1=Max&GetVar2=Baehring","PostVar1=msd&P ostVar2=Germany")
msgbox HTTPResponse(output,1)