'=============================================================================== ' HttpsPostUrlEncoded 1.0 ' By Brent D. Thorn, Apr. 2013 ' Demonstrates posting an encrypted HTML form with URL encoding using the WinInet API. ' PUBLIC DOMAIN '=============================================================================== ' Post to . server$ = "posttestserver.com" page$ = "/post.php" formdata$ = FormData$( _ FormInp$( "search_keywords", "foo bar" )+_ FormInp$( "search_terms", "any" )+_ FormInp$( "search_author", "" )+_ FormInp$( "search_forum", "-1" )+_ FormInp$( "search_time", "0" )+_ FormInp$( "search_fields", "all" )+_ FormInp$( "search_cat", "-1" )+_ FormInp$( "sort_by", "0" )+_ FormInp$( "sort_dir", "DESC" )+_ FormInp$( "show_results", "posts" )+_ FormInp$( "return_chars", "200" )+_ "" ) Open "wininet" For DLL As #wininet Print HttpsPostUrlEncoded$( server$, 443, page$, formdata$ ) Close #wininet End Function FormData$( FormInp$ ) '-- PURPOSE -------------------------------------------------------------------- ' Cleans up string created by concatenated calls to . '-- PARAMETERS ----------------------------------------------------------------- ' IN FormInp$: String assumed to have been created by concatenated calls to ' . '-- RETURN VALUE --------------------------------------------------------------- ' A string that can be passed to . '------------------------------------------------------------------------------- FormData$ = Mid$(FormInp$, 2) End Function Function FormInp$( Name$, Value$ ) '-- PURPOSE -------------------------------------------------------------------- ' Formats an HTML form's input in URL-encoded form. Meant to be called in a ' chain concatenating the results and passing the full string to for cleanup. '-- PARAMETERS ----------------------------------------------------------------- ' IN Name$: String taken from the NAME attribute of an HTML form's INPUTs, ' OPTIONs, etc. ' IN Value$: String taken from the VALUE attribute of a form's INPUTs, etc. '-- RETURN VALUE --------------------------------------------------------------- ' A string of the form "&Name=Value". '------------------------------------------------------------------------------- FormInp$ = "&" + Name$ + "=" + UrlEncoded$(Value$) End Function Function HttpsPostUrlEncoded$( Server$, Port, Page$, FormData$ ) '-- PURPOSE -------------------------------------------------------------------- ' POSTs URL-encoded data to a server. '-- PARAMETERS ----------------------------------------------------------------- ' IN Server$: String holds a valid Internet domain name or IP address. ' IN Port: Number holds the port on the server listening for HTTPS connect- ' ions in the range of 1 to 65535 (usually 443). ' IN Page$: String holds the path to the script on the server for processing ' form POSTs. Usually taken from the HTML form's ACTION attribute. ' Make sure this path is not relative to a subdirectory. ' IN FormData$: String holds URL-encoded data that should be created using ' and . '-- RETURN VALUE --------------------------------------------------------------- ' Success: A string of data (usually HTML text) returned by the Web server. ' Failure: A string starting with "POSTING ERROR:". '------------------------------------------------------------------------------- USER.AGENT$ = "Mozilla/4.0 (compatible; HttpsPostUrlEncoded 1.0; Windows)" POSTING.ERROR$ = "POSTING ERROR: " hNet = OpenInternet( USER.AGENT$ ) If hNet Then hCon = OpenConnection( hNet, Server$, Port ) If hCon Then hReq = OpenHttpsPostRequest( hCon, Page$ ) If hReq Then headers$ = "Content-Type: application/x-www-form-urlencoded" If HttpSendRequest( hReq, headers$, Len(headers$), FormData$, Len(FormData$) ) Then If Not( ReceiveObject( hReq, HttpsPostUrlEncoded$ )) Then ' Could not receive results. HttpsPostUrlEncoded$ = POSTING.ERROR$ + GetLastError$() End If Else ' Could not send request. HttpsPostUrlEncoded$ = POSTING.ERROR$ + GetLastError$() End If Else ' Could not open POST request. HttpsPostUrlEncoded$ = POSTING.ERROR$ + GetLastError$() End If Else ' Could not open connection. HttpsPostUrlEncoded$ = POSTING.ERROR$ + GetLastError$() End If Else ' Could not access Internet. HttpsPostUrlEncoded$ = POSTING.ERROR$ + GetLastError$() End If ' Close all open handles. If hReq Then Call InternetCloseHandle hReq If hCon Then Call InternetCloseHandle hCon If hNet Then Call InternetCloseHandle hNet End Function Function UrlEncoded$( Text$ ) '-- PURPOSE -------------------------------------------------------------------- ' Converts raw text into URL-encoded format by converting illegal characters ' to equivalent escape codes. Does not do any checking to detect if the data ' is already encoded. '-- PARAMETERS ----------------------------------------------------------------- ' IN Text$: String holds raw text data. '-- RETURN VALUE --------------------------------------------------------------- ' A string of URL-encoded data. '------------------------------------------------------------------------------- For i = 1 To Len(Text$) e$ = Mid$(Text$, i, 1) c = Asc(e$) Select Case c Case 32 ' Space becomes "+". e$ = "+" Case 34, 35, 37, 38, 43, 47, 60, 62, 91, 92, 93, 94, 96, 123, 124, 125 ' ", #, %, &, +, /, <, >, [, \, ], ^, `, {, |, and } get escaped. e$ = "%" + DecHex$(c) Case Else ' Escape control chars and extended ASCII. Select Case Case c < 16: e$ = "%0" + DecHex$(c) Case c < 32, _ c > 126: e$ = "%" + DecHex$(c) End Select End Select UrlEncoded$ = UrlEncoded$ + e$ Next End Function Function OpenInternet( UserAgent$ ) '-- PURPOSE -------------------------------------------------------------------- ' A wrapper for the WinInet InternetOpen API passing some appropriate defaults. '-- PARAMETERS ----------------------------------------------------------------- ' IN UserAgent$: String holds the user agent, identifying the client for the ' server. '-- RETURN VALUE --------------------------------------------------------------- ' Success: Non-zero handle that must be closed by . ' Failure: Zero (0) '------------------------------------------------------------------------------- CallDLL #wininet, "InternetOpenA", _ UserAgent$ As Ptr, _ 4 As ULong, _ 'INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY _NULL As Long, _ _NULL As Long, _ 0 As ULong, _ OpenInternet As ULong End Function Function OpenConnection( hInternet, Server$, Port ) '-- PURPOSE -------------------------------------------------------------------- ' A wrapper for the WinInet InternetConnect API passing some appropriate ' defaults. '-- PARAMETERS ----------------------------------------------------------------- ' IN hInternet: Numeber holds a WinInet handle returned by API InternetOpen. ' IN Server$: String holds a server's Internet domain name or IP address. ' IN Port: Number holds the port on which the server listens for HTTP con- ' nections. Valid from 1 to 65535, but usually 80. '-- RETURN VALUE --------------------------------------------------------------- ' Success: Non-zero handle that must be closed by . ' Failure: Zero (0) '------------------------------------------------------------------------------- CallDLL #wininet, "InternetConnectA", _ hInternet As ULong, _ Server$ As Ptr, _ Port As Word, _ "" As Ptr, _ ' user name "" As Ptr, _ ' password 3 As ULong, _ 'INTERNET_SERVICE_HTTP 0 As ULong, _ 0 As ULong, _ OpenConnection As ULong End Function Function OpenHttpsPostRequest( hConnect, Action$ ) '-- PURPOSE -------------------------------------------------------------------- ' Opens a request with the server to post data. It is a wrapper for the Win- ' Inet HttpOpenRequest API passing some appropriate defaults. '-- PARAMETERS ----------------------------------------------------------------- ' IN hConnect: Number holds a handle to a connection created with the ' WinInet InternetConnect API. ' IN Action$: String holds the path to a script residing on the server that ' is capable of processing an HTML form POST request. This is usually ' taken from the form's ACTION attribute. It must not be relative to ' a subdirectory. '-- RETURN VALUE --------------------------------------------------------------- ' Success: Non-zero handle that must be closed by . ' Failure: Zero (0) '------------------------------------------------------------------------------- ' Create an array of strings for "accept types" Struct local1, _ type1 As Ptr, _ null As Long local1.type1.struct = "*/*" ' accept all types flags = HexDec("80800100") 'INTERNET_FLAG_SECURE|INTERNET_FLAG_RELOAD|INTERNET_COOKIE_P3P_ENABLED CallDLL #wininet, "HttpOpenRequestA", _ hConnect As ULong, _ "POST" As Ptr, _ Action$ As Ptr, _ _NULL As Long, _ ' HTTP/1.1 _NULL As Long, _ ' referrer local1 As Struct, _ ' accept types flags As ULong, _ _NULL As ULong, _ OpenHttpsPostRequest As ULong End Function Function HttpSendRequest( hRequest, Headers$, HeadersLen, Optional$, OptionalLen ) '-- PURPOSE -------------------------------------------------------------------- ' A thin wrapper for the WinInet HttpSendRequest API. '-- PARAMETERS ----------------------------------------------------------------- ' IN hRequest: Number (handle) returned by the WinInet HttpOpenRequest API. ' IN Headers$: String holds a list of HTTP headers separated with carriage ' return/linefeed pairs (i.e. "Chr$(13) + Chr$(10)"). ' IN HeadersLen: Number holds the length of the headers string (i.e. ' "Len(Headers$)"). ' IN Optional$: String holds (usually) optional data. POSTed data is not ' optional, however. ' IN OptionalLen: Number holds the length of the data string (i.e. ' "Len(Optional$)"). '-- RETURN VALUE --------------------------------------------------------------- ' Success: Non-zero (i.e. TRUE) ' Failure: Zero (i.e. FALSE) '------------------------------------------------------------------------------- CallDLL #wininet, "HttpSendRequestA", _ hRequest As ULong, _ Headers$ As Ptr, _ HeadersLen As ULong, _ Optional$ As Ptr, _ OptionalLen As ULong, _ HttpSendRequest As Long End Function Function ReceiveObject( hRequest, ByRef retObject$ ) '-- PURPOSE -------------------------------------------------------------------- ' Receives data from the server following an HTTP request to the server. '-- PARAMETERS ----------------------------------------------------------------- ' IN hRequest: Number holds a handle created by WinInet HttpOpenRequest API. ' OUT retObject$: String receives the data from the request. Could hold ' partial data if a failure occurs. '-- RETURN VALUE --------------------------------------------------------------- ' Success: A non-zero (i.e. TRUE) ' Failure: Zero (i.e. FALSE) '------------------------------------------------------------------------------- CHUNK.SIZE = 256 Struct local1, NumberOfBytesRead As ULong chunk$ = Space$(CHUNK.SIZE) retObject$ = "" Do CallDLL #wininet, "InternetReadFile", _ hRequest As ULong, _ chunk$ As Ptr, _ CHUNK.SIZE As ULong, _ local1 As Struct, _ ret As Long cbRead = local1.NumberOfBytesRead.struct If ret = 0 Or cbRead = 0 Then Exit Do retObject$ = retObject$ + Left$(chunk$, cbRead) Loop While 1 ReceiveObject = ret End Function Sub InternetCloseHandle hInternet '-- PURPOSE -------------------------------------------------------------------- ' A wrapper for the WinInet InternetCloseHandle API ignoring the return value. '-- PARAMETERS ----------------------------------------------------------------- ' IN hInternet: Number holds any handle returned by a WinInet API. '------------------------------------------------------------------------------- CallDLL #wininet, "InternetCloseHandle", _ hInternet As ULong, _ ret As Long End Sub Function GetLastError$() '-- PURPOSE -------------------------------------------------------------------- ' Gets the last Windows error code and formats some text that describes the ' error in the user's native language. '-- RETURN VALUE --------------------------------------------------------------- ' A string holding an error message meant to be presented to a user. '------------------------------------------------------------------------------- ' Get last error's code. CallDLL #kernel32, "GetLastError", _ nErr As ULong nSize = 1024 buffer$ = Space$(nSize) ' Fill buffer with error message text. CallDLL #kernel32, "FormatMessageA", _ _FORMAT_MESSAGE_FROM_SYSTEM As ULong, _ _NULL As ULong, _ nErr As ULong, _ 0 As ULong, _ buffer$ As Ptr, _ nSize As ULong, _ _NULL As ULong, _ nSize As ULong ' purposely reusing variable GetLastError$ = Left$(buffer$, nSize) End Function