home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic 5 Developer's Kit / vb5 dev kit.iso / dev / tcp4w20 / samples / pascal / usetcp4w.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1996-06-10  |  10.6 KB  |  262 lines
  1. Unit UseTCP4W;
  2. { * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * }
  3. {                                                                 }
  4. {                                                                 }
  5. {                                                                 }
  6. {   TCP4W.DLL  (Version 2.0)                                      }
  7. {                                                                 }
  8. {                                                                 }
  9. {                                                   By Ph. Jounin }
  10. {                                        Internet ark@ifh.sncf.fr }
  11. { * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * }
  12. {  Pascal Interface written by Andreas Tikart AStA Uni Konstanz   }
  13. {  (Andreas.Tikart@uni-konstanz.de) in cooperation with Polarwolf }
  14. { * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * }
  15.  
  16. Interface
  17.  
  18. Uses WinTypes, WinProcs;
  19.  
  20. Type PSocket = ^TSocket;
  21.      TSocket = THandle;
  22.  
  23.      TIP = Record
  24.        Case Byte Of
  25.          0: (B1, B2, B3, B4: Byte);
  26.          1: (L: Longint);
  27.        End;
  28.  
  29. Const
  30. { ------------------------------- }
  31. { Return codes of TCP4W functions }
  32. { ------------------------------- }
  33. TCP4U_SUCCESS         =  1;  { >=1 function OK            }
  34. TCP4U_ERROR           = -1;  { error                      }
  35. TCP4U_TIMEOUT         = -2;  { timeout has occured        }
  36. TCP4U_BUFFERFREED     = -3;  { the buffer has been freed  }
  37. TCP4U_HOSTUNKNOWN     = -4;  { connect to unknown host    }
  38. TCP4U_NOMORESOCKET    = -5;  { all socket has been used   }
  39. TCP4U_NOMORERESOURCE  = -5;  { or no more free resource   }
  40. TCP4U_CONNECTFAILED   = -6;  { connect function has failed}
  41. TCP4U_UNMATCHEDLENGTH = -7;  { TcpPPRecv : Error in length}
  42. TCP4U_BINDERROR       = -8;  { bind failed (Task already started?) }
  43. TCP4U_OVERFLOW        = -9;  { Overflow during TcpPPRecv  }
  44. TCP4U_EMPTYBUFFER     =-10;  { TcpPPRecv receives 0 byte  }
  45. TCP4U_CANCELLED       =-11;  { Call cancelled by TcpAbort }
  46. TCP4U_INSMEMORY       =-12;  { Not enough memory          }
  47. TCP4U_SOCKETCLOSED    =  0;  { Host has close connection  }
  48.  
  49. { ------------------------------ }
  50. { Return codes of TN4W functions }
  51. { ------------------------------ }
  52. TN_SUCCESS       =  IP_SUCCESS;
  53. TN_ERROR         =  IP_ERROR;
  54. TN_TIMEOUT       =  IP_TIMEOUT;
  55. TN_BUFFERFREED   =  IP_BUFFERFREED;
  56. TN_SOCKETCLOSED  =  IP_SOCKETCLOSED;
  57. TN_OVERFLOW      = 2;
  58.  
  59. Type
  60. { ------------------------------------------------- }
  61. { Registration functions                            }
  62. { ------------------------------------------------- }
  63. TTcp4uInit = Function: Integer;
  64. TTcp4uCleanup = Function: Integer;
  65. TTcp4uVer = Function (szVerStr: PChar; nStrSize: Integer): Integer;
  66. TTcp4uErrorString = Function (nReturnCode: Integer): PChar;
  67.  
  68.  
  69. { ------------------------------------------------- }
  70. { TCP functions                                     }
  71. { ------------------------------------------------- }
  72. TTcpAbort = Function: Integer;
  73. TTcpAccept = Function (Var CSock: TSocket; ListenSock: TSocket; nTO: Integer): Integer;
  74. TTcpConnect = Function (Var S: TSocket; szServer, szService: PChar; Var lpPort: Integer): Integer;
  75. TTcpClose = Function (Var S: TSocket): Integer;
  76. TTcpFlush = Function (S: TSocket): Integer;
  77. TTcpGetListenSocket = Function (Var S: TSocket; szService: PChar; Var lpPort: Integer; nPendingConnection: Integer): Integer;
  78. TTcpGetLocalID = Function (szStrName: PChar; NameSize: Integer; Var lpAddress: TIP): Integer;
  79. TTcpGetRemoteID = Function (S: TSocket; szStrName: PChar; NameSize: Integer; Var lpAddress: TIP): Integer;
  80. TTcpRecv = Function (S: TSocket; szBuf: PChar; BufSize, TimeOut: Integer; hf: Integer): Integer;
  81. TTcpSend = Function (S: TSocket; szBuf: PChar; BufSize: Integer; bHighPriority: Bool; hf: Integer): Integer;
  82. TTcpIsDataAvail = Function (S: TSocket): Integer;
  83. TTcpIsOOBDataAvail = Function (S: TSocket): Integer;
  84.  
  85. { PP protocole (2 first bytes contain length of data) }
  86. TTcpPPRecv = Function (S: TSocket; szBuf: PChar; BufSize, TimeOut: Integer; bExact: Bool; hLogFile: Integer): Integer;
  87. TTcpPPSend = Function (S: TSocket; szBuf: PChar; BufSize: Integer; hLogFile: Integer): Integer;
  88.  
  89. TTcpRecvUntilStr = Function (S: TSocket; szBuf: PChar; Var lpBufSize: Integer;
  90.     szStop: PChar; StopSize: Integer; bCaseSensitive: Bool; TimeOut: Integer; hLogFile: Integer): Integer;
  91.  
  92. { ------------------------------------------------- }
  93. { Telnet functions                                  }
  94. { ------------------------------------------------- }
  95. TTnReadLine = Function (S: TSocket; szBuf: PChar; BufSize, TimeOut: Integer; hf: Integer): Integer;
  96. TTnSend = Function (S: TSocket; szString: PChar; bHighPriority: Bool; hf: Integer): Integer;
  97. TTnGetAnswerCode = Function (ctrl_skt: TSocket; szInBuf: PChar; BufSize, TimeOut: Integer; hf: Integer): Integer;
  98.  
  99. Var
  100. { ------------------------------------------------- }
  101. { Var's                                             }
  102. { ------------------------------------------------- }
  103. Tcp4wInit: TTcp4wInit;
  104. Tcp4wCleanup: TTcp4wCleanup;
  105. Tcp4wVer: TTcp4wVer;
  106. TcpAbort: TTcpAbort;
  107. TcpAccept: TTcpAccept;
  108. TcpConnect: TTcpConnect;
  109. TcpClose: TTcpClose;
  110. TcpFlush: TTcpFlush;
  111. TcpGetListenSocket: TTcpGetListenSocket;
  112. TcpGetLocalID: TTcpGetLocalID;
  113. TcpGetRemoteID: TTcpGetRemoteID;
  114. TcpRecv: TTcpRecv;
  115. TcpSend: TTcpSend;
  116. TcpIsDataAvail: TTcpIsDataAvail;
  117. TcpPPRecv: TTcpPPRecv;
  118. TcpPPSend: TTcpPPSend;
  119. TcpRecvUntilStr: TTcpRecvUntilStr;
  120. TnReadLine: TTnReadLine;
  121. TnSend: TTnSend;
  122. TnGetAnswerCode: TTnGetAnswerCode;
  123.  
  124. {Extra Functions}
  125. Function  TCP4W_Error (ErrorValue: Integer): PChar;
  126.  
  127. Implementation
  128.  
  129. Var hTcp4w: THandle;
  130.     SaveExitProc : Pointer;
  131.  
  132. Procedure OpenTcp4wDLL;
  133.   Var FP: TFarProc;
  134.   Begin
  135.     hTcp4w := LoadLibrary ('TCP4W.DLL');
  136.     If hTcp4w < 32 Then Exit;
  137.     FP := GetProcAddress (hTcp4W, 'Tcp4wInit');
  138.     Tcp4wInit := TTcp4wInit (FP);
  139.     FP := GetProcAddress (hTcp4W, 'Tcp4wCleanup');
  140.     Tcp4wCleanup := TTcp4wCleanup (FP);
  141.     FP := GetProcAddress (hTcp4W, 'Tcp4wVer');
  142.     Tcp4wVer := TTcp4wVer (FP);
  143.  
  144.     FP := GetProcAddress (hTcp4W, 'Tcp4uInit');
  145.     Tcp4uInit := TTcp4uInit (FP);
  146.     FP := GetProcAddress (hTcp4W, 'Tcp4uCleanup');
  147.     Tcp4uCleanup := TTcp4uCleanup (FP);
  148.     FP := GetProcAddress (hTcp4W, 'Tcp4uVer');
  149.     Tcp4uVer := TTcp4uVer (FP);
  150.     FP := GetProcAddress (hTcp4W, 'Tcp4uErrorString');
  151.     Tcp4uVer := TTcp4uErrorString (FP);
  152.  
  153.     FP := GetProcAddress (hTcp4W, 'TcpAbort');
  154.     TcpAbort := TTcpAbort (FP);
  155.     FP := GetProcAddress (hTcp4W, 'TcpAccept');
  156.     TcpAccept := TTcpAccept (FP);
  157.     FP := GetProcAddress (hTcp4W, 'TcpConnect');
  158.     TcpConnect := TTcpConnect (FP);
  159.     FP := GetProcAddress (hTcp4W, 'TcpClose');
  160.     TcpClose := TTcpClose (FP);
  161.     FP := GetProcAddress (hTcp4W, 'TcpFlush');
  162.     TcpFlush := TTcpFlush (FP);
  163.     FP := GetProcAddress (hTcp4W, 'TcpGetListenSocket');
  164.     TcpGetListenSocket := TTcpGetListenSocket (FP);
  165.     FP := GetProcAddress (hTcp4W, 'TcpGetLocalID');
  166.     TcpGetLocalID := TTcpGetLocalID (FP);
  167.     FP := GetProcAddress (hTcp4W, 'TcpGetRemoteID');
  168.     TcpGetRemoteID := TTcpGetRemoteID (FP);
  169.     FP := GetProcAddress (hTcp4W, 'TcpRecv');
  170.     TcpRecv := TTcpRecv (FP);
  171.     FP := GetProcAddress (hTcp4W, 'TcpSend');
  172.     TcpSend := TTcpSend (FP);
  173.     FP := GetProcAddress (hTcp4W, 'TcpIsDataAvail');
  174.     TcpIsDataAvail := TTcpIsDataAvail (FP);
  175.     FP := GetProcAddress (hTcp4W, 'TcpPPRecv');
  176.     TcpPPRecv := TTcpPPRecv (FP);
  177.     FP := GetProcAddress (hTcp4W, 'TcpPPSend');
  178.     TcpPPSend := TTcpPPSend (FP);
  179.     FP := GetProcAddress (hTcp4W, 'TcpRecvUntilStr');
  180.     TcpRecvUntilStr := TTcpRecvUntilStr (FP);
  181.     FP := GetProcAddress (hTcp4W, 'TnReadLine');
  182.     TnReadLine := TTnReadLine (FP);
  183.     FP := GetProcAddress (hTcp4W, 'TnSend');
  184.     TnSend := TTnSend (FP);
  185.     FP := GetProcAddress (hTcp4W, 'TnGetAnswerCode');
  186.     TnGetAnswerCode := TTnGetAnswerCode (FP);
  187.   End;
  188.  
  189. Function TCP4W_Error (ErrorValue: Integer): PChar;
  190.   {return a PChar related to the ErrorValue given}
  191.   {as a parameter}
  192.   Var Msg: PChar;
  193.   Begin
  194.     Case ErrorValue Of
  195.         IP_ERROR           : Msg :=  'error';
  196.         IP_TIMEOUT         : Msg :=  'timeout has occured';
  197.         IP_BUFFERFREED     : Msg :=  'the buffer has been freed';
  198.         IP_HOSTUNKNOWN     : Msg :=  'connect to unknown host';
  199.         IP_NOMORESOCKET    : Msg :=  'all socket has been used';
  200.         IP_NOMORERESOURCE  : Msg :=  'or no more free resource';
  201.         IP_CONNECTFAILED   : Msg :=  'connect function has failed';
  202.         IP_UNMATCHEDLENGTH : Msg :=  'Error in length';
  203.         IP_BINDERROR       : Msg :=  'bind failed (Task already started?)';
  204.         IP_OVERFLOW        : Msg :=  'Overflow during TcpPPRecv';
  205.         IP_EMPTYBUFFER     : Msg :=  'TcpPPRecv receives 0 byte';
  206.         IP_CANCELLED       : Msg :=  'Call cancelled by TcpAbort';
  207.         IP_INSMEMORY       : Msg :=  'Not enough memory';
  208.         IP_SOCKETCLOSED    : Msg :=  'Host has close connection';
  209.       Else Msg := 'Unknown Error';
  210.       End;
  211.     TCP4W_Error := MSG;
  212.   End;
  213.  
  214. Procedure MyExitProc; Far;
  215.   Begin
  216.     ExitProc := SaveExitProc;
  217.     If hTcp4W >= 32 Then
  218.       Begin
  219.         Tcp4uCleanUp;
  220.         FreeLibrary (hTcp4W);
  221.       End;
  222.   End;
  223.  
  224. Begin
  225.   hTcp4W := 0;
  226.   SaveExitProc := ExitProc;
  227.   ExitProc := @MyExitProc;
  228.   OpenTcp4wDLL;
  229.   If hTcp4W < 32 Then
  230.     Begin
  231.       MessageBox (0, 'TCP4W not found', '', mb_IconStop + mb_SystemModal + mb_Ok);
  232.       Halt
  233.     End
  234. End.
  235.  
  236.  
  237. { ------------------------------------------------- }
  238. { old calls and constants                           }
  239. { ------------------------------------------------- }
  240.  
  241.  
  242. IP_SUCCESS         =  1;  { >=1 function OK            }
  243. IP_ERROR           = -1;  { error                      }
  244. IP_TIMEOUT         = -2;  { timeout has occured        }
  245. IP_BUFFERFREED     = -3;  { the buffer has been freed  }
  246. IP_HOSTUNKNOWN     = -4;  { connect to unknown host    }
  247. IP_NOMORESOCKET    = -5;  { all socket has been used   }
  248. IP_NOMORERESOURCE  = -5;  { or no more free resource   }
  249. IP_CONNECTFAILED   = -6;  { connect function has failed}
  250. IP_UNMATCHEDLENGTH = -7;  { TcpPPRecv : Error in length}
  251. IP_BINDERROR       = -8;  { bind failed (Task already started?) }
  252. IP_OVERFLOW        = -9;  { Overflow during TcpPPRecv  }
  253. IP_EMPTYBUFFER     =-10;  { TcpPPRecv receives 0 byte  }
  254. IP_CANCELLED       =-11;  { Call cancelled by TcpAbort }
  255. IP_INSMEMORY       =-12;  { Not enough memory          }
  256. IP_SOCKETCLOSED    =  0;  { Host has close connection  }
  257.  
  258. TTcp4wInit = Function: Integer;
  259. TTcp4wCleanup = Function: Integer;
  260. TTcp4wVer = Function (szVerStr: PChar; nStrSize: Integer): Integer;
  261. TTcp4wErrorString = Function (nReturnCode: Integer): PChar;
  262.