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...
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
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_
