《GOF设计模式》—命令（COMMAND）—Delphi源码示例：在不同的时刻指定、排列和执行请求

示例：在不同的时刻指定、排列和执行请求
说明：
一个Command对象可以有一个与初始请求无关的生存期。如果一个请求的接收者可用一种与地址空间无关的方式表达，那么就可将负责该请求的命令对象传送给另一个不同的进程（或命令队列）并在那儿实现该请求。

代码：
 

unit uCommand2;

interface

uses
SysUtils,Classes,Dialogs,ScktComp,Contnrs,SyncObjs;

type
    TClient = class;

    TCommand = class
    public
        procedure Execute(); virtual; abstract;
    end;

    TSocketCommand = class(TCommand)
    private
        FCurClientSocket: TCustomWinSocket;
        FReceiveText: string;
        FRequestCode: integer;
    public
        property RequestCode: integer read FRequestCode;
        property CurClientSocket: TCustomWinSocket write FCurClientSocket;
        property ReceiveText: string write FReceiveText;
    end;

    THandleCommand = class(TSocketCommand)
    end;
    THandleCommand_Error = class(THandleCommand)
    public
        constructor Create;
        //---
        procedure Execute; override;
    end;
    THandleCommand_1 = class(THandleCommand)
    public
        constructor Create;
        //---
        procedure Execute; override;
    end;
    THandleCommand_2 = class(THandleCommand)
    public
        constructor Create;
        //---
        procedure Execute; override;
    end;

    TReceiveCommand = class(TSocketCommand)
    public
        procedure Execute; override;
    end;
    TReceiveCommand_Error = class(TReceiveCommand)
    public
        constructor Create;
    end;
    TReceiveCommand_1 = class(TReceiveCommand)
    public
        constructor Create;
    end;
    TReceiveCommand_2 = class(TReceiveCommand)
    public
        constructor Create;
    end;

    TRequestCommand = class(TCommand)
    private
        FClient: TClient;
    public
        constructor Create(AClient: TClient);
    end;
    TRequestCommand_1 = class(TRequestCommand)
    public
        procedure Execute; override;
    end;
    TRequestCommand_2 = class(TRequestCommand)
    public
        procedure Execute; override;
    end;
    TRequestCommand_Simple = class(TRequestCommand)
    private
        FRequestCode: integer;
    public
        constructor Create(AClient: TClient; ARequestCode: integer);
        //---
        procedure Execute; override;
    end;

    TCommandThread = class(TThread)
    private
        FCommands: TObjectList;
        FLock: TCriticalSection;
        procedure Lock;
        procedure UnLock;
        procedure ExecCommand;
    protected
        procedure Execute; override;
    public
        constructor Create(CreateSuspended: Boolean);
        destructor Destroy; override;
        //---
        procedure AddCommand(ACommand: TCommand);
    end;

    TCommandSocket = class
    private
        FCommands: TObjectList;
        function FindCommand(ARequestCode: integer): THandleCommand;
        procedure SocketRead(Sender: TObject; Socket: TCustomWinSocket);
    public
        constructor Create;
        destructor Destroy; override;
    end;

    TServer = class(TCommandSocket)
    private
        FServerSocket: TServerSocket;
    public
        constructor Create;
        destructor Destroy; override;
    end;

    TClient = class(TCommandSocket)
    private
        FClientSocket: TClientSocket;
    public
        constructor Create(const IP: string);
        destructor Destroy; override;
        //---
        procedure SendRequest(const ARequest: string);
    end;

implementation

const
    CNT_ErrorCode = 0;

constructor TServer.Create;
    //---
    procedure _InitCommands;
    begin
        with FCommands do
        begin
            Add(THandleCommand_Error.Create);
            Add(THandleCommand_1.Create);
            Add(THandleCommand_2.Create);
        end;
    end;
    //---
    procedure _InitServer;
    begin
        FServerSocket := TServerSocket.Create(nil);
        with FServerSocket do
        begin
            Port := 1028;
            Active := True;
            //---
            OnClientRead := self.SocketRead;
        end;
    end;
begin
    inherited Create;
    //---
    _InitCommands;
    _InitServer;
end;

destructor TServer.Destroy;
begin
    with FServerSocket do
    begin
        Close;
        Free;
    end;
    //---
    inherited;
end;

constructor THandleCommand_1.Create;
begin
    inherited Create;
    //---
    FRequestCode := 1;
end;

procedure THandleCommand_1.Execute;
begin
    FCurClientSocket.SendText('111');
end;

constructor THandleCommand_Error.Create;
begin
    inherited Create;
    //---
    FRequestCode := CNT_ErrorCode;
end;

procedure THandleCommand_Error.Execute;
begin
    FCurClientSocket.SendText('Error');
end;

constructor THandleCommand_2.Create;
begin
    inherited Create;
    //---
    FRequestCode := 2;
end;

procedure THandleCommand_2.Execute;
begin
    FCurClientSocket.SendText('222');
end;

constructor TClient.Create(const IP: string);
    //---
    procedure _InitCommands;
    begin
        with FCommands do
        begin
            Add(TReceiveCommand_Error.Create);
            Add(TReceiveCommand_1.Create);
            Add(TReceiveCommand_2.Create);
        end;
    end;
    //---
    procedure _InitClient;
    begin
        FClientSocket := TClientSocket.Create(nil);
        with FClientSocket do
        begin
            Host := IP;
            Port := 1028;
            Active := true;
            //---
            OnRead := self.SocketRead;
        end;
    end;
