home *** CD-ROM | disk | FTP | other *** search
/ Delphi 5 for Professionals / DELPHI5.iso / Info / Extras / NetManage / Demos / Tcp / main.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1997-03-17  |  3.7 KB  |  145 lines
  1. unit main;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   OleCtrls, ExtCtrls, ComCtrls, Menus, ActiveX, StdCtrls, Buttons, isp3;
  8.  
  9. type
  10.   TChatForm = class(TForm)
  11.     MainMenu1: TMainMenu;
  12.     File1: TMenuItem;
  13.     Exit1: TMenuItem;
  14.     FileConnectItem: TMenuItem;
  15.     FileListenItem: TMenuItem;
  16.     StatusBar1: TStatusBar;
  17.     Bevel1: TBevel;
  18.     Panel1: TPanel;
  19.     TCP1: TTCP;
  20.     Memo1: TMemo;
  21.     TCP2: TTCP;
  22.     Memo2: TMemo;
  23.     N1: TMenuItem;
  24.     SpeedButton1: TSpeedButton;
  25.     Disconnect1: TMenuItem;
  26.     procedure FileListenItemClick(Sender: TObject);
  27.     procedure TCP1ConnectionRequest(Sender: TObject; requestID: Integer);
  28.     procedure FileConnectItemClick(Sender: TObject);
  29.     procedure TCP1DataArrival(Sender: TObject; bytesTotal: Integer);
  30.     procedure Exit1Click(Sender: TObject);
  31.     procedure TCP1Close(Sender: TObject);
  32.     procedure Memo1KeyDown(Sender: TObject; var Key: Word;
  33.       Shift: TShiftState);
  34.     procedure FormCreate(Sender: TObject);
  35.     procedure TCP2Connect(Sender: TObject);
  36.     procedure TCP1Error(Sender: TObject; Number: Smallint;
  37.       var Description: string; Scode: Integer; const Source,
  38.       HelpFile: string; HelpContext: Integer; var CancelDisplay: Wordbool);
  39.     procedure Disconnect1Click(Sender: TObject);
  40.     procedure TCP2Close(Sender: TObject);
  41.   end;
  42.  
  43. var
  44.   ChatForm: TChatForm;
  45.   Server: String;
  46.   N: Integer;
  47.  
  48. implementation
  49.  
  50. {$R *.DFM}
  51.  
  52. procedure TChatForm.FileListenItemClick(Sender: TObject);
  53. begin
  54.   FileListenItem.Checked := not FileListenItem.Checked;
  55.   if FileListenItem.Checked then
  56.   begin
  57.     TCP2.Close;
  58.     TCP1.Listen;
  59.     Statusbar1.Panels[0].Text := 'Listening...'
  60.   end
  61.   else
  62.   begin
  63.     if TCP1.State <> sckClosed then
  64.       TCP1.Close;
  65.     Statusbar1.Panels[0].Text := '';
  66.   end;
  67. end;
  68.  
  69. procedure TChatForm.TCP1ConnectionRequest(Sender: TObject;
  70.   requestID: Integer);
  71. begin
  72.   FileListenItemClick(nil);
  73.   TCP2.Accept(requestID);
  74.   Statusbar1.Panels[0].Text := 'Connected to: ' + TCP1.RemoteHostIP;
  75. end;
  76.  
  77. procedure TChatForm.FileConnectItemClick(Sender: TObject);
  78. begin
  79.   if TCP2.State <> sckClosed then TCP2.Close;
  80.   if InputQuery('Computer to connect to', 'IP Address :', Server) then
  81.     if Length(Server) > 0 then
  82.       TCP2.Connect(Server, 1024);
  83. end;
  84.  
  85. procedure TChatForm.TCP1DataArrival(Sender: TObject; bytesTotal: Integer);
  86. var
  87.   Data: OleVariant;
  88. begin
  89.   TCP2.GetData(Data, VT_BSTR, bytesTotal);
  90.   Memo2.Lines.Add(Data);
  91. end;
  92.  
  93. procedure TChatForm.Exit1Click(Sender: TObject);
  94. begin
  95.   TCP1.Close;
  96.   TCP2.Close;
  97.   Close;
  98. end;
  99.  
  100. procedure TChatForm.TCP1Close(Sender: TObject);
  101. begin
  102.   ShowMessage('TCP1.Close');
  103.   Statusbar1.Panels[0].Text := 'Disconnected';
  104. end;
  105.  
  106. procedure TChatForm.Memo1KeyDown(Sender: TObject; var Key: Word;
  107.   Shift: TShiftState);
  108. begin
  109.   if Key = VK_Return then
  110.     TCP2.SendData(Memo1.Lines[Memo1.Lines.Count - 1]);
  111. end;
  112.  
  113. procedure TChatForm.FormCreate(Sender: TObject);
  114. begin
  115.   FileListenItemClick(nil);
  116. end;
  117.  
  118. procedure TChatForm.TCP2Connect(Sender: TObject);
  119. begin
  120.   if TCP1.State = sckListening then
  121.     FileListenItemClick(nil);
  122.   Statusbar1.Panels[0].Text := 'Connected to: ' + Server;
  123. end;
  124.  
  125. procedure TChatForm.TCP1Error(Sender: TObject; Number: Smallint;
  126.   var Description: string; Scode: Integer; const Source, HelpFile: string;
  127.   HelpContext: Integer; var CancelDisplay: Wordbool);
  128. begin
  129.   ShowMessage(Description);
  130. end;
  131.  
  132. procedure TChatForm.Disconnect1Click(Sender: TObject);
  133. begin
  134.   TCP2.Close;
  135.   FileListenItemClick(nil);
  136. end;
  137.  
  138. procedure TChatForm.TCP2Close(Sender: TObject);
  139. begin
  140.   TCP1.Close;
  141.   FileListenItemClick(nil);
  142. end;
  143.  
  144. end.
  145.