' WebServ 0.9 beta (c)2006 Mike Chambers
' Simple single-threaded web server written in QuickBASIC.
' Visit http://rubbermallet.org for updated
'
' QB must be loaded with QB.QLB quicklibrary like this:
' QB.EXE /L QB.QLB
TYPE Registers
ax AS INTEGER
bx AS INTEGER
cx AS INTEGER
dx AS INTEGER
bp AS INTEGER
si AS INTEGER
di AS INTEGER
flags AS INTEGER
ds AS INTEGER
es AS INTEGER
END TYPE
'Define custom data type for nTCP-related data.
TYPE nTCP
Enabled AS INTEGER
IntVector AS INTEGER
ErrorCode AS INTEGER
LocalIP AS LONG
LocalNetmask AS LONG
LocalGateway AS LONG
LocalDNS AS LONG
LocalDomain AS STRING * 256
DomainLen AS INTEGER
Timeserver AS LONG
MTU AS INTEGER
TTL AS INTEGER
TOS AS INTEGER
MSS AS INTEGER
RWIN AS INTEGER
FreeInputPkts AS INTEGER
FreeOutputPkts AS INTEGER
Timeout AS INTEGER
END TYPE
'Define custom error type constants and other frequently used values.
CONST errBadCall = 1
CONST errCritical = 2
CONST errNoHandles = 3
CONST errBadHandle = 4
CONST errTimeout = 5
CONST errBadSession = 6
CONST sckListening = 1
CONST sckOpen = 4
CONST sckClosed = 7
DECLARE FUNCTION Conv2IP$ (DWord AS LONG)
DECLARE FUNCTION Conv2DWord$ (inString AS STRING)
DECLARE FUNCTION HighByte% (Word AS INTEGER)
DECLARE FUNCTION LowByte% (Word AS INTEGER)
'IMPORTANT: DO NOT USE THE tcpFindInt FUNCTION AS IT IS NOW!
'IT DOES NOT WORK RIGHT. I AM WORKING ON IT.
DECLARE FUNCTION tcpFindInt% (startSegment AS INTEGER, endSegment AS INTEGER)
DECLARE FUNCTION tcpInit% (Vector AS INTEGER)
DECLARE FUNCTION tcpConnect% (RemoteIP AS STRING, RemotePort AS INTEGER)
DECLARE FUNCTION tcpStatus% (tcpHandle AS INTEGER)
DECLARE FUNCTION MakeReg% (h AS INTEGER, l AS INTEGER)
DECLARE FUNCTION tcpListen% (ListenPort AS INTEGER)
DECLARE SUB AddBuffer (textadd AS STRING)
DECLARE SUB DrawScreen ()
DECLARE SUB tcpUnload ()
DECLARE SUB tcpSetTimeout (TimeoutSeconds AS INTEGER)
DECLARE SUB RegBlank ()
DECLARE FUNCTION tcpGetData$ (tcpHandle AS INTEGER)
DECLARE SUB tcpClose (tcpHandle AS INTEGER)
DECLARE FUNCTION tcpInBuffer% (tcpHandle AS INTEGER)
DECLARE FUNCTION tcpInputQueue% (tcpHandle AS INTEGER)
DECLARE FUNCTION tcpRemoteIP$ (tcpHandle AS INTEGER)
DECLARE SUB tcpSendData (tcpHandle AS INTEGER, Data2Send AS STRING)
DECLARE SUB tcpDoIO ()
DECLARE SUB showErrorMsg ()
DECLARE SUB interruptx (intnum AS INTEGER, inreg AS Registers, outreg AS Registers)
'The debugShowReturn subroutine simply prints all the register values
'stored in tcpReturn to the screen. You really shouldn't have any reason
'to use it unless you are curious about the specifics behind NTCPDRV.
'It is mainly here for my own purposes.
DECLARE SUB debugShowReturn ()
DEFINT A-Z
'Dimension variables that are shared between all subroutines and functions.
DIM SHARED tcpCall AS Registers
DIM SHARED tcpReturn AS Registers
DIM SHARED tcpDriver AS nTCP
DIM SHARED isActive AS INTEGER
DIM SHARED strGetData AS STRING * 1500
DIM SHARED strSendData AS STRING * 1500
DIM SHARED mime(1 TO 100, 1 TO 2) AS STRING
DIM SHARED mimetotal AS INTEGER
DIM SHARED stat(0 TO 1) AS STRING
DIM SHARED scrlog(0 TO 17) AS STRING
DIM SHARED logfile$
'This makes all CPU-blocking calls timeout after 5 seconds.
tcpSetTimeout 5
SCREEN 0: WIDTH 80, 25: CLS
logfile$ = "%none"
AddBuffer "---------------------------------------"
AddBuffer "WebServ v0.9 beta (c)2006 Mike Chambers"
AddBuffer "http://www.rubbermallet.org"
AddBuffer "---------------------------------------"
AddBuffer "Please direct all bug reports to: half_eaten@yahoo.com"
AddBuffer ""
AddBuffer "Loading WEBSERV.INI configuration..."
DrawScreen
OPEN "WEBSERV.INI" FOR BINARY AS #1: filsiz = LOF(1): CLOSE #1
IF filsiz = 0 THEN
AddBuffer "FATAL ERROR: Can't find configuration!"
AddBuffer "Press any key to quit to DOS..."
DO: LOOP UNTIL INKEY$ <> ""
COLOR 7, 0: CLS : END
END IF
OPEN "WEBSERV.INI" FOR INPUT AS #1
mimenum = 1
DO UNTIL EOF(1)
INPUT #1, directive$
IF LEFT$(directive$, 1) <> "#" THEN
SELECT CASE LCASE$(directive$)
CASE "tcpvector"
LINE INPUT #1, vect$
tcpVect% = VAL("&H" + vect$)
AddBuffer "Using TCPDRV interrupt vector " + HEX$(tcpVect%) + "h."
CASE "folder"
LINE INPUT #1, htdocs$
AddBuffer "Using documents folder " + htdocs$
CASE "port"
INPUT #1, portnr%
AddBuffer "Serving on port" + STR$(portnr%) + "."
CASE "logfile"
LINE INPUT #1, logtemp$
AddBuffer "Using output text log file " + logtemp$
CASE "mime"
INPUT #1, fileext$
LINE INPUT #1, mimename$
'AddBuffer "Adding mimetype: " + fileext$ + " = " + mimename$
mime(mimenum, 1) = fileext$
mime(mimenum, 2) = mimename$
mimenum = mimenum + 1
CASE "error"
LINE INPUT #1, err404$
AddBuffer "Using error page " + err404$
CASE "hostname"
LINE INPUT #1, localname$
END SELECT
DrawScreen
END IF
LOOP
CLOSE #1
mimetotal = mimenum - 1
AddBuffer "Loaded" + STR$(mimenum) + " mime types from configuration file."
DrawScreen
IF tcpInit(tcpVect%) <> 1 THEN END
AddBuffer ""
logfile$ = logtemp$
IF logfile$ <> "%none" THEN
OPEN logfile$ FOR BINARY AS #2: CLOSE #2
'Make sure file exists before opening FOR APPEND to avoid errors.
OPEN logfile$ FOR APPEND AS #2
PRINT #2,
PRINT #2, "----[ LOG SECTION BEGIN @ " + TIME$ + " ON " + DATE$ + " ]----"
CLOSE #2
END IF
AddBuffer "Web server initialized."
IF LCASE$(localname$) = "%ip" THEN localname$ = Conv2IP$(tcpDriver.LocalIP)
DO
stat(0) = "Waiting for connection on port" + STR$(portnr%) + "..."
stat(1) = STRING$(76, "°")
DrawScreen
hand% = tcpListen(portnr%)
DO
IF INKEY$ = CHR$(27) THEN tcpClose hand%: END
LOOP UNTIL tcpStatus(hand%) = sckOpen
header$ = ""
DO
nd$ = tcpGetData(hand%)
IF nd$ <> "" THEN header$ = header$ + nd$
tcpDoIO
retn% = tcpStatus(hand%)
IF retn% = sckClosed OR retn% = 0 THEN EXIT DO
LOOP UNTIL INSTR(1, header$, CHR$(13) + CHR$(10) + CHR$(13) + CHR$(10))
xp = INSTR(1, LCASE$(header$), "get ")
IF xp THEN
header$ = MID$(header$, xp + 4)
IF LEFT$(header$, 1) <> "/" THEN header$ = "/" + header$
xp = INSTR(1, header$, " ")
IF xp THEN header$ = LEFT$(header$, xp - 1)
filename$ = ""
FOR n = 1 TO LEN(header$)
cc$ = MID$(header$, n, 1)
SELECT CASE cc$
CASE ""
CASE "/"
filename$ = filename$ + "\"
CASE ELSE
filename$ = filename$ + cc$
END SELECT
NEXT n
IF RIGHT$(filename$, 1) = "\" THEN filename$ = filename$ + "INDEX.HTM"
shl$ = "DIR " + htdocs$ + filename$ + " /b >exist.tmp"
LOCATE 1, 1: SHELL shl$
OPEN "exist.tmp" FOR BINARY AS #1: CLOSE #1
OPEN "exist.tmp" FOR INPUT AS #1
IF LOF(1) THEN LINE INPUT #1, check$ ELSE check$ = ""
CLOSE #1
KILL "exist.tmp"
IF check$ = "" THEN errorpage = 1 ELSE errorpage = 0
FOR n = LEN(filename$) TO 1 STEP -1
IF MID$(filename$, n, 1) = "." THEN EXIT FOR
NEXT n
FOR num = 1 TO mimetotal
IF LCASE$(MID$(filename$, n)) = LCASE$(mime(num, 1)) THEN
content$ = mime(num, 2)
EXIT FOR
END IF
NEXT num
IF num > mimetotal THEN content$ = "text/text"
IF errorpage = 1 THEN content$ = "text/html"
buffadd$ = DATE$ + " " + TIME$ + " - " + tcpRemoteIP(hand%) + " GET " + filename$
IF errorpage = 0 THEN
OPEN htdocs$ + filename$ FOR BINARY AS #1
buffadd$ = buffadd$ + " (" + MID$(STR$(LOF(1)), 2) + " bytes)"
ELSE
OPEN err404$ FOR BINARY AS #1
buffadd$ = buffadd$ + " (404 not found)"
END IF
AddBuffer buffadd$
DrawScreen
tcpSendData hand%, "HTTP/1.1 200 OK" + CHR$(13) + CHR$(10)
tcpSendData hand%, "Content-type: " + content$ + CHR$(13) + CHR$(10)
tcpSendData hand%, "Content-length:" + STR$(LOF(1)) + CHR$(13) + CHR$(10) + CHR$(13) + CHR$(10)
ratio! = 76 / 100
exitserv = 0
DO UNTIL EOF(1) OR LOF(1) <= LOC(1)
IF INKEY$ = CHR$(27) THEN exitserv = 1: EXIT DO
a$ = SPACE$(1500)
IF LOF(1) - LOC(1) < 1500 THEN a$ = SPACE$(LOF(1) - LOC(1))
GET #1, , a$
IF errorpage = 1 THEN
xp = INSTR(1, a$, "%date")
IF xp THEN a$ = LEFT$(a$, xp - 1) + DATE$ + MID$(a$, xp + 5)
xp = INSTR(1, a$, "%time")
IF xp THEN a$ = LEFT$(a$, xp - 1) + TIME$ + MID$(a$, xp + 5)
xp = INSTR(1, a$, "%host")
IF xp THEN a$ = LEFT$(a$, xp - 1) + localname$ + MID$(a$, xp + 5)
END IF
tcpSendData hand%, a$
retn% = tcpStatus(hand%)
IF retn% = 0 OR retn% = sckClosed THEN EXIT DO
pct% = FIX((LOC(1) / LOF(1)) * 100)
stat(0) = "Sending file: " + filename$ + " (" + MID$(STR$(LOC(1)), 2) + " of" + STR$(LOF(1)) + ") -" + STR$(pct%) + "%"
stat(1) = STRING$(FIX(pct% * ratio!), "²") + STRING$(76 - FIX(pct% * ratio!), "°")
LOCATE 2, 1
PRINT "º " + LEFT$(stat(0) + SPACE$(76), 76) + " º";
PRINT "º " + LEFT$(stat(1) + SPACE$(76), 76) + " º";
LOOP
CLOSE #1
IF exitserv = 1 THEN EXIT DO
END IF
tcpClose hand%
LOOP
tcpClose hand% 'Just to make sure.
END
SUB AddBuffer (textadd AS STRING)
IF logfile$ <> "%none" THEN OPEN logfile$ FOR APPEND AS #2
DIM tempText AS STRING
tempText = textadd
DO
FOR tn = 1 TO 17
scrlog(tn - 1) = scrlog(tn)
NEXT tn
scrlog(17) = LEFT$(tempText, 76)
IF logfile$ <> "%none" THEN PRINT #2, LEFT$(tempText, 76)
tempText = MID$(tempText, 77)
LOOP UNTIL tempText = ""
IF logfile$ <> "%none" THEN CLOSE #2
END SUB
DEFSNG A-Z
FUNCTION Conv2DWord$ (inString AS STRING)
'The inString variable should be an IPv4 address in the standard
'format of x.x.x.x
DIM tempArray(3) AS STRING * 1
DIM tempVal AS INTEGER
tempVal = INSTR(1, inString, ".")
IF tempVal THEN
tempArray(0) = CHR$(VAL(LEFT$(inString, tempVal)))
inString = MID$(inString, tempVal + 1)
ELSE
EXIT FUNCTION
END IF
tempVal = INSTR(1, inString, ".")
IF tempVal THEN
tempArray(1) = CHR$(VAL(LEFT$(inString, tempVal)))
inString = MID$(inString, tempVal + 1)
ELSE
EXIT FUNCTION
END IF
tempVal = INSTR(1, inString, ".")
IF tempVal THEN
tempArray(2) = CHR$(VAL(LEFT$(inString, tempVal)))
inString = MID$(inString, tempVal + 1)
ELSE
EXIT FUNCTION
END IF
tempArray(3) = CHR$(VAL(inString))
Conv2DWord$ = tempArray(0) + tempArray(1) + tempArray(2) + tempArray(3)
END FUNCTION
FUNCTION Conv2IP$ (DWord AS LONG)
DIM tempStr AS STRING * 4
tempStr = MKL$(DWord)
Conv2IP$ = MID$(STR$(ASC(LEFT$(tempStr, 1))), 2) + "." + MID$(STR$(ASC(MID$(tempStr, 2, 1))), 2) + "." + MID$(STR$(ASC(MID$(tempStr, 3, 1))), 2) + "." + MID$(STR$(ASC(RIGHT$(tempStr, 1))), 2)
END FUNCTION
SUB debugShowReturn
PRINT " ax:" + STR$(tcpReturn.ax) + " (" + HEX$(tcpReturn.ax) + "h)"
PRINT " bx:" + STR$(tcpReturn.bx) + " (" + HEX$(tcpReturn.bx) + "h)"
PRINT " cx:" + STR$(tcpReturn.cx) + " (" + HEX$(tcpReturn.cx) + "h)"
PRINT " dx:" + STR$(tcpReturn.dx) + " (" + HEX$(tcpReturn.dx) + "h)"
PRINT " bp:" + STR$(tcpReturn.bp) + " (" + HEX$(tcpReturn.bp) + "h)"
PRINT " si:" + STR$(tcpReturn.si) + " (" + HEX$(tcpReturn.si) + "h)"
PRINT " di:" + STR$(tcpReturn.di) + " (" + HEX$(tcpReturn.di) + "h)"
PRINT "flags:" + STR$(tcpReturn.flags) + " (" + HEX$(tcpReturn.flags) + "h)"
PRINT " ds:" + STR$(tcpReturn.ds) + " (" + HEX$(tcpReturn.ds) + "h)"
PRINT " es:" + STR$(tcpReturn.es) + " (" + HEX$(tcpReturn.es) + "h)"
END SUB
DEFINT A-Z
SUB DrawScreen
COLOR 7, 0: LOCATE 1, 1
PRINT "É͹ Transfer Ì" + STRING$(65, "Í") + "»";
PRINT "º " + LEFT$(stat(0) + SPACE$(76), 76) + " º";
PRINT "º " + LEFT$(stat(1) + SPACE$(76), 76) + " º";
PRINT "È" + STRING$(78, "Í") + "¼";
PRINT "É͹ Log Ì" + STRING$(70, "Í") + "»";
FOR tn = 0 TO 17
PRINT "º " + LEFT$(scrlog(tn) + SPACE$(76), 76) + " º";
NEXT tn
PRINT "È" + STRING$(78, "Í") + "¼";
LOCATE 25, 45
PRINT "To shut down this server, hit ESC.";
END SUB
DEFSNG A-Z
FUNCTION HighByte% (Word AS INTEGER)
HighByte% = ASC(RIGHT$(MKI$(Word), 1))
END FUNCTION
FUNCTION LowByte% (Word AS INTEGER)
LowByte% = ASC(LEFT$(MKI$(Word), 1))
END FUNCTION
FUNCTION MakeReg% (h AS INTEGER, l AS INTEGER)
MakeReg% = CVI(CHR$(l) + CHR$(h))
END FUNCTION
SUB RegBlank
tcpCall.ax = 0
tcpCall.bx = 0
tcpCall.cx = 0
tcpCall.dx = 0
tcpCall.bp = 0
tcpCall.si = 0
tcpCall.di = 0
tcpCall.flags = 0
tcpCall.ds = 0
tcpCall.es = 0
END SUB
SUB showErrorMsg
PRINT "ERROR CODE" + STR$(tcpDriver.ErrorCode) + "!!! ";
SELECT CASE tcpDriver.ErrorCode
CASE errBadCall
PRINT "err_badcall"
CASE errCritical
PRINT "err_critical"
CASE errNoHandles
PRINT "err_nohandles"
CASE errBadHandle
PRINT "err_badhandle"
CASE errTimeout
PRINT "err_timeout"
CASE errBadSession
PRINT "err_badsession"
END SELECT
END SUB
SUB tcpClose (tcpHandle AS INTEGER)
tcpCall.ax = MakeReg(&H11, 1)
tcpCall.bx = tcpHandle
tcpCall.dx = 0
CALL interruptx(tcpDriver.IntVector, tcpCall, tcpReturn)
tcpDriver.ErrorCode = LowByte(tcpReturn.dx)
END SUB
FUNCTION tcpConnect% (RemoteIP AS STRING, RemotePort AS INTEGER)
DIM tempRemoteIP AS STRING
tempRemoteIP = Conv2DWord(RemoteIP)
tcpCall.ax = MakeReg(&H10, 0)
tcpCall.bx = 0
tcpCall.cx = RemotePort
tcpCall.dx = tcpDriver.Timeout
tcpCall.di = CVI(LEFT$(tempRemoteIP, 2))
tcpCall.si = CVI(RIGHT$(tempRemoteIP, 2))
CALL interruptx(tcpDriver.IntVector, tcpCall, tcpReturn)
dummyLocalPortNr% = tcpReturn.ax
'PRINT "Local port:"; dummyLocalPortNr%
tcpConnect% = tcpReturn.bx 'Makes this function return the TCPDRV handle number.
tcpDriver.ErrorCode = LowByte(tcpReturn.dx)
END FUNCTION
SUB tcpDoIO
'Allows TCPDRV to perform processing of data. THIS MUST BE CALLED REGULARLY
'for packets to be processed! If you don't do this, TCPDRV will eventually
'crash when it runs out of storage space for input and output queues.
'RegBlank
tcpCall.ax = MakeReg(&H2, 0)
tcpCall.dx = 0 'tcpDriver.Timeout
CALL interruptx(tcpDriver.IntVector, tcpCall, tcpReturn)
tcpDriver.ErrorCode = LowByte(tcpReturn.dx)
END SUB
FUNCTION tcpFindInt% (startSegment AS INTEGER, endSegment AS INTEGER)
'If either or both startSegment or endSegment is zero, use standard NTCPDRV
'segment range of 60h to 7Fh for scanning.
IF startSegment = 0 OR endSegment = 0 THEN
startSegment = &H60
endSegment = &H7F
END IF
DIM tempScan AS INTEGER
DIM tempScan2 AS LONG
FOR tempScan = startSegment TO endSegment
DEF SEG = tempScan
FOR tempScan2 = 0 TO 65535
'If current offset in this segment is the letter T
'(ASCII value 84), then check the next 7 bytes for "CP_DRVR"
'(excluding quotes). If they are, we've found our NTCPDRV
'interrupt vector! :)
IF PEEK(tempScan2) = 84 THEN
'This next line is huge, sorry. I know I could have had
'it convert each of these bytes to its ASCII string value
'with CHR$(PEEK(blah)) and put them together as tempStr$
'then say `IF tempStr$ = "CP_DRVR" THEN' for much sexier
'looking code, but I want these routines to be as fast as
'possible. We would waste valuable CPU cycles with that
'process. What if somebody is running this on an 8088? :)
IF PEEK(tempScan2 + 1) = 67 AND PEEK(tempScan2 + 2) = 80 AND PEEK(tempScan2 + 3) = 95 AND PEEK(tempScan2 + 4) = 68 AND PEEK(tempScan2 + 5) = 82 AND PEEK(tempScan2 + 6) = 86 AND PEEK(tempScan2 + 7) = 82 THEN
'Got our segment, so return it!
tcpFindInt% = tempScan + 1
EXIT FUNCTION
END IF
END IF
NEXT tempScan2
NEXT tempScan
tcpFindInt% = 0
'Yeah, yeah... I know tcpFindInt% should already be zero since we could
'not locate a NTCPDRV interrupt segment in the given range, but now we
'KNOW it is, right? Can't go wrong with that! :)
END FUNCTION
FUNCTION tcpGetData$ (tcpHandle AS INTEGER)
tcpCall.ax = MakeReg(&H12, 1)
tcpCall.bx = tcpHandle
tcpCall.es = VARSEG(strGetData)
tcpCall.di = VARPTR(strGetData)
tcpCall.cx = 1500
tcpCall.dx = 0
CALL interruptx(tcpDriver.IntVector, tcpCall, tcpReturn)
tcpGetData$ = LEFT$(strGetData, tcpReturn.ax)
tcpDriver.ErrorCode = LowByte(tcpReturn.dx)
END FUNCTION
FUNCTION tcpInBuffer% (tcpHandle AS INTEGER)
dummy1% = tcpStatus%(tcpHandle)
IF isActive > 0 THEN
tcpInBuffer% = tcpReturn.ax
END IF
tcpDriver.ErrorCode = LowByte(tcpReturn.dx)
END FUNCTION
FUNCTION tcpInit% (Vector AS INTEGER)
'If given vector value is zero, assume the usual vector 61h.
IF Vector = 0 THEN Vector = &H61
tcpCall.ax = MakeReg(&H0, &HFF)
CALL interruptx(Vector, tcpCall, tcpReturn)
'This next line sets tcpDriver.Enabled to zero, sets the tcpInit function
'return value to zero, and exits the function immediately if the interrupt
'call did not return the expected value of zero for a functional TCPDRV
'vector at the specified segment.
IF tcpReturn.ax <> 0 THEN tcpDriver.Enabled = 0: tcpInit% = 0: EXIT FUNCTION
tcpInit% = 1
tcpDriver.Enabled = 1
tcpDriver.IntVector = Vector
DEF SEG = tcpReturn.es
offset = tcpReturn.di
'The following lines of code parse all of the network-related data
'from the pointer value returned by TCPDRV.
tcpDriver.LocalIP = CVL(CHR$(PEEK(offset)) + CHR$(PEEK(offset + 1)) + CHR$(PEEK(offset + 2)) + CHR$(PEEK(offset + 3)))
offset = offset + 4
tcpDriver.LocalNetmask = CVL(CHR$(PEEK(offset)) + CHR$(PEEK(offset + 1)) + CHR$(PEEK(offset + 2)) + CHR$(PEEK(offset + 3)))
offset = offset + 4
tcpDriver.LocalGateway = CVL(CHR$(PEEK(offset)) + CHR$(PEEK(offset + 1)) + CHR$(PEEK(offset + 2)) + CHR$(PEEK(offset + 3)))
offset = offset + 4
tcpDriver.LocalDNS = CVL(CHR$(PEEK(offset)) + CHR$(PEEK(offset + 1)) + CHR$(PEEK(offset + 2)) + CHR$(PEEK(offset + 3)))
offset = offset + 4
tcpDriver.Timeserver = CVL(CHR$(PEEK(offset)) + CHR$(PEEK(offset + 1)) + CHR$(PEEK(offset + 2)) + CHR$(PEEK(offset + 3)))
offset = offset + 4
tcpDriver.MTU = CVI(CHR$(PEEK(offset)) + CHR$(PEEK(offset + 1)))
offset = offset + 2
tcpDriver.TTL = PEEK(offset)
tcpDriver.TOS = PEEK(offset + 1)
offset = offset + 4 'Skip two unused bytes after TTL and TOS data.
tcpDriver.MSS = CVI(CHR$(PEEK(offset)) + CHR$(PEEK(offset + 1)))
offset = offset + 2
tcpDriver.RWIN = CVI(CHR$(PEEK(offset)) + CHR$(PEEK(offset + 1)))
offset = offset + 4 'Skip two unused bytes after RWIN data.
'The following code segment gets the local domain string.
'TCPDRV allocates 256 bytes for this string, because that is the maximum
'allowed length of a domain name. If the string is shorter than 256 bytes,
'then TCPDRV fills the remainder of the string with ASCII code 255. The
'following code stops reading from the domain string as soon is it sees
'the first byte with a value of 255 for performance reasons.
DIM tempNum AS INTEGER
DIM tempCurByte AS STRING * 1
DIM tempStr AS STRING
FOR tempNum = offset TO offset + 255
tempCurByte = CHR$(PEEK(tempNum))
IF tempCurByte = CHR$(255) THEN
tcpDriver.DomainLen = tempNum - offset
tcpDriver.LocalDomain = tempStr
ELSE
tempStr = tempStr + tempCurByte
END IF
NEXT tempNum
tcpDriver.ErrorCode = LowByte(tcpReturn.dx)
END FUNCTION
FUNCTION tcpListen% (ListenPort AS INTEGER)
tcpCall.ax = MakeReg(&H10, 1)
tcpCall.bx = ListenPort
tcpCall.cx = 0
tcpCall.dx = tcpDriver.Timeout
tcpCall.si = 0
tcpCall.di = 0
CALL interruptx(tcpDriver.IntVector, tcpCall, tcpReturn)
tcpListen% = tcpReturn.bx
tcpDriver.ErrorCode = LowByte(tcpReturn.dx)
END FUNCTION
DEFINT A-Z
FUNCTION tcpRemoteIP$ (tcpHandle AS INTEGER)
checkstat% = tcpStatus(tcpHandle)
IF checkstat% <> sckOpen THEN tcpRemoteIP$ = "0.0.0.0": EXIT FUNCTION
DEF SEG = tcpReturn.es
stateoffset = tcpReturn.di
ipdest$ = Conv2IP(CVL(CHR$(PEEK(stateoffset + 6)) + CHR$(PEEK(stateoffset + 7)) + CHR$(PEEK(stateoffset + 8)) + CHR$(PEEK(stateoffset + 9))))
'ipsrce$ = Conv2IP(CVL(CHR$(PEEK(stateoffset)) + CHR$(PEEK(stateoffset + 1)) + CHR$(PEEK(stateoffset + 2)) + CHR$(PEEK(stateoffset + 3))))
tcpRemoteIP$ = ipdest$
END FUNCTION
DEFSNG A-Z
SUB tcpSendData (tcpHandle AS INTEGER, Data2Send AS STRING)
strSendData = Data2Send
tcpCall.ax = MakeReg(&H13, 4)
tcpCall.bx = tcpHandle
tcpCall.es = INT(VARSEG(strSendData))
tcpCall.di = INT(VARPTR(strSendData))
tcpCall.cx = INT(LEN(Data2Send))
tcpCall.dx = tcpDriver.Timeout
CALL interruptx(tcpDriver.IntVector, tcpCall, tcpReturn)
tcpDriver.ErrorCode = LowByte(tcpReturn.dx)
tcpDoIO
END SUB
SUB tcpSetTimeout (TimeoutSeconds AS INTEGER)
tcpDriver.Timeout = INT(TimeoutSeconds * 18.2)
END SUB
FUNCTION tcpStatus% (tcpHandle AS INTEGER)
tcpCall.ax = MakeReg(&H14, 0)
tcpCall.bx = tcpHandle
CALL interruptx(tcpDriver.IntVector, tcpCall, tcpReturn)
DEF SEG = tcpReturn.es
stateoffset = tcpReturn.di
ipsrce$ = Conv2IP(CVL(CHR$(PEEK(stateoffset)) + CHR$(PEEK(stateoffset + 1)) + CHR$(PEEK(stateoffset + 2)) + CHR$(PEEK(stateoffset + 3))))
ipdest$ = Conv2IP(CVL(CHR$(PEEK(stateoffset + 4)) + CHR$(PEEK(stateoffset + 5)) + CHR$(PEEK(stateoffset + 6)) + CHR$(PEEK(stateoffset + 7))))
ipprot% = PEEK(stateoffset + 8)
active% = PEEK(stateoffset + 9)
ifActive = active%
'PRINT "======================"
'PRINT "Debug: Status data return values for TCP handle"; tcpHandle
'PRINT
'PRINT "Error code:"; LowByte(tcpReturn.dx)
'PRINT "TCP state:"; HighByte(tcpReturn.dx)
'PRINT
'PRINT "Bytes available for reading:"; tcpReturn.ax
'PRINT "Bytes still being transmitted:"; tcpReturn.cx
'PRINT
'PRINT "Session info gathered from pointer" + STR$(tcpReturn.es) + ":" + MID$(STR$(tcpReturn.di), 2)
'PRINT "IP source: " + ipsrce$
'PRINT "IP dest: " + ipsrce$
'PRINT "IP prot:"; ipprot%
'PRINT "Active:"; active%
'PRINT "======================"
tcpStatus% = HighByte(tcpReturn.dx)
tcpDriver.ErrorCode = LowByte(tcpReturn.dx)
END FUNCTION
SUB tcpUnload
tcpCall.ax = MakeReg(&H1, 0)
CALL interruptx(tcpDriver.IntVector, tcpCall, tcpReturn)
tcpDriver.Enabled = 0
END SUB