begin
    inherited Create;
    //---
    _InitCommands;
    _InitClient;
end;

destructor TClient.Destroy;
begin
    with FClientSocket do
    begin
        Close;
        Free;
    end;
    //---
    inherited;
end;

procedure TClient.SendRequest(const ARequest: string);
begin
    if FClientSocket.Active then
        FClientSocket.Socket.SendText(ARequest);
end;

constructor TRequestCommand.Create(AClient: TClient);
begin
    inherited Create;
    //---
    FClient := AClient;
end;

procedure TRequestCommand_1.Execute;
begin
    FClient.SendRequest('1');
end;

procedure TRequestCommand_2.Execute;
begin
    FClient.SendRequest('2');
end;

constructor TRequestCommand_Simple.Create(AClient: TClient;
    ARequestCode: integer);
begin
    inherited Create(AClient);
    //---
    FRequestCode := ARequestCode;
end;

procedure TRequestCommand_Simple.Execute;
begin
    FClient.SendRequest(IntToStr(FRequestCode));
end;

constructor TReceiveCommand_1.Create;
begin
    inherited Create;
    //---
    FRequestCode := 1;
end;

procedure TReceiveCommand.Execute;
begin
    if Length(FReceiveText) > 0 then
        ShowMessage(FReceiveText);
end;

constructor TReceiveCommand_2.Create;
begin
    inherited Create;
    //---
    FRequestCode := 2;
end;

constructor TReceiveCommand_Error.Create;
begin
    inherited Create;
    //---
    FRequestCode := CNT_ErrorCode;
end;

{ TCommandThread }

procedure TCommandThread.AddCommand(ACommand: TCommand);
begin
    self.Lock;
    try
        FCommands.Add(ACommand);
    finally
        self.UnLock;
    end;
end;

constructor TCommandThread.Create(CreateSuspended: Boolean);
begin
    inherited;
    //---
    FCommands := TObjectList.Create;
    FLock := TCriticalSection.Create;
end;

destructor TCommandThread.Destroy;
begin
    FCommands.Free;
    FLock.Free;
    //---
    inherited;
end;

procedure TCommandThread.ExecCommand;
begin
    self.Lock;
    try
        if FCommands.Count > 0 then
        begin
            TCommand(FCommands[0]).Execute;
            FCommands.Delete(0);
        end;
    finally
        self.UnLock;
    end;
end;

procedure TCommandThread.Execute;
begin
    FreeOnTerminate := True;
    //---
    while not Terminated do
    begin
        ExecCommand;
        Sleep(200);
    end;
end;

procedure TCommandThread.Lock;
begin
    FLock.Enter;
end;

procedure TCommandThread.UnLock;
begin
    FLock.Leave;
end;

constructor TCommandSocket.Create;
begin
    FCommands := TObjectList.Create;
end;

destructor TCommandSocket.Destroy;
begin
    FCommands.Free;
    //---
    inherited;
end;

function TCommandSocket.FindCommand(ARequestCode: integer): THandleCommand;
var
    i: integer;
begin
    with FCommands do
    begin
        for i := 0 to Count - 1 do
        begin
            Result := THandleCommand(Items[i]);
            if Result.RequestCode = ARequestCode then
                exit;
        end;
    end;
    //---
    Result := nil;
end;

procedure TCommandSocket.SocketRead(Sender: TObject; Socket: TCustomWinSocket);
    //---
    procedure _HandleRequest;
    var
        AReceiveText: string;
        ARequestCode: integer;
        ACommand: TSocketCommand;
    begin
        AReceiveText := Socket.ReceiveText;
        //---
        ARequestCode := StrToIntDef(PChar(AReceiveText)^,CNT_ErrorCode);
        ACommand := FindCommand(ARequestCode);
        if ACommand = nil then
            ACommand := FindCommand(CNT_ErrorCode);
        with ACommand do
        begin
            CurClientSocket := Socket;
            ReceiveText := AReceiveText;
            Execute;
        end;
    end;
begin
    _HandleRequest;
end;

end.

unit Unit2;

interface

uses
    Windows,Messages,SysUtils,Variants,Classes,Graphics,Controls,Forms,
    Dialogs,StdCtrls,uCommand2;

type
    TForm2 = class(TForm)
        Button1: TButton;
        procedure FormDestroy(Sender: TObject);
        procedure FormCreate(Sender: TObject);
        procedure Button1Click(Sender: TObject);
    private
        FServer: TServer;
        FClient: TClient;
        FCommandThread:TCommandThread;
    public
    { Public declarations }
    end;

var
    Form2: TForm2;

implementation

{$R *.dfm}

procedure TForm2.FormCreate(Sender: TObject);
begin
    FServer := TServer.Create;
    FClient := TClient.Create('127.0.0.1');
    FCommandThread:=TCommandThread.Create(false);
end;

procedure TForm2.FormDestroy(Sender: TObject);
begin
    FClient.Free;
    FServer.Free;
    FCommandThread.Terminate;
end;

procedure TForm2.Button1Click(Sender: TObject);
begin
    with FCommandThread do
    begin
        AddCommand(TRequestCommand_1.Create(FClient));
        AddCommand(TRequestCommand_2.Create(FClient));
        AddCommand(TRequestCommand_Simple.Create(FClient,3));
    end;
end;

end.