This tutorial is designed to explain how you can create your own TCP-enabled applcations in QB4.x to QB7.1.
We will get into some fairly advanced concepts such as interrupt calls, which means you need to start QB with the QB.QLB(for 4.x) or QBX.QLB(for 7.1) QuickLibrary files.
This is accomplished by simply loading QB with the command like parameter /L QB.QLB or /L QBX.QLB
My tutorial covers only interfacing with the TCPDRV/NTCPDRV TSR programs by Peter Tattam. Do a quick google search for one of the (I highly reccommend NTCPDRV - it is less memory hungry) - you will also need to load a packet driver appropriate for your particular network card. Check http://www.crynwr.com and you'll most likely find what you need.
I do have a nice packged version of the source code we'll be dealing with here at http://www.rubbermallet.org which is my website. Go to the My Software page to download NTCPQB v1.2. It is all you'll need, it is a skeleton code file that allows you to get right into it. I did feel it would be a good idea to write this tutorial anyway, just so I can explain in detail how it works.
With my code, you can write all kinds of programs in QuickBASIC that are kind of mind-boggling considering our choice of language and compiler. :) For example, so far I've used this base code to write things like an IRC client, and IRC *SERVER* (the source is huge so far, like 200 KB), a web server, and plenty of other little nifty tools to turn an old 486 or Pentium 1 into a useful little box. Or even slower if you want. My IRC server runs on an 8088. :)
All the code for my little apps are at the rubbermallet.org site linked to above.
The first thing we need to do is define a "Registers" custom data type to make it nice and easy to do interrupt calls. Here is the code for that portion:
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
You'll want to have this right at the top of your source code file. Okay, next lets define yet another custom type to make it easy to keep track of the info TCPDRV gives you. Such as your local IP, and lots more useful information. That code is as follows:
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
The next order of business is defining some custom CONSTant values for the program, such as TCPDRV status codes. This just makes it simpler to work with. We will also dimension a few shared variables that will be needed since I break all the separate TCPDRV functions such as sending data, receiving data, connecting to a remote port somewhere, etc. into their own SUB and FUNCTION routines.
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
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
'This makes all CPU-blocking calls timeout after 5 seconds.
tcpSetTimeout 5
Now we will start writing the subroutines and functions that allow simple use of the code throughout the program! The following code contains all the meat of the interface. :)
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
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 tcpClose (tcpHandle AS INTEGER)
tcpCall.ax = MakeReg(&H11, 1)
tcpCall.bx = tcpHandle
tcpCall.dx = tcpDriver.Timeout
CALL interruptx(tcpDriver.IntVector, tcpCall, tcpReturn)
tcpDriver.ErrorCode = LowByte(tcpReturn.dx)
tcpDoIO
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)
tcpDoIO
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.
'What I did was simply create a tcpDoIO call in each of the other TCPDRV subs
'and functions so you won't have to worry about it that much. However, if there
'are sections of your programs that don't calls for long-ish periods of time,
'make sure you call this SUB periodically yourself.
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 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 = tcpDriver.Timeout
CALL interruptx(tcpDriver.IntVector, tcpCall, tcpReturn)
tcpGetData$ = LEFT$(strGetData, tcpReturn.ax)
tcpDriver.ErrorCode = LowByte(tcpReturn.dx)
tcpDoIO
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.
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)
tcpDoIO
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)
DO UNTIL Data2Send = "" OR UNTIL tcpStatus(tcpHandle) <> sckOpen
strSendData = LEFT$(Data2Send, 1500)
SendSize = LEN(Data2Send)
IF SendSize > 1500 then SendSize = 1500 'breaks into 1500 byte chunk and makes sure TCPDRV only does 1500 at a time.
Data2Send = MID$(Data2Send, SendSize + 1)
tcpCall.ax = MakeReg(&H13, 4)
tcpCall.bx = tcpHandle
tcpCall.es = INT(VARSEG(strSendData))
tcpCall.di = INT(VARPTR(strSendData))
tcpCall.cx = INT(SendSize)
tcpCall.dx = tcpDriver.Timeout
CALL interruptx(tcpDriver.IntVector, tcpCall, tcpReturn)
tcpDriver.ErrorCode = LowByte(tcpReturn.dx)
tcpDoIO
LOOP
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%
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
Basically what is going on here is that each of those SUBs/FUNCTIONs handle the initialization of different functions of TCPDRV via interrupt calls. You will have to initialize the packet driver and NTCPDRV/TCPDRV before your code will work. Plus use the tcpInit%(vector) function before trying to do any other TCPDRV communication, otherwise your system just locks up. :)
Usually the interrupt vector NTCPDRV is on is 61h, unless you changed that yourself. Run this line of code after setting the TCP timeout value: dummy% = tcpInit(&H61) or replace the 61 thre with the proper value on your system.
If it initialized TCPDRV properly, dummy% or whatever you make it will retuen a positive value. If it didn't work, well your system locks up lol. I haven't figured a way to get around that yet, nor automatically find the right vector - so be careful!
Save your code every time before you run it as well. :) Once everything is initted okay, you should have no problems or lockups AT ALL! TCPDRV connections are each assigned unique handle values.. lets say you connect to port 80 on IP 192.168.1.1 or whatever. Here's how you intiate it:
hand% = tcpConnect("192.168.1.1", 80)
It will wait until your specified timeout in seconds with tcpSetTimeOut for the connection to proceed. Otherwise the function returns -1 indiciating FAILURE! Otherwise, it connects and returns the TCPDRV handle number of the new connection.
To get or send data, you'll always want to check the status of the TCP connection like so: stat% = tcpStatus(hand%)
if the value is the same as sckOpen constant (decimal 4) then connection is open and active. You can send a receive data. If the socket is open and healthy, proceeed!
To check for new incoming data, use a temporary string like so: newdata$ = tcpGetData(hand%) if the newdata$ string is blank, there of course no new incoming data. Other it pulls it down 1500 bytes at a type every time you make this call. You should keep doing this call until you get nothing back!
Let's say you wanted to say "hi noob" over the TCP connection, do this:
tcpSendData hand%, "hi noob"
I am not going to get into the specifics of various internet protocols or anything here. That is up to do. Google is your friend. I just wanted to help you at least get yor QB programs 100% LAN/internet capabable. :)
To open a listening socket (acts as a server handle!) just do this:
listenhand% = tcpListen(portnum)
You obviously replace "portnum" with the TCP port you want to listen on, or use a variable if you'd like. Keep polling the status on any listening port, one it is status 4 (sckOpen) that means it has received a connection from a client, and now you can communicate with it like an outgoing connection.
Remember to ALWAYS use tcpClose hand% on any handle that has been closed and you're done with, otherwise TCPDRV will not recycle the handle, and you will eventually run out of them and your program is useless until you restart TCPDRV! I know this doc may be confusion, I tried my best. E-mail me with any questions or comments. Address is on the top of this page!
If you want to run multiple listening sockets at once (i.e. a multithreaded server), here's a simple example of how to open 8 at once:
DIM Handles(7) AS INTEGER
FOR handval% = 0 to 7
Handles(handval%) = tcpListen(portval)
NEXT handval%
Alright, now those 8 are open. You will need to keep checking their status to see if there are new connections:
DO
FOR handval% = 0 to 7
curstat% = tcpStatus(Handles(handval%))
SELECT CASE curstat%
CASE sckOpen 'New connection on this handle!
tcpSendData Handles(handval%), "Howdy! You're connected. Okay, bye now."
tcpClose Handles(handval%)
case sckClosed, 0 'okay, they disconnected (or you disconnected them in this example more likely)
'you NEED to close it again, and then make the handle listen again!
tcpClose Handles(handval%)
Handles(handval%) = tcpListen(portval)
END SELECT
NEXT handval%
LOOP
Obviously this is a VERY simple server example... won't really serve much, but you get the picture I hope. :P
-Mike Chambers 7/26/2008