Announcement

**Paul Purvis** · 30 Mar 2008, 05:37 PM

here is my latest program
this is not a proxy server, i just gave it a bad name in the beginning, sorry.
this program uses pb tcp routines to be a server in a certain kind of way.
the program was intended to capture web sites visited

i have been running this program this way
use firefox and make the change inside the firefox program of the network setting and use the manual proxy configuration, change the http proxy address to the ip address of your computer, probably 127.0.0.1 will work, but i just use my static ip address i have set on my computer and port 998, then i close firefox, then use ccleaner to wipe out firefox's cache, then restart firefox, while this program is running.

this program show l a few things
using Paul Roberts code that was altered by John Gleason, timing of data transfers, the speed at which packets are sent or received, which was interesting in of itself.
this program can also be used to capture http headers if code is place in it to read that, very easy to do. i believe this is the code
sheader=mid$(spacket,instr(spacket,$CRLF+$CRLF)+3) ' that would go just before the line "serverlocation=lcase$"

in this program, rather than gathering all the received data from the website into one large string then sending that string back to the requesting web browser, i found it much better to send the received data back to the web browser as it was received from the website and if for no other reason, just to keep the connection alive to the client(web browser)

in using this program, it fails, if you try to login to a website. i have only tried on the powerbasic website and none others, but on some web servers, it might be possible.
but just for plain old web browsing, this program works ok, but not what i wanted in the end. i need a better way to receive data from the web site requuested.

in changing the performance or where the program may stop, you can try changing the blocksize(used for receiving packets from a web site) and the timeout value (where the tcp open statement is used to connect to a website)
by changing blocksize to 256 improves stability but decreases total transfer speed(more data transfers, more cpu instructions,etc). i found a blocksize of 1024 to be the next most stable blocksize to use and i have set that in the program.

for timeout, if the timeout can be set to 1500 to 2000, the program will run faster, by may timeout, crashing your connection to the web site, i found out for the powerbasic website a setting of 5000 is just about right. sounds like the three little bears doesn't it.

anyway here it is,
i am sure i will work on it more.

the long variable gquiet is used for toggling display setting, if set to 1 will cause the program to display information and naturally a value of 0 is suppose to stop all display.

again i suggest firefox for doing testing with this program, because you can change the network configuration easily without requiring a reboot.

code and exe at http://pdptemp.dyndns.org/zipcode/proxy
it is proxy7

Code:

'proxy7.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"
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 = USING$(f,(qStop - qStart - qOverhead)*1000000/qFreq /1000) + " 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
$endofhtml="</HTML"



GLOBAL ghproxyclient    AS LONG
GLOBAL hwebpage    AS LONG
GLOBAL hServer  AS LONG
GLOBAL hwndTCP  AS LONG
GLOBAL hThread  AS LONG
GLOBAL GQUIET AS LONG

FUNCTION mythread(BYVAL a AS LONG) AS LONG
LOCAL temp AS STRING
getagain:
TCP RECV a,4096,temp
IF LEN(temp)<>0& THEN GOTO getagain
TCP CLOSE a
END FUNCTION

FUNCTION webtoclient(BYREF hproxyclient AS LONG) AS LONG
 LOCAL  sBuffer AS STRING
 LOCAL  sPacket AS STRING
 LOCAL serverlocation, buffer,received AS STRING
 LOCAL receivedcount AS LONG
 LOCAL blocksize AS LONG
 LOCAL temp AS LONG
ontimer
   sPacket = ""
   sbuffer = ""
   DO
   TCP RECV hproxyclient, 4096*2, sBuffer
   sPacket = sPacket & sBuffer
   LOOP UNTIL ISTRUE EOF(hproxyclient) OR ISTRUE ERR OR sBuffer = ""
   IF GQUIET THEN STDOUT "client received"
   IF LEN(spacket)=0& THEN EXIT FUNCTION

   IF LEN(spacket) THEN
    serverlocation=LCASE$(MID$(spacket,12,INSTR(6,spacket, " HTTP/")-13))
      IF TALLY(serverlocation,"/") THEN  serverlocation=MID$(serverlocation,1,INSTR(serverlocation, "/")-1)
    ERRCLEAR
     IF GQUIET THEN STDOUT serverlocation
   '  IF tally("SB.GOOGLE.COM IMG.YOUTUBE.COM",UCASE$(SERVERLOCATION)) THEN SERVERLOCATION="pdptemp.dyndns.org":EXIT FUNCTION

         hwebpage=FREEFILE
         IF GQUIET THEN STDOUT "trying to connect"+STR$(hwebpage)
         IF GQUIET THEN STDOUT "webpage file number"+STR$(hwebpage)
         TCP OPEN PORT 80 AT TRIM$(serverlocation) AS #hwebpage TIMEOUT 2500   'Open server
         TCP PRINT hwebpage, spacket
         IF GQUIET THEN STDOUT "packet sent to web"
                   IF GQUIET THEN  STDOUT "sent to web server"
                    received=""
                    receivedcount=0&
                    BLOCKSIZE=1024

                    'read first block of the received web page
                    INCR receivedcount:IF GQUIET THEN STDOUT "    pactet number = "+STR$(receivedcount)
                    IF GQUIET THEN gotimer
                    TCP RECV hwebpage,BLOCKSIZE,buffer
                    IF GQUIET THEN stoptimer
                    IF GQUIET THEN STDOUT                    "web received time = "+showtimer
                   ' gotimer
                    TCP SEND hproxyclient, buffer
                   ' stoptimer
                   ' STDOUT "timer "+showtimer
                    IF GQUIET THEN  STDOUT                   "      packet size = "+STR$(LEN(buffer))
                 
            
                    DO
                    IF LEN(buffer)<blocksize THEN EXIT DO
                    INCR receivedcount:IF GQUIET THEN STDOUT "    packet number = "+STR$(receivedcount)
                    IF GQUIET THEN gotimer
                    TCP RECV hwebpage,BLOCKSIZE,buffer
                    IF GQUIET THEN stoptimer
                    IF GQUIET THEN STDOUT                    "web received time = "+showtimer

                    IF GQUIET THEN  STDOUT                   "      packet size = "+STR$(LEN(buffer))
                    IF LEN(buffer)=0& THEN EXIT DO
                    IF ERR THEN EXIT DO
                    SLEEP 1
                   ' gotimer
                    TCP SEND hproxyclient, buffer
                   ' stoptimer
                   ' STDOUT "timer "+showtimer
                    LOOP


                    endofreadingweb:
                    IF GQUIET THEN  STDOUT "done web server reading"

                   ' tcp close hwebpage
                   ' tcp close hproxyclient
                  'IF GQUIET THEN STDOUT "closed connection to webserver"

         END IF
END FUNCTION

FUNCTION threadwebtoclient(BYVAL x AS LONG) AS LONG
webtoclient(x)

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"+STR$(ghproxyclient)
            threadwebtoclient(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=1&
    CONSOLE SCREEN 51,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

**Paul Purvis** · 1 Apr 2008, 04:27 AM

much faster but does not display pictures.
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

Announcement

working on a http proxy

working on a http proxy

Comment

Comment