QB64.org Forum

Active Forums => QB64 Discussion => Topic started by: badger on October 15, 2020, 07:08:28 pm

Title: would this be helpful to anyone
Post by: badger on October 15, 2020, 07:08:28 pm

Hello

I found this poking around on the internet thought it looked promising.

Badger

Code: QB64: [Select]

1. 'TCP/IP routines for real-mode DOS networking in QuickBASIC.
2. 'Coded by Mike Chambers, 2006 - Home page: http://rubbermallet.org/qb
3. '
4. 'Requirements:
5. '       - Ethernet card and a packet driver, or a dial-up connection.
6. '         If you don't have a packet driver for your card, you
7. '         need to find one that is compatible with yours.
8. '         Crynwr proides free DOS packet drivers for MANY different cards.
9. '         You can find them at http://www.crynwr.com/drivers
10. '
11. '       - WatTCP (Provides TCP/IP stack. http://www.wattcp.com )
12.  
13. DECLARE SUB Disconnect (socketID%)
14. DECLARE FUNCTION FreeSock% ()
15. DECLARE FUNCTION SendData% (socketID%, strData$)
16. DECLARE FUNCTION IsOpen% (socketID%)
17. DECLARE FUNCTION GetData$ (socketID%)
18. DECLARE FUNCTION Connect% (socketID%, ipAdr$, portNr%)
19. DECLARE FUNCTION VerifyTCP% ()
20.  
21. '$INCLUDE: 'c:\users\sureshot\jbridal\qb.bi'
22. DEFINT A-Z
23.  
24. DIM SHARED tcpIn AS RegType, tcpOut AS RegType
25. DIM SHARED PufSeg%, PufOffs%
26.  
27. DEFSNG A-Z
28. FUNCTION Connect% (socketID%, ipAdr$, portNr%)
29.     DEF SEG = PufSeg%
30.  
31.     ipBin$ = ""
32.     DO
33.         p% = INSTR(ipAdr$, ".")
34.         IF p% = 0 THEN EXIT DO
35.         ipBin$ = ipBin$ + CHR$(VAL(LEFT$(ipAdr$, p% - 1)))
36.         ipAdr$ = MID$(ipAdr$, p% + 1)
37.     LOOP
38.     ipBin$ = ipBin$ + CHR$(VAL(ipAdr$))
39.  
40.     'Make sure supplied remote IP is valid.
41.     IF LEN(ipBin$) <> 4 THEN Connect = 0: EXIT FUNCTION
42.  
43.     tcpIn.ax = &H300
44.     tcpIn.cx = 1
45.     tcpIn.dx = socketID%
46.     CALL INTERRUPT(&H17, tcpIn, tcpOut)
47.     IF tcpOut.ax <> 0 THEN 'If error occurs while trying to connect.
48.         Connect = 0
49.         EXIT FUNCTION
50.     END IF
51.  
52.     PufSeg% = tcpOut.cx
53.     PufOffs% = tcpOut.dx
54.     DEF SEG = PufSeg%
55.  
56.     tcpIn.ax = &H500
57.     tcpIn.dx = socketID%
58.     rsockaddr$ = RIGHT$(MKI$(portNr%), 1) + LEFT$(MKI$(portNr%), 1) + ipBin$
59.  
60.     FOR i% = 1 TO LEN(rsockaddr$)
61.         POKE PufOffs% + i% + 1, ASC(MID$(rsockaddr$, i%, 1))
62.     NEXT i%
63.  
64.     CALL INTERRUPT(&H17, tcpIn, tcpOut)
65.     IF tcpOut.ax <> 0 THEN 'If connection error occurs.
66.         Connect = 0
67.         tcpIn.ax = &HD00
68.         CALL INTERRUPT(&H17, tcpIn, tcpOut)
69.         EXIT FUNCTION
70.     END IF
71.  
72.     tcpIn.ax = &HB00
73.     tcpIn.dx = socketID%
74.     CALL INTERRUPT(&H17, tcpIn, tcpOut)
75.     Connect = 1
76. END FUNCTION
77.  
78. SUB Disconnect (socketID%)
79.     DEF SEG = PufSeg%
80.  
81.     tcpIn.ax = &HC00
82.     tcpIn.dx = socketID%
83.     CALL INTERRUPT(&H17, tcpIn, tcpOut)
84.  
85.     tcpIn.ax = &HD00
86.     CALL INTERRUPT(&H17, tcpIn, tcpOut)
87. END SUB
88.  
89. FUNCTION FreeSock%
90.     FOR ntemp% = 1 TO 32767
91.         IF IsOpen(ntemp%) THEN FreeSock% = ntemp%: EXIT FUNCTION
92.     NEXT ntemp%
93.     IF ntemp% = 32768 THEN FreeSock% = 0
94. END FUNCTION
95.  
96. FUNCTION GetData$ (socketID%)
97.     DEF SEG = PufSeg%
98.  
99.     Continue% = -1
100.     DO UNTIL Continue% = 0
101.         z$ = ""
102.         tcpIn.ax = &H800
103.         tcpIn.cx = 1024
104.         tcpIn.dx = socketID%
105.         CALL INTERRUPT(&H17, tcpIn, tcpOut)
106.         IF tcpOut.ax = -1 THEN
107.             IF tcpOut.cx = 35 THEN
108.                 'Ignore
109.             ELSEIF tcpOut.cx = 6 THEN
110.                 'If peer closes the connection.
111.                 Continue% = 0
112.                 EXIT DO
113.             ELSE
114.                 Disconnect socketID%
115.                 EXIT FUNCTION
116.             END IF
117.         ELSE
118.             FOR i% = 0 TO tcpOut.ax - 1
119.                 z$ = z$ + CHR$(PEEK(PufOffs% + 16 + i%))
120.             NEXT i%
121.         END IF
122.         IF z$ = "" THEN EXIT DO ELSE GetData$ = z$
123.     LOOP
124. END FUNCTION
125.  
126. FUNCTION IsOpen% (socketID%)
127.     DEF SEG = PufSeg%
128.  
129.     tcpIn.ax = &H800
130.     tcpIn.cx = 0
131.     tcpIn.dx = socketID%
132.     CALL INTERRUPT(&H17, tcpIn, tcpOut)
133.     IF tcpOut.ax = 2048 THEN
134.         IsOpen = 1
135.     ELSE
136.         IsOpen = 0
137.     END IF
138. END FUNCTION
139.  
140. FUNCTION SendData% (socketID%, strData$)
141.     DEF SEG = PufSeg%
142.  
143.     sID% = socketID%
144.     t$ = strData$
145.     Continue% = -1
146.     WHILE Continue%
147.         IF t$ <> "" THEN
148.             WHILE t$ <> ""
149.                 tcpIn.ax = &H900
150.                 tcpIn.cx = LEN(t$)
151.                 tcpIn.dx = socketID%
152.                 FOR i% = 0 TO LEN(t$) - 1
153.                     POKE PufOffs% + 16 + i%, ASC(MID$(t$, i% + 1, 1))
154.                 NEXT i%
155.                 CALL INTERRUPT(&H17, tcpIn, tcpOut)
156.                 IF tcpOut.ax < 0 THEN 'If there is an error sending data.
157.                     Disconnect (sID%)
158.                     SendData = 0
159.                     EXIT FUNCTION
160.                 END IF
161.                 t$ = MID$(t$, tcpOut.ax + 1)
162.             WEND
163.         END IF
164.         IF t$ = "" THEN SendData = 1: EXIT FUNCTION
165.     WEND
166.     SendData = 1
167. END FUNCTION
168.  
169. FUNCTION VerifyTCP%
170.     tcpIn.ax = &HE00
171.     CALL INTERRUPT(&H17, tcpIn, tcpOut)
172.     IF tcpOut.cx <> &H1234 THEN
173.         VerifyTCP = 0
174.     ELSE
175.         VerifyTCP = 1
176.     END IF
177. END FUNCTION
178.  
179.  
180.  
181.  

Title: Re: would this be helpful to anyone
Post by: SMcNeill on October 15, 2020, 07:14:34 pm

You may need to attach the included file:

'$INCLUDE: 'c:\users\sureshot\jbridal\qb.bi'

Title: Re: would this be helpful to anyone
Post by: badger on October 15, 2020, 07:17:32 pm

Hello

Opps i forgot you will also need a packet driver ..

Badger

Text Only | Text with Attachments