home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Runimage / Delphi50 / Demos / Internet / Chat / MAIN.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1999-08-11  |  5.0 KB  |  181 lines
  1. unit main;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   Menus, StdCtrls, Buttons, ScktComp, ExtCtrls, ComCtrls;
  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.     Memo1: TMemo;
  20.     Memo2: TMemo;
  21.     N1: TMenuItem;
  22.     SpeedButton1: TSpeedButton;
  23.     Disconnect1: TMenuItem;
  24.     ServerSocket: TServerSocket;
  25.     ClientSocket: TClientSocket;
  26.     procedure FileListenItemClick(Sender: TObject);
  27.     procedure FileConnectItemClick(Sender: TObject);
  28.     procedure Exit1Click(Sender: TObject);
  29.     procedure Memo1KeyDown(Sender: TObject; var Key: Word;
  30.       Shift: TShiftState);
  31.     procedure FormCreate(Sender: TObject);
  32.     procedure ServerSocketError(Sender: TObject; Number: Smallint;
  33.       var Description: string; Scode: Integer; const Source,
  34.       HelpFile: string; HelpContext: Integer; var CancelDisplay: Wordbool);
  35.     procedure Disconnect1Click(Sender: TObject);
  36.     procedure ClientSocketConnect(Sender: TObject;
  37.       Socket: TCustomWinSocket);
  38.     procedure ClientSocketRead(Sender: TObject; Socket: TCustomWinSocket);
  39.     procedure ServerSocketClientRead(Sender: TObject;
  40.       Socket: TCustomWinSocket);
  41.     procedure ServerSocketAccept(Sender: TObject;
  42.       Socket: TCustomWinSocket);
  43.     procedure ServerSocketClientConnect(Sender: TObject;
  44.       Socket: TCustomWinSocket);
  45.     procedure ClientSocketDisconnect(Sender: TObject;
  46.       Socket: TCustomWinSocket);
  47.     procedure ClientSocketError(Sender: TObject; Socket: TCustomWinSocket;
  48.       ErrorEvent: TErrorEvent; var ErrorCode: Integer);
  49.     procedure ServerSocketClientDisconnect(Sender: TObject;
  50.       Socket: TCustomWinSocket);
  51.   protected
  52.     IsServer: Boolean;
  53.   end;
  54.  
  55. var
  56.   ChatForm: TChatForm;
  57.   Server: String;
  58.  
  59. implementation
  60.  
  61. {$R *.DFM}
  62.  
  63. procedure TChatForm.FileListenItemClick(Sender: TObject);
  64. begin
  65.   FileListenItem.Checked := not FileListenItem.Checked;
  66.   if FileListenItem.Checked then
  67.   begin
  68.     ClientSocket.Active := False;
  69.     ServerSocket.Active := True;
  70.     Statusbar1.Panels[0].Text := 'Listening...';
  71.   end
  72.   else
  73.   begin
  74.     if ServerSocket.Active then
  75.       ServerSocket.Active := False;
  76.     Statusbar1.Panels[0].Text := '';
  77.   end;
  78. end;
  79.  
  80. procedure TChatForm.FileConnectItemClick(Sender: TObject);
  81. begin
  82.   if ClientSocket.Active then ClientSocket.Active := False;
  83.   if InputQuery('Computer to connect to', 'Address Name:', Server) then
  84.     if Length(Server) > 0 then
  85.       with ClientSocket do
  86.       begin
  87.         Host := Server;
  88.         Active := True;
  89.         FileListenItem.Checked := False;
  90.       end;
  91. end;
  92.  
  93. procedure TChatForm.Exit1Click(Sender: TObject);
  94. begin
  95.   ServerSocket.Close;
  96.   ClientSocket.Close;
  97.   Close;
  98. end;
  99.  
  100. procedure TChatForm.Memo1KeyDown(Sender: TObject; var Key: Word;
  101.   Shift: TShiftState);
  102. begin
  103.   if Key = VK_Return then
  104.     if IsServer then
  105.       ServerSocket.Socket.Connections[0].SendText(Memo1.Lines[Memo1.Lines.Count - 1])
  106.     else
  107.       ClientSocket.Socket.SendText(Memo1.Lines[Memo1.Lines.Count - 1]);
  108. end;
  109.  
  110. procedure TChatForm.FormCreate(Sender: TObject);
  111. begin
  112.   FileListenItemClick(nil);
  113. end;
  114.  
  115. procedure TChatForm.ServerSocketError(Sender: TObject; Number: Smallint;
  116.   var Description: string; Scode: Integer; const Source, HelpFile: string;
  117.   HelpContext: Integer; var CancelDisplay: Wordbool);
  118. begin
  119.   ShowMessage(Description);
  120. end;
  121.  
  122. procedure TChatForm.Disconnect1Click(Sender: TObject);
  123. begin
  124.   ClientSocket.Active := False;
  125.   ServerSocket.Active := True;
  126.   Statusbar1.Panels[0].Text := 'Listening...';
  127. end;
  128.  
  129. procedure TChatForm.ClientSocketConnect(Sender: TObject;
  130.   Socket: TCustomWinSocket);
  131. begin
  132.   Statusbar1.Panels[0].Text := 'Connected to: ' + Socket.RemoteHost;
  133. end;
  134.  
  135. procedure TChatForm.ClientSocketRead(Sender: TObject;
  136.   Socket: TCustomWinSocket);
  137. begin
  138.   Memo2.Lines.Add(Socket.ReceiveText);
  139. end;
  140.  
  141. procedure TChatForm.ServerSocketClientRead(Sender: TObject;
  142.   Socket: TCustomWinSocket);
  143. begin
  144.   Memo2.Lines.Add(Socket.ReceiveText);
  145. end;
  146.  
  147. procedure TChatForm.ServerSocketAccept(Sender: TObject;
  148.   Socket: TCustomWinSocket);
  149. begin
  150.   IsServer := True;
  151.   Statusbar1.Panels[0].Text := 'Connected to: ' + Socket.RemoteAddress;
  152. end;
  153.  
  154. procedure TChatForm.ServerSocketClientConnect(Sender: TObject;
  155.   Socket: TCustomWinSocket);
  156. begin
  157.   Memo2.Lines.Clear;
  158. end;
  159.  
  160. procedure TChatForm.ClientSocketDisconnect(Sender: TObject;
  161.   Socket: TCustomWinSocket);
  162. begin
  163.   FileListenItemClick(nil);
  164. end;
  165.  
  166. procedure TChatForm.ClientSocketError(Sender: TObject;
  167.   Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  168.   var ErrorCode: Integer);
  169. begin
  170.   Memo2.Lines.Add('Error connecting to : ' + Server);
  171.   ErrorCode := 0;
  172. end;
  173.  
  174. procedure TChatForm.ServerSocketClientDisconnect(Sender: TObject;
  175.   Socket: TCustomWinSocket);
  176. begin
  177.   Statusbar1.Panels[0].Text := 'Listening...';
  178. end;
  179.  
  180. end.
  181.