home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 August / PCWorld_2000-08_cd.bin / Software / TemaCD / xbasic / xbpro.exe / xb / aserver.x < prev    next >
Encoding:
Text File  |  1999-11-25  |  12.3 KB  |  421 lines
  1. '
  2. ' ####################
  3. ' #####  PROLOG  #####
  4. ' ####################
  5. '
  6. PROGRAM    "aserver"
  7. VERSION    "0.0001"
  8. '
  9. IMPORT    "xst"
  10. IMPORT    "xin"
  11. IMPORT    "xui"
  12. '
  13. ' IMPORTANT : The Windows XBasic "xin" sockets/network/internet
  14. ' function library is disabled if file "c:/windows/xb.ini" exits
  15. ' and contains the line "xin=false".  The best way to enable the
  16. ' "xin" function library is to comment-out that line with a '
  17. ' comment-character prefix - change "xin=false" to "' xin=false".
  18. ' You can then re-disable the "xin" library if you wish by simply
  19. ' removing the ' comment character.  Why is this silly "xin=false"
  20. ' initialization-string needed?  For unknown reasons, in computers
  21. ' that do not have TCP/IP networking but DO have dial-up networking,
  22. ' initialization in "xin" malfunctions unless a dial-up connection
  23. ' has been made since the computer started.  Why is unclear, and
  24. ' hopefully this silly workaround can be eliminated someday.
  25. '
  26. ' This "aserver.x" program is a time stamp server program that
  27. ' works with the "aclient.x" program to test and demonstrate the
  28. ' simplest possible client and server programs.  This "aserver.x"
  29. ' program connects to port 0x2020.  All this program does is wait
  30. ' for a "time" stamp request, then create a time stamp string and
  31. ' send it to the requesting client, which can be "aclient.x" for
  32. ' testing purposes, but could be any client that connects to the
  33. ' IP address of this system on port 0x2020.
  34. '
  35. DECLARE FUNCTION  Entry      ()
  36. DECLARE FUNCTION  Blowback   ()
  37. '
  38.     $$SERVER_PORT    = 0x2020
  39. '
  40. '
  41. ' ######################
  42. ' #####  Entry ()  #####
  43. ' ######################
  44. '
  45. FUNCTION  Entry ()
  46.     HOST  host
  47. '
  48.     XinSetDebug (1)                            ' turn on bug print
  49.     client = $$FALSE                        ' no client socket yet
  50.     connected = $$FALSE                    ' not connected to a client yet
  51.     buffer$ = NULL$ (255)                ' place to capture request strings
  52. '
  53.     GOSUB ClearConsole                    ' clear console for readability
  54.     GOSUB PrintBanner                        ' print aclient.x startup banner
  55.     GOSUB Initialize                        ' initialize network function library
  56.     GOSUB PrintLocalHostInfo        ' print information about this system
  57.     GOSUB PrintNetworkAddress        ' print network address of this system
  58.     GOSUB OpenSocket                        ' open a network communications socket
  59.     GOSUB BindSocket                        ' bind the socket to port $$SERVER_PORT
  60.     GOSUB Listen                                ' have socket listen for connect request
  61. '
  62. ' Need nested loop so when a client disconnects the server loops
  63. ' around and waits for and accepts the next client to connect.
  64. '
  65.     DO                                                    ' wait for a client to connect
  66.         DO                                                ' keep waiting for client connection
  67.             GOSUB Accept                        ' accept any client connection attempts
  68.         LOOP UNTIL client                    ' keep waiting for a client to connect
  69. '
  70.         GOSUB GetAddresses                ' get and print server/client addresses
  71. '
  72.         DO
  73.             GOSUB ReadTimeRequest        ' read request for timestamp from client
  74.             IFZ client THEN EXIT DO    ' maybe the client disconnected or failed
  75.             GOSUB WriteTimeStamp        ' write the time stamp string to client
  76.         LOOP WHILE client                    ' continue as long as client is connected
  77.     LOOP WHILE socket                        ' continue as long as server is alive
  78. '
  79.     Blowback ()
  80.     RETURN ($$FALSE)
  81.  
  82. '
  83. '
  84. ' *****  ClearConsole  *****
  85. '
  86. SUB ClearConsole
  87.     XstGetConsoleGrid (@console)
  88.     XuiSendStringMessage (console, @"SetTextArray", 0, 0, 0, 0, 0, 0)
  89.     XuiSendStringMessage (console, @"Redraw", 0, 0, 0, 0, 0, 0)
  90. END SUB
  91. '
  92. '
  93. ' *****  PrintBanner  *****
  94. '
  95. SUB PrintBanner
  96.     PRINT
  97.     PRINT "####################################################"
  98.     PRINT "#####  XBasic Network Functions Test : Server  #####"
  99.     PRINT "####################################################"
  100. END SUB
  101. '
  102. '
  103. ' *****  Initialize  *****
  104. '
  105. SUB Initialize
  106.     PRINT
  107.     PRINT "#####  Xin ()  #####"
  108.     PRINT "#####  XinInitialize (@local, @hosts, @sockets, @version, @comments$, @notes$)  #####"
  109. '
  110.     Xin ()
  111.     XinInitialize (@local, @hosts, @version, @sockets, @comments$, @notes$)
  112. '
  113. ' *****  print basic network information  *****
  114. '
  115.     PRINT
  116.     PRINT "local                  = "; HEX$ (local,8)
  117.     PRINT "hosts                  = "; HEX$ (hosts,8)
  118.     PRINT "sockets                = "; HEX$ (sockets,8)
  119.     PRINT "version                = "; HEX$ (version,8)
  120.     PRINT "comments$              = "; comments$
  121.     PRINT "notes$                 = "; notes$
  122. END SUB
  123. '
  124. '
  125. ' *****  PrintLocalHostInfo  *****
  126. '
  127. SUB PrintLocalHostInfo
  128.     PRINT
  129.     PRINT "#####  XinHostNumberToInfo (base, @info)  #####"
  130. '
  131.     XinHostNumberToInfo (0, @host)
  132.     hostaddress = host.address
  133.     address$$ = host.address
  134.     host$ = host.name
  135. '
  136.     PRINT
  137.     PRINT "host.name              = \""; host.name; "\""
  138.     PRINT "host.alias[0]          = \""; host.alias[0]; "\""
  139.     PRINT "host.alias[1]          = \""; host.alias[1]; "\""
  140.     PRINT "host.alias[2]          = \""; host.alias[2]; "\""
  141.     PRINT "host.system            = \""; host.system; "\""
  142.     PRINT "host.hostnumber        = "; HEX$ (host.hostnumber,8)
  143.     PRINT "host.address           = "; HEX$ (host.address,8); " = "; STRING$(host.address AND 0x000000FF) + "." + STRING$((host.address >> 8) AND 0x000000FF) + "." + STRING$((host.address >> 16) AND 0x000000FF) + "." + STRING$((host.address >> 24) AND 0x000000FF)
  144. '
  145.     FOR i = 0 TO 7
  146.         PRINT "host.addresses[" + STRING$(i) + "]      = "; HEX$ (host.addresses[i],8); " = "; STRING$(host.addresses[i] AND 0x000000FF) + "." + STRING$((host.addresses[i] >> 8) AND 0x000000FF) + "." + STRING$((host.addresses[i] >> 16) AND 0x000000FF) + "." + STRING$((host.addresses[i] >> 24) AND 0x000000FF)
  147.     NEXT i
  148. '
  149.     PRINT "host.addressBytes      = "; HEX$ (host.addressBytes,8)
  150.     PRINT "host.addressFamily     = "; HEX$ (host.addressFamily,8)
  151.     PRINT "host.protocolFamily    = "; HEX$ (host.protocolFamily,8)
  152.     PRINT "host.protocol          = "; HEX$ (host.protocol,8)
  153. END SUB
  154. '
  155. '
  156. ' *****  PrintNetworkAddress  *****
  157. '
  158. SUB PrintNetworkAddress
  159.     PRINT
  160.     XinAddressNumberToString (@address$$, @address$)
  161.     PRINT "<"; HEX$(address$$,16); "> <"; address$; "> <";
  162.     XinAddressStringToNumber (@address$, @addr$$)
  163.     PRINT address$; "> <"; HEX$(addr$$,16); ">"
  164. END SUB
  165. '
  166. '
  167. ' *****  OpenSocket  *****
  168. '
  169. SUB OpenSocket
  170.     PRINT
  171.     PRINT "#####  error = XinSocketOpen (@socket, addressType, socketType, flags)  #####"
  172. '
  173.     flags = 0
  174.     socketType = 0
  175.     addressType = 0
  176.     error = XinSocketOpen (@socket, @addressType, @socketType, flags)
  177. '
  178.     PRINT
  179.     PRINT "error                  = "; HEX$ (error, 8)
  180.     PRINT "socket                 = "; HEX$ (socket, 8)
  181.     PRINT "addressType            = "; HEX$ (addressType, 8)
  182.     PRINT "socketType             = "; HEX$ (socketType, 8)
  183.     PRINT "flags                  = "; HEX$ (flags, 8)
  184. '
  185.     IF error THEN
  186.         Blowback ()
  187.         RETURN
  188.     END IF
  189. END SUB
  190. '
  191. '
  192. ' *****  BindSocket  *****
  193. '
  194. SUB BindSocket
  195.     PRINT
  196.     PRINT "#####  error = XinSocketBind (socket, block, @address$$, @port)  #####"
  197. '
  198.     block = 0
  199.     port = $$SERVER_PORT
  200.     address = hostaddress
  201.     error = XinSocketBind (socket, block, @address$$, @port)
  202. '
  203.     PRINT
  204.     PRINT "error                  = "; HEX$ (error, 8)
  205.     PRINT "socket                 = "; HEX$ (socket, 8)
  206.     PRINT "block                  = "; HEX$ (block, 8)
  207.     PRINT "address                = "; HEX$ (address, 8)
  208.     PRINT "port                   = "; HEX$ (port, 8)
  209. '
  210.     IF error THEN
  211.         Blowback ()
  212.         RETURN
  213.     END IF
  214. END SUB
  215. '
  216. '
  217. ' *****  Listen  *****
  218. '
  219. SUB Listen
  220.     PRINT
  221.     PRINT "#####  error = XinSocketListen (socket, block, flags)  #####"
  222. '
  223.     flags = 0
  224.     block = 0
  225.     error = XinSocketListen (socket, block, flags)
  226. '
  227.     PRINT
  228.     PRINT "error                  = "; HEX$ (error, 8)
  229.     PRINT "socket                 = "; HEX$ (socket, 8)
  230.     PRINT "block                  = "; HEX$ (block, 8)
  231.     PRINT "flags                  = "; HEX$ (flags, 8)
  232. '
  233.     IF error THEN
  234.         Blowback ()
  235.         RETURN
  236.     END IF
  237. END SUB
  238. '
  239. '
  240. ' *****  Accept  *****
  241. '
  242. SUB Accept
  243.     flags = 0
  244.     client = 0
  245.     block = 100
  246. '
  247.     error = XinSocketAccept (socket, block, @client, flags)
  248. '
  249.     IF (error OR client) THEN
  250.         PRINT
  251.         PRINT "#####  error = XinSocketAccept (socket, block, @client, flags)  #####"
  252.         PRINT
  253.         PRINT "error                  = "; HEX$ (error, 8)
  254.         PRINT "block                  = "; HEX$ (block, 8)
  255.         PRINT "client                 = "; HEX$ (client, 8)
  256.         PRINT "flags                  = "; HEX$ (flags, 8)
  257.     END IF
  258. '
  259.     IF error THEN
  260.         Blowback ()
  261.         RETURN
  262.     END IF
  263. END SUB
  264. '
  265. '
  266. ' *****  GetAddresses  *****
  267. '
  268. SUB GetAddresses
  269.     PRINT
  270.     PRINT "#####  error = XinSocketGetAddress (socket, @port, @address$$, @remote, @rport, @raddress$$)  #####"
  271. '
  272.     error = XinSocketGetAddress (socket, @port, @address$$, @remote, @rport, @raddress$$)
  273. '
  274.     PRINT
  275.     PRINT "error                  = "; HEX$ (error, 8)
  276.     PRINT "socket                 = "; HEX$ (socket, 8)
  277.     PRINT "port                   = "; HEX$ (port, 8)
  278.     PRINT "address$$              = "; HEX$ (address$$, 16)
  279.     PRINT "remote                 = "; HEX$ (remote, 8)
  280.     PRINT "rport                  = "; HEX$ (rport, 8)
  281.     PRINT "raddress$$             = "; HEX$ (raddress$$, 16)
  282. END SUB
  283. '
  284. '
  285. ' *****  ReadTimeRequest  *****
  286. '
  287. SUB ReadTimeRequest
  288.     PRINT
  289.     PRINT "#####  error = XinSocketRead (client, block, address, readbytes, flags, @bytes)  #####"
  290. '
  291.     error = 0
  292.     bytes = 0
  293.     flags = 0
  294.     block = 100                            ' wait 100us each loop
  295.     readbytes = 4                        ' number of bytes to read, in "time" request
  296.     request$ = NULL$(4)            ' room for "time" request string
  297.     address = &request$            ' address to read request into
  298. '
  299.     DO UNTIL error
  300.         error = XinSocketRead (client, block, address, readbytes, flags, @bytes)
  301. '
  302.         IFZ error THEN
  303.             IF bytes THEN
  304.                 readbytes = readbytes - bytes
  305.                 address = address + bytes
  306.             END IF
  307.         END IF
  308.     LOOP WHILE (readbytes > 0)
  309. '
  310.     error$ = ""
  311.     IF error THEN
  312.         err = ERROR (0)
  313.         IF err THEN error = err
  314.         XstErrorNumberToName (error, @error$)
  315.     END IF
  316. '
  317.     PRINT
  318.     PRINT "error                  = "; HEX$ (error, 8); " : "; error$
  319.     PRINT "client                 = "; HEX$ (client, 8)
  320.     PRINT "block                  = "; HEX$ (block, 8)
  321.     PRINT "address                = "; HEX$ (address, 8)
  322.     PRINT "readbytes              = "; HEX$ (readbytes, 8)
  323.     PRINT "flags                  = "; HEX$ (flags, 8)
  324.     PRINT "bytes                  = "; HEX$ (bytes, 8)
  325.     PRINT "request$               = \""; request$; "\""
  326. '
  327.     IF error THEN
  328.         XinSocketGetStatus (client, 0, 0, 0, @status, 0, 0, 0)
  329.         IFZ (status AND $$SocketStatusConnected) THEN
  330.             XinSocketClose (client)
  331.             client = 0
  332.         END IF
  333.     END IF
  334. END SUB
  335. '
  336. '
  337. ' *****  WriteTimeStamp  *****
  338. '
  339. SUB WriteTimeStamp
  340.     GOSUB GetTimeStamp                                    ' returns time stamp in time$
  341. '
  342.     PRINT
  343.     PRINT "#####  error = XinSocketWrite (client, block, address, writebytes, flags, @bytes, @error)  #####"
  344. '
  345.     error = 0
  346.     flags = 0
  347.     block = 100                                                    ' wait 100us each loop
  348.     address = &time$                                        ' address of time stamp string
  349.     writebytes = LEN (time$)                        ' # of bytes in time stamp string
  350. '
  351.     DO UNTIL error
  352.         bytes = 0
  353.         error = 0
  354.         error = XinSocketWrite (client, block, address, writebytes, flags, @bytes)
  355. '
  356.         IFZ error THEN
  357.             IF (bytes > 0) THEN
  358.                 writebytes = writebytes - bytes        ' bytes left to send
  359.                 address = address + bytes                    ' move past written bytes
  360.             END IF
  361.         END IF
  362.     LOOP WHILE (writebytes > 0)                            ' write again if necessary
  363. '
  364.     IF error THEN
  365.         err = ERROR (0)
  366.         IF err THEN error = err
  367.     END IF
  368. '
  369.     PRINT
  370.     PRINT "error                  = "; HEX$ (error, 8)
  371.     PRINT "socket                 = "; HEX$ (socket, 8)
  372.     PRINT "block                  = "; HEX$ (block, 8)
  373.     PRINT "address                = "; HEX$ (address, 8)
  374.     PRINT "maxbytes               = "; HEX$ (maxbytes, 8)
  375.     PRINT "flags                  = "; HEX$ (flags, 8)
  376.     PRINT "bytes                  = "; HEX$ (bytes, 8)
  377.     PRINT "write                  = \""; LEFT$(time$,bytes); "\""
  378. '
  379.     IF error THEN
  380.         XinSocketGetStatus (client, 0, 0, 0, @status, 0, 0, 0)
  381.         IFZ (status AND $$SocketStatusConnected) THEN
  382.             XinSocketClose (client)
  383.             client = 0
  384.         END IF
  385.     END IF
  386. END SUB
  387. '
  388. '
  389. ' *****  GetTimeStamp  *****
  390. '
  391. SUB GetTimeStamp
  392.     time$ = ""
  393.     XstGetDateAndTime (@year, @month, @day, @weekday, @hour, @minute, @second, @nanosecond)
  394.     time$ = time$ + RIGHT$ ("0000" + STRING$(year), 4)
  395.     time$ = time$ + RIGHT$ ("00" + STRING$(month), 2)
  396.     time$ = time$ + RIGHT$ ("00" + STRING$(day), 2) + ":"
  397.     time$ = time$ + RIGHT$ ("00" + STRING$(hour), 2)
  398.     time$ = time$ + RIGHT$ ("00" + STRING$(minute), 2)
  399.     time$ = time$ + RIGHT$ ("00" + STRING$(second), 2) + "."
  400.     time$ = time$ + RIGHT$ ("000000000" + STRING$ (nanosecond), 9)
  401. '
  402.     PRINT
  403.     PRINT "time                   = \""; time$; "\""
  404. END SUB
  405. END FUNCTION
  406. '
  407. '
  408. ' #########################
  409. ' #####  Blowback ()  #####
  410. ' #########################
  411. '
  412. FUNCTION  Blowback ()
  413. '
  414.     PRINT
  415.     PRINT "#####  aserver.x : Blowback()  #####"
  416. '
  417.     XinSocketClose (-1)                ' close all my sockets
  418. '    XinSetDebug (0)                        ' turn off bug printer
  419. END FUNCTION
  420. END PROGRAM
  421.