mainform.~pas

delphi socket 编程实例

{***************************************************************
 *
 * Project  : CBServ
 * Unit Name: MainForm
 * Purpose  :
 * Version  : 1.0
 * Date  : Wed 25 Apr 2001  -  01:12:54
 * Author  : Jeremy Darling <[e-mail]>
 * History  :
 * Tested  : Wed 25 Apr 2001  // Allen O'Neill <[e-mail]>
 *
 ****************************************************************}

Unit MainForm;

Interface

Uses
  {$IFDEF Linux}
  QGraphics,
  QControls,
  QForms,
  QDialogs,
  QComCtrls,
  QStdCtrls,
  QExtCtrls,
  QImgList,
  QMenus,
  {$ELSE}
  Graphics,
  Controls,
  Forms,
  Dialogs,
  ComCtrls,
  StdCtrls,
  ExtCtrls,
  ImgList,
  Menus,
  {$ENDIF}
  windows,
  messages,
  ToolWin,
  spin,
  SysUtils,
  Classes,
  IdBaseComponent,
  IdComponent,
  IdTCPServer,
  IdThreadMgr,
  IdThreadMgrDefault;

Type
  TSimpleClient = Class(TObject)
    DNS, Name: String;
    ListLink: Integer;
    Thread: Pointer;
  End;

  TfrmMain = Class(TForm)
    StatusBar1: TStatusBar;
    Panel1: TPanel;
    Panel2: TPanel;
    lbClients: TListBox;
    PageControl1: TPageControl;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    ImageList1: TImageList;
    Label3: TLabel;
    lblDNS: TLabel;
    tcpServer: TIdTCPServer;
    lblSocketVer: TLabel;
    Label5: TLabel;
    Label4: TLabel;
    seBinding: TSpinEdit;
    IdThreadMgrDefault1: TIdThreadMgrDefault;
    Label6: TLabel;
    memEntry: TMemo;
    Label7: TLabel;
    memEMotes: TMemo;
    Label8: TLabel;
    Label9: TLabel;
    lblClientName: TLabel;
    lblClientDNS: TLabel;
    puMemoMenu: TPopupMenu;
    Savetofile1: TMenuItem;
    Loadfromfile1: TMenuItem;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    ToolBar1: TToolBar;
    btnServerUp: TToolButton;
    ToolButton1: TToolButton;
    btnKillClient: TToolButton;
    btnClients: TToolButton;
    btnPM: TToolButton;
    Label12: TLabel;
    edSyopName: TEdit;
    Procedure btnServerUpClick(Sender: TObject);
    Procedure FormCreate(Sender: TObject);
    Procedure seBindingChange(Sender: TObject);
    Procedure tcpServerConnect(AThread: TIdPeerThread);
    Procedure tcpServerDisconnect(AThread: TIdPeerThread);
    Procedure FormClose(Sender: TObject; Var Action: TCloseAction);
    Procedure Savetofile1Click(Sender: TObject);
    Procedure Loadfromfile1Click(Sender: TObject);
    Procedure tcpServerExecute(AThread: TIdPeerThread);
    Procedure btnClientsClick(Sender: TObject);
    Procedure btnPMClick(Sender: TObject);
    Procedure btnKillClientClick(Sender: TObject);
    Procedure lbClientsClick(Sender: TObject);
  Private
    { Private declarations }
  Public
    { Public declarations }
    Clients: TList;
    Procedure UpdateBindings;
    Procedure UpdateClientList;
    Procedure BroadcastMessage(WhoFrom, TheMessage: String);
  End;

Var
  frmMain: TfrmMain;

Implementation

{$IFDEF MSWINDOWS}{$R *.dfm}{$ELSE}{$R *.xfm}{$ENDIF}

Uses
  IdSocketHandle; // This is where the IdSocketHandle class is defined.

Procedure TfrmMain.UpdateBindings;
Var
  Binding: TIdSocketHandle;
