Author Topic: would this be helpful to anyone  (Read 2824 times)

0 Members and 1 Guest are viewing this topic.

Offline badger

  • Forum Regular
  • Posts: 148
    • View Profile
would this be helpful to anyone
« 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.  
  77. SUB Disconnect (socketID%)
  78.     DEF SEG = PufSeg%
  79.  
  80.     tcpIn.ax = &HC00
  81.     tcpIn.dx = socketID%
  82.     CALL INTERRUPT(&H17, tcpIn, tcpOut)
  83.  
  84.     tcpIn.ax = &HD00
  85.     CALL INTERRUPT(&H17, tcpIn, tcpOut)
  86.  
  87. FUNCTION FreeSock%
  88.     FOR ntemp% = 1 TO 32767
  89.         IF IsOpen(ntemp%) THEN FreeSock% = ntemp%: EXIT FUNCTION
  90.     NEXT ntemp%
  91.     IF ntemp% = 32768 THEN FreeSock% = 0
  92.  
  93. FUNCTION GetData$ (socketID%)
  94.     DEF SEG = PufSeg%
  95.  
  96.     Continue% = -1
  97.     DO UNTIL Continue% = 0
  98.         z$ = ""
  99.         tcpIn.ax = &H800
  100.         tcpIn.cx = 1024
  101.         tcpIn.dx = socketID%
  102.         CALL INTERRUPT(&H17, tcpIn, tcpOut)
  103.         IF tcpOut.ax = -1 THEN
  104.             IF tcpOut.cx = 35 THEN
  105.                 'Ignore
  106.             ELSEIF tcpOut.cx = 6 THEN
  107.                 'If peer closes the connection.
  108.                 Continue% = 0
  109.                 EXIT DO
  110.             ELSE
  111.                 Disconnect socketID%
  112.                 EXIT FUNCTION
  113.             END IF
  114.         ELSE
  115.             FOR i% = 0 TO tcpOut.ax - 1
  116.                 z$ = z$ + CHR$(PEEK(PufOffs% + 16 + i%))
  117.             NEXT i%
  118.         END IF
  119.         IF z$ = "" THEN EXIT DO ELSE GetData$ = z$
  120.     LOOP
  121.  
  122. FUNCTION IsOpen% (socketID%)
  123.     DEF SEG = PufSeg%
  124.  
  125.     tcpIn.ax = &H800
  126.     tcpIn.cx = 0
  127.     tcpIn.dx = socketID%
  128.     CALL INTERRUPT(&H17, tcpIn, tcpOut)
  129.     IF tcpOut.ax = 2048 THEN
  130.         IsOpen = 1
  131.     ELSE
  132.         IsOpen = 0
  133.     END IF
  134.  
  135. FUNCTION SendData% (socketID%, strData$)
  136.     DEF SEG = PufSeg%
  137.  
  138.     sID% = socketID%
  139.     t$ = strData$
  140.     Continue% = -1
  141.     WHILE Continue%
  142.         IF t$ <> "" THEN
  143.             WHILE t$ <> ""
  144.                 tcpIn.ax = &H900
  145.                 tcpIn.cx = LEN(t$)
  146.                 tcpIn.dx = socketID%
  147.                 FOR i% = 0 TO LEN(t$) - 1
  148.                     POKE PufOffs% + 16 + i%, ASC(MID$(t$, i% + 1, 1))
  149.                 NEXT i%
  150.                 CALL INTERRUPT(&H17, tcpIn, tcpOut)
  151.                 IF tcpOut.ax < 0 THEN 'If there is an error sending data.
  152.                     Disconnect (sID%)
  153.                     SendData = 0
  154.                     EXIT FUNCTION
  155.                 END IF
  156.                 t$ = MID$(t$, tcpOut.ax + 1)
  157.             WEND
  158.         END IF
  159.         IF t$ = "" THEN SendData = 1: EXIT FUNCTION
  160.     WEND
  161.     SendData = 1
  162.  
  163. FUNCTION VerifyTCP%
  164.     tcpIn.ax = &HE00
  165.     CALL INTERRUPT(&H17, tcpIn, tcpOut)
  166.     IF tcpOut.cx <> &H1234 THEN
  167.         VerifyTCP = 0
  168.     ELSE
  169.         VerifyTCP = 1
  170.     END IF
  171.  
  172.  
  173.  
  174.  

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: would this be helpful to anyone
« Reply #1 on: October 15, 2020, 07:14:34 pm »
You may need to attach the included file:

'$INCLUDE: 'c:\users\sureshot\jbridal\qb.bi'
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline badger

  • Forum Regular
  • Posts: 148
    • View Profile
Re: would this be helpful to anyone
« Reply #2 on: October 15, 2020, 07:17:32 pm »
Hello

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

Badger