如果必须使用 POST，则必须使用 Internet 传输控制。在 VB6 IDE 中，按 CTL-T，然后选择“Microsoft Internet Transfer Control 6.0”。按确定。
将控件的实例添加到窗体。称之为“Inet”。向窗体添加一个名为“cmdPost”的命令按钮。添加对“Microsoft Scripting Runtime”的引用（参见菜单 Project=>References）。
将以下代码添加到您的表单中：
Option Explicit
Private Declare Function InternetCanonicalizeUrl Lib "Wininet.dll" Alias "InternetCanonicalizeUrlW" ( _
ByVal lpszUrl As Long, _
ByVal lpszBuffer As Long, _
ByRef lpdwBufferLength As Long, _
ByVal dwFlags As Long _
) As Long
Private m_sData As String
Private m_nDataReceived As Long
Private m_bPostActive As Boolean
Private m_bDataReceived As Boolean
Private m_bError As Boolean ' For error handling.
Private m_bDisconnected As Boolean
Private Sub cmdPost_Click()
Dim dctParameters As Scripting.Dictionary
txtOutput.Text = vbNullString
m_sData = vbNullString
Set dctParameters = New Scripting.Dictionary
dctParameters.Add "var1", "secret"
dctParameters.Add "var2", "pass"
txtOutput.Text = Post("http://localhost:80/test.php", dctParameters)
End Sub
' Returns post data string based on dictionary.
Private Function GetPostDataString(ByRef the_dctParameters As Scripting.Dictionary) As String
Dim vName As Variant
Dim sPostDataString As String
For Each vName In the_dctParameters
sPostDataString = sPostDataString & UrlEncode(CStr(vName)) & "=" & UrlEncode(CStr(the_dctParameters.Item(vName))) & "&"
Next vName
GetPostDataString = Left$(sPostDataString, Len(sPostDataString) - 1)
End Function
Private Sub Inet_StateChanged(ByVal State As Integer)
' Ignore state change if we are outside the Post function.
If m_bPostActive Then
Select Case State
Case StateConstants.icResponseReceived
ReceiveData False
Case StateConstants.icResponseCompleted
ReceiveData True
Case StateConstants.icDisconnected
m_bDisconnected = True
Case StateConstants.icError
m_bError = True
End Select
End If
End Sub
' Synchronous Post function.
Private Function Post(ByRef the_sURL As String, ByRef the_dctParameters As Scripting.Dictionary)
Dim sPostData As String
Dim sHeaders As String
' Flag that we are in the middle of this function.
m_bPostActive = True
' Create a string containing the POST parameters.
sPostData = GetPostDataString(the_dctParameters)
' Create a headers string to allow POST.
sHeaders = _
"Content-Type: application/x-www-form-urlencoded" & vbNewLine & _
"Content-Length: " & CStr(Len(sPostData)) & vbNewLine & _
"Connection: Keep-Alive" & vbNewLine & _
"Cache-Control: no-cache" & vbNewLine
Inet.Execute the_sURL, "POST", GetPostDataString(the_dctParameters), sHeaders
' Allow Inet events to fire.
Do
DoEvents
Loop Until m_bDataReceived Or m_bDisconnected
If m_bDataReceived Then
Post = m_sData
End If
' Clear all state flags to defaults.
m_bDataReceived = False
m_bDisconnected = False
m_bError = False
m_sData = vbNullString
m_nDataReceived = 0
' Flag that we have exited this function.
m_bPostActive = False
End Function
' Receive as much data as we can.
' <the_bCompleted> should be True if the response is completed i.e. all data is available.
Private Sub ReceiveData(ByVal the_bCompleted As Boolean)
Const knBufferSize As Long = 1024
Dim nContentLength As Long
Dim sContentType As String
Dim sChunk As String
Dim nChunkSize As Long
' If we haven't yet created our buffer, do so now, based on the size of the incoming data.
If m_nDataReceived = 0 Then
nContentLength = CLng(Inet.GetHeader("Content-length"))
m_sData = Space$(nContentLength)
' You might want to do a check on the content type here, and if it is wrong, cancel the request with Inet.Cancel .
sContentType = Inet.GetHeader("Content-type")
End If
' Retrieve data until we have all the data.
Do Until m_nDataReceived = Len(m_sData)
' If called when not all data has been received, then exit function if it is currently executing.
If Not the_bCompleted Then
If Inet.StillExecuting Then
Debug.Print "Exiting"
Exit Sub
End If
End If
' Get a chunk, copy it into the output buffer, and increment the amount of data received.
sChunk = Inet.GetChunk(knBufferSize, DataTypeConstants.icString)
nChunkSize = Len(sChunk)
Mid$(m_sData, m_nDataReceived + 1, nChunkSize) = sChunk
m_nDataReceived = m_nDataReceived + nChunkSize
Loop
' Flag that all data has been retrieved.
m_bDataReceived = True
End Sub
' Encode the URL data.
Private Function UrlEncode(ByVal the_sURLData As String) As String
Dim nBufferLen As Long
Dim sBuffer As String
' Only exception - encode spaces as "+".
the_sURLData = Replace$(the_sURLData, " ", "+")
' Try to #-encode the string.
' Reserve a buffer. Maximum size is 3 chars for every 1 char in the input string.
nBufferLen = Len(the_sURLData) * 3
sBuffer = Space$(nBufferLen)
If InternetCanonicalizeUrl(StrPtr(the_sURLData), StrPtr(sBuffer), nBufferLen, 0&) Then
UrlEncode = Left$(sBuffer, nBufferLen)
Else
UrlEncode = the_sURLData
End If
End Function