$Define ANY LONG
$define Boolean LONG

'From:  "Gregg Morrison" <greggmor@b...> Thu Oct 3, 2002  2:35 pm
'Subject:  send variables via POST
' VisualBasic code.
' send some variables to a server with post method

Public Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" _
(ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As _
String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long

Public Declare Function InternetConnect Lib "wininet.dll" Alias _
"InternetConnectA" (ByVal InternetSession As Long, ByVal sServerName As _
String, ByVal nServerPort As Integer, ByVal sUsername As String, ByVal _
sPassword As String, ByVal lService As Long, ByVal lFlags As Long, ByVal _
lContext As Long) As Long

Public Declare Function HttpOpenRequest Lib "wininet.dll" Alias _
"HttpOpenRequestA" (ByVal hHttpSession As Long, ByVal sVerb As String, ByVal _
sObjectName As String, ByVal sVersion As String, ByVal sReferer As String, _
ByVal something As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long

Public Declare Function HttpAddRequestHeaders Lib "wininet.dll" Alias _
"HttpAddRequestHeadersA" (ByVal hHttpRequest As Long, ByVal sHeaders As _
String, ByVal lHeadersLength As Long, ByVal lModifiers As Long) As Integer

Public Declare Function HttpSendRequest Lib "wininet.dll" Alias _
"HttpSendRequestA" (ByVal hHttpRequest As Long, ByVal sHeaders As String, _
ByVal lHeadersLength As Long, sOptional As Any, ByVal lOptionalLength As _
Long) As Integer

Public Declare Function InternetReadFile Lib "wininet.dll" Alias "InternetReadFile" (ByVal hFile As _
Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, _
lNumberOfBytesRead As Long) As Integer

Public Declare Function InternetCloseHandle Lib "wininet.dll" Alias "InternetCloseHandle" (ByVal hInet _
As Long) As Integer

Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Const INTERNET_SERVICE_HTTP = 3
Const INTERNET_DEFAULT_HTTP_PORT = 80
Const INTERNET_FLAG_RELOAD = &H80000000
Const HTTP_ADDREQ_FLAG_ADD = &H20000000
Const HTTP_ADDREQ_FLAG_REPLACE = &H80000000


' *********************************************************
' POST data to the Internet server using API calls.
' srv = Server URL
' script = CGI app on server
' postdat = data you want to send
' *********************************************************
Public Function PostInfo(srv As String, script As String, postdat As String) As String

' Handles and Status
Dim hInternetOpen As Long
Dim hInternetConnect As Long
Dim hHttpOpenRequest As Long
Dim bRet As Boolean

' Internal Strings and Variables
Dim sHeader As String
Dim lpszPostData As String
Dim lPostDataLen As Long
Dim sReadBuffer As String * 2048
Dim sBuffer As String
Dim bDoLoop As Boolean
Dim lNumberOfBytesRead As Long

' Constants
Dim vbNullString as String
Dim vbCrLf as string


vbNullString = ""
vbCrLf = Chr$(13) + Chr$(10)

hInternetOpen = 0
hInternetConnect = 0
hHttpOpenRequest = 0

'Use registry access settings.
hInternetOpen = InternetOpen("http generic", _
INTERNET_OPEN_TYPE_PRECONFIG, _
vbNullString, _
vbNullString, _
0)

If hInternetOpen <> 0 Then
'Type of service to access.
'srv = the Server name you want to access
' EG: "http:\\voveotech.com"
hInternetConnect = InternetConnect(hInternetOpen, _
srv, _
INTERNET_DEFAULT_HTTP_PORT, _
vbNullString, _
"HTTP/1.0", _
INTERNET_SERVICE_HTTP, _
0, _
0)

If hInternetConnect <> 0 Then
' Brings the data across the wire even if it locally cached.
hHttpOpenRequest = HttpOpenRequest(hInternetConnect, _
"POST", _
script, _
"HTTP/1.0", _
vbNullString, _
0, _
INTERNET_FLAG_RELOAD, _
0)

If hHttpOpenRequest <> 0 Then
sHeader = "Content-Type: application/x-www-form-urlencoded" & vbCrLf
bRet = HttpAddRequestHeaders(hHttpOpenRequest, _
sHeader, Len(sHeader), HTTP_ADDREQ_FLAG_REPLACE _
Or HTTP_ADDREQ_FLAG_ADD)

lpszPostData = postdat
lPostDataLen = Len(lpszPostData)
bRet = HttpSendRequest(hHttpOpenRequest, _
vbNullString, _
0, _
lpszPostData, _
lPostDataLen)

bDoLoop = True
While bDoLoop
sReadBuffer = vbNullString
bDoLoop = InternetReadFile(hHttpOpenRequest, _
sReadBuffer, Len(sReadBuffer), lNumberOfBytesRead)
sBuffer = sBuffer & Left$(sReadBuffer, _
lNumberOfBytesRead)
If Not CBool(lNumberOfBytesRead) Then bDoLoop = False
Wend

PostInfo = sBuffer
bRet = InternetCloseHandle(hHttpOpenRequest)
End If
bRet = InternetCloseHandle(hInternetConnect)
End If
bRet = InternetCloseHandle(hInternetOpen)
End If
End Function