รบกวนสอบถามท่านผู้รู้ทุกท่านครับ VB6 Call PHP ส่งค่าแบบ POST

ption 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