home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format 91 / af091a.adf / af91a3.lzx / prgs / ACEports / server / server.b < prev   
Encoding:
Text File  |  1996-09-15  |  1.9 KB  |  91 lines
  1. {*
  2. ** A Time/Date/Day Server.
  3. ** 
  4. ** Author: David J Benn
  5. **   Date: 31st August 1994,
  6. **       1st September 1994
  7. *}
  8.  
  9. CONST serving = -1&
  10. CONST default = -1&
  11.  
  12. DECLARE SUB quit
  13.  
  14. '..set up days
  15. DIM the_day$(6)
  16. for i=0 to 6
  17.   read the_day$(i)
  18. next
  19. DATA Sunday,Monday,Tuesday,Wednesday,Thursday,Friday,Saturday
  20.  
  21. window 1,"Time/Date Server [press Q to quit]",(0,0)-(640,75),7
  22.  
  23. '..create the server's port.
  24. message open #1,"time server","r"
  25. if err=400 then
  26.   print "Unable to create message port for server!"
  27.   quit
  28. end if
  29.  
  30. WHILE serving
  31.   '..await a request from a client.
  32.   repeat
  33.     locate 1,1
  34.     print "Date: ";date$
  35.     locate 2,1
  36.     print "Time: ";time$
  37.     if UCASE$(inkey$)="Q" then call quit
  38.     message read #1,request$
  39.     sleep for .1
  40.   until err<>402
  41.  
  42.   '..decode message.
  43.   client$ = LEFT$(request$,INSTR(request$,"/")-1)
  44.   reqtype$ = MID$(request$,INSTR(request$,"/")+1)
  45.   cls
  46.   locate 4,1
  47.   print "Received request for ";reqtype$;" from ";ucase$(client$);"."
  48.  
  49.   '..build reply.
  50.   reqtype$ = UCASE$(reqtype$)
  51.   reply$ = ""
  52.  
  53.   CASE
  54.     reqtype$ = "DATE" : reply$ = date$
  55.     reqtype$ = "TIME" : reply$ = time$
  56.     reqtype$ = "DAY"  : the_date$ = date$:reply$ = the_day$(day)
  57.     reqtype$ = "HELP" : reply$ = "Commands: DATE TIME DAY HELP"
  58.     default            : reply$ = "'"+reqtype$+"': unknown command."
  59.   END CASE
  60.  
  61.   '..open a channel to the client.
  62.   message open #2,client$,"w"
  63.   if err = 400 then
  64.     print "Unable to connect to ";client$;"."
  65.   else
  66.     '..send reply to client.
  67.     message write #2,reply$
  68.  
  69.     '..wait for client to receive message.
  70.     if err = 403 then 
  71.       print "Error while writing to ";client$;"."
  72.     else
  73.       message wait #2    
  74.     end if
  75.     '..close channel to the client.
  76.     message close #2
  77.   end if
  78. WEND
  79.  
  80. SUB quit
  81.   CLS
  82.   print "*** Server terminating..."
  83.   sleep for .75
  84.   message close #1
  85.   message close #2
  86.   window close 1
  87.   STOP
  88. END SUB
  89.  
  90. END
  91.