home *** CD-ROM | disk | FTP | other *** search
/ PC Pro 1999 February / DPPCPRO0299.ISO / February / Delphi / Runimage / DELPHI20 / DEMOS / INTERNET / TCP / MAIN.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1996-06-10  |  3.7 KB  |  146 lines
  1. unit main;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   OleCtrls, ISP, ExtCtrls, ComCtrls, Menus, OLE2, StdCtrls, Buttons;
  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', 'Address (either IP or Name):', 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, DataType: Variant;
  88.   Ch: Integer;
  89. begin
  90.   TCP2.GetData(Data, VT_BSTR, bytesTotal);
  91.   Memo2.Lines.Add(Data);
  92. end;
  93.  
  94. procedure TChatForm.Exit1Click(Sender: TObject);
  95. begin
  96.   TCP1.Close;
  97.   TCP2.Close;
  98.   Close;
  99. end;
  100.  
  101. procedure TChatForm.TCP1Close(Sender: TObject);
  102. begin
  103.   ShowMessage('TCP1.Close');
  104.   Statusbar1.Panels[0].Text := 'Disconnected';
  105. end;
  106.  
  107. procedure TChatForm.Memo1KeyDown(Sender: TObject; var Key: Word;
  108.   Shift: TShiftState);
  109. begin
  110.   if Key = VK_Return then
  111.     TCP2.SendData(Memo1.Lines[Memo1.Lines.Count - 1]);
  112. end;
  113.  
  114. procedure TChatForm.FormCreate(Sender: TObject);
  115. begin
  116.   FileListenItemClick(nil);
  117. end;
  118.  
  119. procedure TChatForm.TCP2Connect(Sender: TObject);
  120. begin
  121.   if TCP1.State = sckListening then
  122.     FileListenItemClick(nil);
  123.   Statusbar1.Panels[0].Text := 'Connected to: ' + Server;
  124. end;
  125.  
  126. procedure TChatForm.TCP1Error(Sender: TObject; Number: Smallint;
  127.   var Description: string; Scode: Integer; const Source, HelpFile: string;
  128.   HelpContext: Integer; var CancelDisplay: Wordbool);
  129. begin
  130.   ShowMessage(Description);
  131. end;
  132.  
  133. procedure TChatForm.Disconnect1Click(Sender: TObject);
  134. begin
  135.   TCP2.Close;
  136.   FileListenItemClick(nil);
  137. end;
  138.  
  139. procedure TChatForm.TCP2Close(Sender: TObject);
  140. begin
  141.   TCP1.Close;
  142.   FileListenItemClick(nil);
  143. end;
  144.  
  145. end.
  146.