Begin
  { Set the TIdTCPServer's port to the chosen value }
  tcpServer.DefaultPort:= seBinding.Value;

  { Remove all bindings that currently exist }
  tcpServer.Bindings.Clear;

  { Create a new binding }
  Binding:= tcpServer.Bindings.Add;

  { Assign that bindings port to our new port }
  Binding.Port:= seBinding.Value;
End;

Procedure TfrmMain.btnServerUpClick(Sender: TObject);
Begin
  Try
    { Check to see if the server is online or offline }
    tcpServer.Active:= Not tcpServer.Active;
    btnServerUp.Down:= tcpServer.Active;
    If btnServerUp.Down Then
      Begin
        { Server is online }
        btnServerUp.ImageIndex:= 1;
        btnServerUp.Hint:= 'Shut down server';
      End
    Else
      Begin
        { Server is offline }
        btnServerUp.ImageIndex:= 0;
        btnServerUp.Hint:= 'Start up server';
      End;
    { Setup GUI buttons }
    btnClients.Enabled:= btnServerUp.Down;
    seBinding.Enabled:= Not btnServerUp.Down;
    edSyopName.Enabled:= Not btnServerUp.Down;
  Except
    { If we have a problem then rest things }
    btnServerUp.Down:= false;
    seBinding.Enabled:= Not btnServerUp.Down;
    btnClients.Enabled:= btnServerUp.Down;
    edSyopName.Enabled:= Not btnServerUp.Down;
  End;
End;

Procedure TfrmMain.FormCreate(Sender: TObject);
Begin
  { Initalize our clients list }
  Clients:= TList.Create;
  { Call updatebindings so that the servers bindings are correct }
  UpdateBindings;
  { Get the local DNS entry for this computer }
  lblDNS.Caption:= tcpServer.LocalName;
  { Display the current version of indy running on the system }
  lblSocketVer.Caption:= tcpServer.Version;
End;

Procedure TfrmMain.seBindingChange(Sender: TObject);
Begin
  UpdateBindings;
End;

Procedure TfrmMain.tcpServerConnect(AThread: TIdPeerThread);
Var
  Client: TSimpleClient;
Begin
  { Send a welcome message, and prompt for the users name }
  AThread.Connection.WriteLn('ISD Connection Established...');
  AThread.Connection.WriteLn('Please send valid login sequence...');
  AThread.Connection.WriteLn('Your Name:');
  { Create a client object }
  Client:= TSimpleClient.Create;
  { Assign its default values }
  Client.DNS:= AThread.Connection.LocalName;
  Client.Name:= 'Logging In';
  Client.ListLink:= lbClients.Items.Count;
  { Assign the thread to it for ease in finding }
  Client.Thread:= AThread;
  { Add to our clients list box }
  lbClients.Items.Add(Client.Name);
  { Assign it to the thread so we can identify it later }
  AThread.Data:= Client;
  { Add it to the clients list }
  Clients.Add(Client);
End;

Procedure TfrmMain.tcpServerDisconnect(AThread: TIdPeerThread);
Var
  Client: TSimpleClient;
Begin
  { Retrieve Client Record from Data pointer }
  Client:= Pointer(AThread.Data);
  { Remove Client from the Clients TList }
  Clients.Delete(Client.ListLink);
  { Remove Client from the Clients List Box }
  lbClients.Items.Delete(lbClients.Items.IndexOf(Client.Name));
  BroadcastMessage('System', Client.Name + ' has left the chat.');
  { Free the Client object }
  Client.Free;
  AThread.Data:= Nil;

End;

Procedure TfrmMain.FormClose(Sender: TObject; Var Action: TCloseAction);
Begin
  If (Clients.Count > 0) And
    (tcpServer.Active) Then
    Begin
      Action:= caNone;
      ShowMessage('Can''t close CBServ while server is online.');
    End
  Else
    Clients.Free;
End;

Procedure TfrmMain.Savetofile1Click(Sender: TObject);
Begin
  If Not (puMemoMenu.PopupComponent Is TMemo) Then
    exit;

  If SaveDialog1.Execute Then
    Begin
      TMemo(puMemoMenu.PopupComponent).Lines.SaveToFile(SaveDialog1.FileName);
    End;
End;

Procedure TfrmMain.Loadfromfile1Click(Sender: TObject);
Begin
  If Not (puMemoMenu.PopupComponent Is TMemo) Then
    exit;

  If OpenDialog1.Execute Then
    Begin
      TMemo(puMemoMenu.PopupComponent).Lines.LoadFromFile(OpenDialog1.FileName);
    End;
End;

Procedure TfrmMain.UpdateClientList;
Var
  Count: Integer;
Begin
  { Loop through all the clients connected to the system and set their names }
  For Count:= 0 To lbClients.Items.Count - 1 Do
    If Count < Clients.Count Then
      lbClients.Items.Strings[Count]:=
        TSimpleClient(Clients.Items[Count]).Name;
End;

Procedure TfrmMain.tcpServerExecute(AThread: TIdPeerThread);
Var
  Client: TSimpleClient;
  Com, // System command
  Msg: String;
Begin
  { Get the text sent from the client }
  Msg:= AThread.Connection.ReadLn;
  { Get the clients package info }
  Client:= Pointer(AThread.Data);
  { Check to see if the clients name has been assigned yet }
  If Client.Name = 'Logging In' Then
    Begin
      { if not, assign the name and announce the client }
      Client.Name:= Msg;
      UpdateClientList;
      BroadcastMessage('System', Msg + ' has just logged in.');
      AThread.Connection.WriteLn(memEntry.Lines.Text);
    End
  Else
    { If name is set, then send the message } If Msg[1] <> '@' Then
      Begin
        { Not a system command }
        BroadcastMessage(Client.Name, Msg);
      End
    Else
      Begin
        { System command }
        Com:= UpperCase(Trim(Copy(Msg, 2, Pos(':', Msg) - 2)));
        Msg:= UpperCase(Trim(Copy(Msg, Pos(':', Msg) + 1, Length(Msg))));
        If Com = 'CLIENTS' Then
          AThread.Connection.WriteLn('@' + 'clients:' +
            lbClients.Items.CommaText);
      End;
End;

Procedure TfrmMain.BroadcastMessage(WhoFrom, TheMessage: String);
Var
  Count: Integer;
  List: TList;
  EMote,
    Msg: String;
Begin
  Msg:= Trim(TheMessage);

  EMote:= Trim(memEMotes.Lines.Values[Msg]);

  If WhoFrom <> 'System' Then
    Msg:= WhoFrom + ': ' + Msg;

  If EMote <> '' Then
    Msg:= Format(Trim(EMote), [WhoFrom]);

  List:= tcpServer.Threads.LockList;
  Try
    For Count:= 0 To List.Count - 1 Do
      Try
        TIdPeerThread(List.Items[Count]).Connection.WriteLn(Msg);
      Except
        TIdPeerThread(List.Items[Count]).Stop;
      End;
  Finally
    tcpServer.Threads.UnlockList;
  End;
End;

Procedure TfrmMain.btnClientsClick(Sender: TObject);
Begin
  UpdateClientList;
End;

Procedure TfrmMain.btnPMClick(Sender: TObject);
Var
  Msg: String;
  Client: TSimpleClient;
Begin
  Msg:= InputBox('Private Message', 'What is the message', '');
  Msg:= Trim(Msg);
  Msg:= edSyopName.Text + '> ' + Msg;
  If (Msg <> '') And
    (lbClients.ItemIndex <> -1) Then
    Begin
      Client:= Clients.Items[lbClients.ItemIndex];
      TIdPeerThread(Client.Thread).Connection.WriteLn(Msg);
    End;
End;

Procedure TfrmMain.btnKillClientClick(Sender: TObject);
Var
  Msg: String;
  Client: TSimpleClient;
Begin
  Msg:= InputBox('Disconnect message', 'Enter a reason for the disconnect',
    '');
  Msg:= Trim(Msg);
  Msg:= edSyopName.Text + '> ' + Msg;
  If (Msg <> '') And
    (lbClients.ItemIndex <> -1) Then
    Begin
      Client:= Clients.Items[lbClients.ItemIndex];
      TIdPeerThread(Client.Thread).Connection.WriteLn(Msg);
      TIdPeerThread(Client.Thread).Connection.Disconnect;
      Clients.Delete(lbClients.ItemIndex);
      lbClients.Items.Delete(lbClients.ItemIndex);
    End;
End;

Procedure TfrmMain.lbClientsClick(Sender: TObject);
Var
  Client: TSimpleClient;
Begin
  btnPM.Enabled:= lbClients.ItemIndex <> -1;
  btnKillClient.Enabled:= btnPM.Enabled;

  If lbClients.ItemIndex = -1 Then
    exit;
  Client:= Clients.Items[lbClients.ItemIndex];
  lblClientName.Caption:= Client.Name;
  lblClientDNS.Caption:= Client.DNS;
End;

End.