home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic 5 Developer's Kit / vb5 dev kit.iso / dev / tcp4w20 / samples / pascal / koala.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-06-10  |  2.8 KB  |  117 lines
  1. Program PWTN;
  2. {$A+,B-,D+,F-,G+,I-,K+,L+,N-,P+,Q+,R+,S+,T+,V+,W+,X+,Y+}
  3. {$M 8192,8192}
  4. {Simple Koala Client for TCP4W}
  5.  
  6. Uses WinTypes, WinProcs, WinCrt, Strings, UseTcp4w;
  7.  
  8. Const LTIL = $7000;
  9.  
  10. Type PLongTextItem = ^TLongTextItem;
  11.      TLongTextItem = Array [0..LTIL] Of Char;
  12.  
  13. Var Status: Integer;
  14.     S: TSocket;
  15.     Port: Integer;
  16.     T: PLongTextItem;
  17.     SaveExitProc : Pointer;
  18.  
  19. Procedure WriteWinsockVerInfo;
  20.   Const WSADESCRIPTION_LEN = 256;
  21.         WSASYS_STATUS_LEN = 128;
  22.   Type TWSAData = Record
  23.            wVersion: Word;
  24.            wHighVersion: Word;
  25.            szDescription: Array [0..WSADESCRIPTION_LEN] Of Char;
  26.            szSystemStatus: Array [0..WSASYS_STATUS_LEN] Of Char;
  27.            iMaxSockets: Byte;
  28.            iMaxUdpDg: Byte;
  29.            lpVendorInfo: Pointer;
  30.          End;
  31.        TWSAStartUp = Function (wVersionRequested: Word; WSAData: TWSAData): Integer;
  32.        TWSACleanup = Function: Integer;
  33.   Var WSAData: TWSAData;
  34.       hWinsock: THandle;
  35.       FP : TFarProc;
  36.   Begin
  37.     hWinsock := LoadLibrary ('WINSOCK');
  38.     If hWinsock >= 32 Then
  39.       Begin
  40.         FP := GetProcAddress (hWinsock, 'WSAStartup');
  41.         If FP <> NIL Then
  42.           If TWSAStartUp (FP) (257, WSAData) = 0 Then
  43.             WriteLn (WSAData.szDescription);
  44.         FP := GetProcAddress (hWinsock, 'WSACleanup');
  45.         If FP <> NIL Then TWSACleanUp (FP);
  46.         FreeLibrary (hWinsock)
  47.       End
  48.   End;
  49.  
  50. Procedure CheckStatus;
  51.   Begin
  52.     If Status > 0 Then Exit;
  53.     WriteLn;
  54.     WriteLn ('?', Tcp4W_Error (Status));
  55.     Halt
  56.   End;
  57.  
  58. Procedure MyExitProc; Far;
  59.   Begin
  60.     ExitProc := SaveExitProc;
  61.     If S <> 0 Then TcpClose (S);
  62.     Tcp4WCleanup;
  63.   End;
  64.  
  65. Procedure GetAnswer;
  66.   Begin
  67.     Status := TcpRecv (S, T^, LTIL, 1000, -1);
  68.     CheckStatus;
  69.     T^[Status] := #0;
  70.     Write (T^)
  71.   End;
  72.  
  73. Procedure MainLoop;
  74.   Begin
  75.     Repeat
  76.       ReadLn (T^);
  77.       StrCat (T^, #13#10);
  78.       If StrLIComp (T^, 'EXIT', 4) = 0 Then Exit;
  79.       If StrLIComp (T^, 'ENDE', 4) = 0 Then Exit;
  80.       If StrLIComp (T^, 'QUIT', 4) = 0 Then Exit;
  81.       Status := TcpSend (S, T^, StrLen (T^) , False, -1);
  82.       CheckStatus;
  83.       GetAnswer;
  84.     Until False
  85.   End;
  86.  
  87. Begin
  88.   CheckBreak := False;
  89.   CmdShow := sw_ShowMaximized;
  90.   AutoTracking := False;
  91.   New (T);
  92.   WriteLn ('Simple Koala Client by AStA (Andreas.Tikart@uni-konstanz.de) <Polarwolf>');
  93.   Tcp4wVer (T^, 0);
  94.   WriteLn (T^);
  95.   WriteWinsockVerInfo;
  96.   WriteLn;
  97.   S := 0;
  98.   Port := 775;
  99.   SaveExitProc := ExitProc;
  100.   ExitProc := @MyExitProc;
  101.   Status := Tcp4wInit;
  102.   CheckStatus;
  103.  
  104.   Status := TcpConnect (S, 'polydos.uni-konstanz.de', '', Port);
  105.   CheckStatus;
  106.  
  107.   GetAnswer;
  108.   GetAnswer;
  109.   MainLoop;
  110.   TcpClose (S);
  111.   S := 0;
  112.   CheckStatus;
  113.   Tcp4WCleanUp;
  114.   ExitProc := SaveExitProc;
  115.   DoneWinCrt;
  116. End.
  117.