using wininet to down load webpages
also cannot get make program login to powerbasic website.
Code:
' change GQUIET to 1 to get many display messages in pbmain at the bottom of program listing
' if this program runs in guiet mode(GQUIET=0&) then the brower will run faster
'proxy13.bas
'compiled with pbcc 4.04
#COMPILE EXE
#DIM ALL
%CCWIN = 1 ' Include GUI API calls
%USEMACROS = 1
#INCLUDE "WIN32API.INC"
#INCLUDE "WS2_32.INC"
#INCLUDE "WININET.INC"
DECLARE FUNCTION QueryPerformanceCounter LIB "KERNEL32.DLL" ALIAS "QueryPerformanceCounter" (lpPerformanceCount AS QUAD) AS LONG
DECLARE FUNCTION QueryPerformanceFrequency LIB "KERNEL32.DLL" ALIAS "QueryPerformanceFrequency" (lpFrequency AS QUAD) AS LONG
'~~~~~~~~~~~A Variation of Dave Roberts' MACRO Timer~~~~~~~~~~~~~~~~~~~~~~~
MACRO onTimer
LOCAL qFreq, qOverhead, qStart, qStop AS QUAD
LOCAL f AS STRING
f = "#.###"
QueryPerformanceFrequency qFreq
QueryPerformanceCounter qStart ' Intel suggestion. First use may be suspect
QueryPerformanceCounter qStart ' So, wack it twice <smile>
QueryPerformanceCounter qStop
qOverhead = qStop - qStart ' Relatively small
END MACRO
MACRO goTimer = QueryPerformanceCounter qStart
MACRO stopTimer = QueryPerformanceCounter qStop
MACRO showTimer = RSET$(USING$(f,(qStop - qStart - qOverhead)*1000000/qFreq /1000),10) + " milliseconds"
%TCP_ACCEPT = %WM_USER + 4093 ' Any value larger than %WM_USER + 500
%TCP_proxy = %WM_USER + 4094 ' Any value larger than %WM_USER + 500
GLOBAL ghproxyclient AS LONG
GLOBAL hwebpage AS LONG
GLOBAL hServer AS LONG
GLOBAL hwndTCP AS LONG
GLOBAL hThread AS LONG
GLOBAL GQUIET AS LONG
%HTTP_BUFFER_LENGTH=256 '16000
FUNCTION WEBREQUEST(clientpacket AS STRING) AS STRING
LOCAL I AS LONG
DIM apacketheader() AS STRING
LOCAL lheaderarraycount AS LONG
LOCAL sheader AS STRING
LOCAL sweburl AS STRING
LOCAL sfirstlineofheader AS STRING
LOCAL sfullheader AS STRING
LOCAL sversion AS STRING
LOCAL sPostData AS STRING
LOCAL sreferer AS STRING
LOCAL smethod AS STRING
LOCAL sformdata AS STRING
LOCAL spath AS STRING
LOCAL saccept AS STRING
LOCAL tempstr AS STRING
LOCAL hInternet AS DWORD
LOCAL hSession AS DWORD
LOCAL hRequest AS DWORD
LOCAL zHeader AS ASCIIZ*3000
LOCAL ZMethod AS ASCIIZ*%MAX_PATH
LOCAL zweburl AS ASCIIZ*%MAX_PATH
LOCAL zPath AS ASCIIZ * 255
LOCAL zVersion AS ASCIIZ * 15
LOCAL zReferer AS ASCIIZ * 255
' LOCAL zAccept AS ASCIIZ * 255
REM---------------------------------------------------------------------------------------------
'sfullheader is the full header without the ending doublel crlf's , it used for parsing out later
sfullheader=TRIM$(MID$(clientpacket,1,INSTR(1,clientpacket, $CRLF+$CRLF)-1))
lheaderarraycount=PARSECOUNT(sfullheader,$CRLF)
REDIM apacketheader(1& TO lheaderarraycount)
PARSE sfullheader,apacketheader(),$CRLF
IF GQUIET THEN
FOR I=1& TO lheaderarraycount
STDOUT apacketheader(I)
NEXT I
END IF
'sformdata is any data following the headers
sformdata=RIGHT$(clientpacket,LEN(clientpacket)-(LEN(sfullheader)+4&))
sfirstlineofheader=apacketheader(1&)
'sversion = should equal http1/1 or http1/1
tempstr=RIGHT$(sfirstlineofheader,LEN(sfirstlineofheader)-INSTR(-1&,sfirstlineofheader," "))
sversion=LEFT$(tempstr,LEN(tempstr)-2&)
'sweburl is the url name example www.google.com
sweburl=TRIM$(MID$(sfirstlineofheader,12&,INSTR(6&,sfirstlineofheader, " HTTP/")-13&))
IF TALLY(sweburl,"/") THEN
sweburl=MID$(sweburl,1&,INSTR(sweburl, "/")-1&)
END IF
'smethod is usually GET OR POST OR HEAD
smethod=MID$(sfirstlineofheader,1&,INSTR(clientpacket," ")-1&)
'spath is string of any character past the url in the first line of the header
I=INSTR(-1&,UCASE$(sfirstlineofheader),"HTTP")
Spath=TRIM$(MID$(sfirstlineofheader,INSTR(LEN(smethod)+9&,sfirstlineofheader,"/")+1&,I-1&-INSTR(LEN(smethod)+9&,sfirstlineofheader,"/")))
FOR I=2& TO lheaderarraycount
IF LEFT$(UCASE$(apacketheader(I)),9&)="REFERER: " THEN sreferer=RIGHT$(apacketheader(I),LEN(apacketheader(I))-9)
IF LEFT$(UCASE$(apacketheader(I)),8&)="ACCEPT: " THEN saccept=RIGHT$(apacketheader(I),LEN(apacketheader(I))-8)
NEXT I
'build a new header
sHeader ="User-Agent: AGENT/2.0.0.12"
FOR I=2& TO lheaderarraycount
IF LEN(TRIM$(Apacketheader(i)))=0& THEN ITERATE FOR
'IF LEFT$(UCASE$(apacketheader(I)),6&)="HOST: " THEN ITERATE FOR
IF LEFT$(UCASE$(apacketheader(I)),12&)="USER-AGENT: " THEN ITERATE FOR
'IF LEFT$(UCASE$(apacketheader(I)),9&)="REFERER: " THEN ITERATE FOR
sheader=sheader+$CRLF+apacketheader(I)
NEXT I
sheader=sheader+$CRLF+"Cache-Control: max-age=0"'+$crlf+$crlf
IF GQUIET THEN
STDOUT "-----header----------------"
STDOUT sheader
STDOUT "----------------------"
END IF
zheader=sheader
zversion=sversion
zmethod=smethod
zweburl=sweburl
zreferer=sreferer
IF LEN(spath)>0& THEN zpath="/"+spath
hInternet = InternetOpen(BYVAL %NULL, %INTERNET_OPEN_TYPE_PRECONFIG, BYVAL %NULL, BYVAL %NULL, 0)
IF hInternet = 0 THEN
STDOUT "InternetOpen failed"
GOTO Finish
END IF
' STDOUT "internet open"
hsession = InternetConnect(hInternet, zweburl, 80, "", "", %INTERNET_SERVICE_HTTP, 0, 0)
IF hsession = 0 THEN
STDOUT "InternetConnect failed"
GOTO Finish
END IF
IF GQUIET THEN STDOUT "connected to web"
hRequest = httpOpenRequest(hsession, zmethod, zpath, zversion, zreferer, BYVAL %NULL,%INTERNET_FLAG_RELOAD, %null)
' other options that i do not know what they do
' %INTERNET_FLAG_RELOAD OR _
' %INTERNET_FLAG_NO_CACHE_WRITE OR _
' %INTERNET_FLAG_PRAGMA_NOCACHE OR _
' %INTERNET_FLAG_EXISTING_CONNECT, %null)
' %INTERNET_FLAG_NO_AUTH or _
' %INTERNET_FLAG_NO_CACHE_WRITE or _
' %INTERNET_FLAG_SECURE or _
' %INTERNET_FLAG_IGNORE_CERT_DATE_INVALID or _
' %INTERNET_FLAG_IGNORE_CERT_CN_INVALID _
' %INTERNET_FLAG_RELOAD _
IF hRequest = 0 THEN
STDOUT "httpOpenRequest failed."
GOTO Finish
END IF
' i saw in poffs where this helped somebody but i do not see any differences in improving this program
' i = HttpAddRequestHeaders( hrequest, zHeader, -1&, _
' %HTTP_ADDREQ_FLAG_REPLACE OR %HTTP_ADDREQ_FLAG_ADD)
IF httpSendRequest(hRequest, zheader,LEN(zheader), BYVAL STRPTR(sformdata), LEN(sformdata)) = 0 THEN
STDOUT "httpSendRequest failed."
GOTO Finish
END IF
LOCAL ssBuffer AS ASCIIZ * 50001
LOCAL iiResult AS INTEGER
LOCAL sData AS STRING
LOCAL llReturn AS DWORD
LOCAL dwBufferLength AS DWORD
sdata=""
IF hInternet THEN
dwBufferLength = 4096
iiResult = InternetReadFile(hrequest,BYVAL VARPTR(ssBuffer), 4096, llReturn)
sData = ssBuffer
DO WHILE llReturn > 0& AND iiResult > 0&
iiResult = InternetReadFile( hrequest, BYVAL VARPTR(ssBuffer) , 4096, llReturn)
sData = sData + MID$(ssBuffer, 1&, llReturn)
LOOP
END IF
FUNCTION = sDATA
Finish:
IF hRequest<>0 THEN InternetCloseHandle hRequest
IF hsession<>0 THEN InternetCloseHandle hsession
IF hInternet<>0 THEN InternetCloseHandle hInternet
finish2:
END FUNCTION
FUNCTION webtoclient(BYREF hproxyclient AS LONG) AS LONG
LOCAL sBuffer AS STRING
LOCAL sPacket AS STRING
LOCAL webreceiveddata AS STRING
ontimer
sPacket = ""
sbuffer = ""
DO
SLEEP 1
TCP RECV hproxyclient, 1024, sBuffer
SLEEP 1
sPacket = sPacket & sBuffer
LOOP UNTIL ISTRUE EOF(hproxyclient) OR ISTRUE ERR OR sBuffer = ""
IF GQUIET THEN STDOUT "client-received data"
IF LEN(spacket)=0& THEN
IF GQUIET THEN STDOUT "client-received data is empty"
EXIT FUNCTION
END IF
IF LEN(spacket) THEN
webreceiveddata=webrequest(spacket)
TCP SEND hproxyclient, TRIM$(webreceiveddata)
TCP CLOSE hproxyclient
EXIT FUNCTION
END IF
END FUNCTION
' Callback function to handle events for the GUI window
FUNCTION TcpProc (BYVAL hWnd AS LONG, BYVAL wMsg AS LONG, _
BYVAL wParam AS LONG, BYVAL lParam AS LONG) EXPORT AS LONG
STATIC hServer AS LONG
LOCAL hfoo AS LONG
LOCAL lresult AS LONG
SELECT CASE wMsg
CASE %WM_CREATE
hServer = FREEFILE
TCP OPEN SERVER PORT 998 AS hServer TIMEOUT 60000
IF ERR THEN
STDOUT "proxy Couldn't create socket!"
ELSE
TCP NOTIFY hServer, ACCEPT TO hWnd AS %TCP_ACCEPT
STDOUT "proxy Connected to Port 998"
END IF
ghproxyclient = %INVALID_SOCKET
FUNCTION = 1
CASE %TCP_ACCEPT
SELECT CASE LO(WORD, lParam)
CASE %FD_ACCEPT
TCP CLOSE ghproxyclient
ghproxyclient = FREEFILE
TCP ACCEPT hServer AS ghproxyclient
TCP NOTIFY ghproxyclient, RECV CLOSE TO hWnd AS %TCP_proxy
END SELECT
FUNCTION = 1
CASE %TCP_proxy
SELECT CASE LO(WORD, lParam)
CASE %FD_READ
IF ghproxyclient <> %INVALID_SOCKET THEN
IF GQUIET THEN STDOUT "proxy client connected"+STR$(ghproxyclient)
webtoclient(ghproxyclient)
END IF
CASE %FD_CLOSE
TCP CLOSE ghproxyclient
ghproxyclient = %INVALID_SOCKET
END SELECT
FUNCTION = 1
CASE %WM_DESTROY
TCP CLOSE hServer
END SELECT
FUNCTION = DefWindowProc(hWnd, wMsg, wParam, lParam)
END FUNCTION
'------------------------------------------------------------------------------
' Create the GUI window to receive TCP event notification messages
'
FUNCTION MakeWindow () AS LONG
LOCAL wce AS WndClassEx
LOCAL szClassName AS ASCIIZ * 64
LOCAL hWnd AS LONG
LOCAL hInst AS LONG
STATIC registered AS LONG
hInst = GetModuleHandle(BYVAL %NULL)
IF ISFALSE registered THEN
szClassName = "PBTCPCOMM"
wce.cbSize = SIZEOF(wce)
wce.style = %CS_HREDRAW OR %CS_VREDRAW
wce.lpfnWndProc = CODEPTR(TcpProc)
wce.cbClsExtra = 0
wce.cbWndExtra = 0
wce.hInstance = hInst
wce.hIcon = %NULL
wce.hCursor = %NULL
wce.hbrBackground = %NULL
wce.lpszMenuName = %NULL
wce.lpszClassName = VARPTR(szClassName)
wce.hIconSm = %NULL
RegisterClassEx wce
registered = %TRUE
END IF
hWnd = CreateWindow(szClassName, _
"TCP Handler", _
%WS_OVERLAPPEDWINDOW, _
5, 5, 10, 10, _
%NULL, _
%NULL, _
hInst, _
BYVAL %NULL)
IF ISFALSE hWnd THEN
hWnd = GetLastError
ELSE
ShowWindow hWnd, %SW_HIDE
UpdateWindow hWnd
END IF
FUNCTION = hWnd
END FUNCTION
'------------------------------------------------------------------------------
' Spawn a thread to create/own the GUI window and run a thread message pump.
' Each thread must operate it's own pump the GUI windows it owns.
'
FUNCTION WindowThread (BYVAL nIgnored AS LONG) AS LONG
LOCAL Msg AS tagMsg
hwndTCP = MakeWindow
DO WHILE IsWindow(hwndTCP) AND GetMessage(Msg, %NULL, 0, 0)
TranslateMessage Msg
DispatchMessage Msg
LOOP
END FUNCTION
'------------------------------------------------------------------------------
' Main program entry point...
'
FUNCTION PBMAIN () AS LONG
GQUIET=0&
CONSOLE SCREEN 46,80
' CONSOLE SET VIRTUAL 500,80
' Process socket messages in a separate thread
THREAD CREATE WindowThread(%NULL) TO hThread
' If the user presses the Esc key, exit the server
PRINT "Press ESC to end the proxy Server"
DO
' UNTIL WAITKEY$ = $ESC
SLEEP 100
LOOP
SendMessage hwndTCP, %WM_CLOSE, 0, 0
END FUNCTION
Leave a comment: