tcpmsgserver.pas

使用delphi自带的控件

unit tcpMsgServer;

interface

uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms,
  Dialogs, DBTables, DB, IdBaseComponent, IdComponent, IdTCPServer,
  Serv, CommonDef, Database;

type
  TdmeMsgServer = class(TDataModule)
    tcpMsgServer: TIdTCPServer;
    procedure DataModuleCreate(Sender: TObject);
    procedure tcpMsgServerLoginCommand(ASender: TIdCommand);
    procedure tcpMsgServerLogoffCommand(ASender: TIdCommand);
    procedure tcpMsgServerNoCommandHandler(ASender: TIdTCPServer;
      const AData: String; AThread: TIdPeerThread);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure SendCommandResult(ResultStr: string; AThread: TIdPeerThread);
  end;

var
  dmeMsgServer: TdmeMsgServer;

implementation

{$R *.dfm}

procedure TdmeMsgServer.DataModuleCreate(Sender: TObject);
begin
  if (tcpMsgServer.Active)  then
    tcpMsgServer.Active := False;
  try
    tcpMsgServer.DefaultPort := 10555;
    tcpMsgServer.Active := True;
  except
    ShowMessage('不能打开端口 - 10555. 可能是因为这个端口已经被占用. 无法提供正常服务. 请查看原因后重试');
    Application.Terminate;
  end;
end;


{***************************
 真正响应客户端请求的工作
 由过程SendCommandResult完成
 使用WriteLn向客户端发送数据
 ResultStr为要写入的数据信息
****************************}
procedure TdmeMsgServer.SendCommandResult(ResultStr: string; AThread: TIdPeerThread);
var
  I:  Integer;
  ResultsList:  TStringList;
begin
  ResultsList := TStringList.Create;
  ResultsList.Text := ResultStr;
  //一行一行的发送数据信息到客户端
  for I:=0 to  ResultsList.Count do
  AThread.Connection.WriteLn(ResultsList.Strings[I]);
  //完成发送任务后发送一个‘.’
  AThread.Connection.WriteLn('.'); 
end;




procedure TdmeMsgServer.tcpMsgServerLoginCommand(ASender: TIdCommand);
var
  UserName: string;
  Password: string;
begin
  UserName := ASender.Params.Strings[0];
  Password := ASender.Params.Strings[1];
  if (UserLogin(UserName, Password)) then
  begin
    SendCommandResult(LoginOk, Asender.Thread);
    frmMain.AddLoginedUser(UserName, ASender.Thread);
  end
  else
  begin
    SendCommandResult(LoginError, Asender.Thread);
  end;
end;

procedure TdmeMsgServer.tcpMsgServerLogoffCommand(ASender: TIdCommand);
var
  UserName: string;
begin
  UserName := ASender.Params.Strings[0];
  if (UserLogoff(UserName)) then
  begin
    SendCommandResult(LogoffOk, Asender.Thread);
    frmMain.DelLoginedUser(UserName, ASender.Thread);
  end
  else
  begin
    SendCommandResult(LogoffError, Asender.Thread);
  end;
end;

procedure TdmeMsgServer.tcpMsgServerNoCommandHandler(ASender: TIdTCPServer;
  const AData: String; AThread: TIdPeerThread);
begin
  if (AData = '.') then
  //end of line is found, do nothing
  begin
    Exit;
  end
  else
  begin
    SendCommandResult('Unknow_Command "'+AData+'" is found!', AThread);
  end;
end;

end.