VB6 — using POST & GET from URL and displaying in VB6 Form

我与影子孤独终老i 提交于 2020-01-23 04:08:29

问题


How can my VB6 form POST 2 vars, pull the results from a URL and then assign a VB6 var to the results?

I need someone to show me VERY basic VB6 sample code or point me in the right direction. This is the simplest form - in the final product, the PHP vars will write to MySQL, but that's not what i need help with.

I have a simple PHP page that accepts 2 parameters:

test.php?var1=secret&var2=pass

Here's my really simple PHP code

<?php

$var1 = $_GET['var1'];
$var2 = $_GET['var2'];

$varAcc = "ACCEPTED";
$varDen = "DENIED";

if ($var1 === "secret" && $var2 === "pass")
  {
   echo $varAcc;
  }
else
  {
   echo $varDen;
  }
?>

The logic behind this is gonna be VB6 login with "userName", "passWord" and "hardWareID", and send a hash. The hash will be checked against MySQL to see whether it exists, and returns YES or NO for access, how many days left on their account, and some other details, like FULL NAME, ACCOUNT INFO, etc.

( NO.. I do not want to use XML, just thought i would put that out there.. Just POST & Receive to vars)

Thank You...


回答1:


If you must use POST, then you will have to use the Internet Transfer Control. In the VB6 IDE, press CTL-T, and select "Microsoft Internet Transfer Control 6.0". Press Ok.

Add an instance of the control to the form. Call it "Inet". Add a CommandButton called "cmdPost" to the form. Add a reference to "Microsoft Scripting Runtime" (see the menu Project=>References).

Add the following code to your form:

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



回答2:


VB forms don't have any built-in mechanism for sending HTTP requests. Some may suggest you use the Internet Transfer Control. However, the VB UserControl has a mechanism for HTTP that you can use without the need for third party controls, assuming you use the GET method, and use the query string to pass your parameters. If you have to use POST, you must use the Internet Transfer Control.

Create a VB project with a reference to "Microsoft Scripting Runtime" (see the menu Project=>References). Add a UserControl. Call it "HttpService". Set InvisibleAtRuntime=True. Add the following code to the UserControl:

Option Explicit

Private Const m_ksProperty_Default              As String = ""

Private m_sHost                                 As String
Private m_nPort                                 As Long
Private m_sPath                                 As String
Private m_dctQueryStringParameters              As Scripting.Dictionary

Private m_sOutput                               As String

' Ensure that all parts of the query string are deleted.
Public Sub ClearQueryString()

    Set m_dctQueryStringParameters = New Scripting.Dictionary

End Sub

' Executes "GET" method for URL.
Public Function Get_() As String

    ' Read in data from URL. UserControl_AsyncReadComplete will fire when finished.
    UserControl.AsyncRead "http://" & m_sHost & ":" & CStr(m_nPort) & "" & m_sPath & "?" & GetQueryString(), vbAsyncTypeByteArray, m_ksProperty_Default, vbAsyncReadSynchronousDownload

    ' Return the contents of the buffer.
    Get_ = m_sOutput

    ' Clear down state.
    m_sOutput = vbNullString

End Function

' Returns query string based on dictionary.
Private Function GetQueryString() As String

    Dim vName                                   As Variant
    Dim sQueryString                            As String

    For Each vName In m_dctQueryStringParameters
        sQueryString = sQueryString & CStr(vName) & "=" & m_dctQueryStringParameters.Item(vName) & "&"
    Next vName

    GetQueryString = Left$(sQueryString, Len(sQueryString) - 1)

End Function

' Sets the remote host.
Public Property Let Host(ByVal the_sValue As String)

    m_sHost = the_sValue

End Property

' Sets the directory and filename part of the URL.
Public Property Let Path(ByVal the_sValue As String)

    m_sPath = the_sValue

End Property

' Sets the port number for this request.
Public Property Let Port(ByVal the_nValue As Long)

    m_nPort = the_nValue

End Property

' Sets a name/value pair in the query string. Supports duplicate names.
Public Property Let QueryStringParameter(ByVal the_sName As String, ByVal the_sValue As String)

    m_dctQueryStringParameters.Item(the_sName) = the_sValue

End Property

' Fired when the download is complete.
Private Sub UserControl_AsyncReadComplete(AsyncProp As AsyncProperty)

    ' Gets the data from the internet transfer.
    m_sOutput = StrConv(AsyncProp.Value, vbUnicode)

End Sub

Private Sub UserControl_Initialize()

    ' Initialises the scripting dictionary.
    Set m_dctQueryStringParameters = New Scripting.Dictionary

End Sub

To use this UserControl, add it to your form. Call it "HttpService". Add a TextBox called "txtOutput" to test the following code on the form:

HttpService.Host = "localhost"
HttpService.Port = 80
HttpService.Path = "/test.php"
HttpService.QueryStringParameter("var1") = "secret"
HttpService.QueryStringParameter("var2") = "pass"

txtOutput.Text = HttpService.Get_


来源:https://stackoverflow.com/questions/15710181/vb6-using-post-get-from-url-and-displaying-in-vb6-form

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!