《GOF设计模式》—状态（STATE）—Delphi源码示例：网络连接

示例：网络连接
说明：
考虑一个表示网络连接的类TCPConnection。一个TCPConnection对象的状态处于若干不同状态之一：连接已建立（Established）、正在监听(Listening)、连接已关闭(Closed)。State模式描述了TCPConnection如何在每一种状态下表现出不同的行为。

代码：
 
unit uTCPConnection;

interface

uses
    SysUtils, Classes,Dialogs;

type
    TTCPState = class;
    TTCPOctetStream = class
    end;

    TTCPConnection = class
    private
        FState: TTCPState;
        procedure ChangeState(s: TTCPState);
    public
        constructor Create;
        //---
        procedure ActiveOpen();  //--主动打开连接
        procedure PassiveOpen(); //--被动打开连接
        procedure Close();
        procedure Send();        //--发送
        procedure Acknowledge(); //--应答
        procedure Synchronize();
        //---
        procedure ProcessOctet(os: TTCPOctetStream);  //--处理字节流
    end;

    TTCPState = class
    protected
        procedure ChangeState(c: TTCPConnection; s: TTCPState);
    public
        procedure ActiveOpen(c: TTCPConnection); virtual;
        procedure PassiveOpen(c: TTCPConnection); virtual;
        procedure Close(c: TTCPConnection); virtual;
        procedure Send(c: TTCPConnection); virtual;
        procedure Acknowledge(c: TTCPConnection); virtual;
        procedure Synchronize(c: TTCPConnection); virtual;
        procedure Transmit(c: TTCPConnection; os: TTCPOctetStream); virtual;
    end;

    TTCPClosed = class(TTCPState)      //--连接已关闭
    public
        constructor Create;
        destructor Destroy; override;
        //---
        class function Instance(): TTCPState;
        //---
        procedure ActiveOpen(c: TTCPConnection); override;  //--主动打开连接
        procedure PassiveOpen(c: TTCPConnection); override; //--被动打开连接
    end;

    TTCPEstablished = class(TTCPState)  //--连接已建立，数据传输状态
    public
        constructor Create;
        destructor Destroy; override;
        //---
        class function Instance(): TTCPState;
        //---
        procedure Close(c: TTCPConnection); override;
        procedure Send(c: TTCPConnection); override;
        procedure Transmit(c: TTCPConnection; os: TTCPOctetStream);  override;
    end;

    TTCPListening = class(TTCPState)  //--正在监听
    public
        constructor Create;
        destructor Destroy; override;
        procedure Acknowledge(c: TTCPConnection); override;
        //---
        class function Instance(): TTCPState;
        //---
        procedure Send(c: TTCPConnection); override;
    end;

procedure Test;

implementation

var
    FTCPClosed: TTCPClosed;
    FTCPEstablished: TTCPEstablished;
    FTCPListening: TTCPListening;

procedure Test;
    //---
    procedure _TCPClient;
    var
        AClient:TTCPConnection;
    begin
        AClient := TTCPConnection.Create;
        try
            with AClient do
            begin
                ActiveOpen;
                Send;
                Close;
            end;
        finally
            AClient.Free;
        end;
    end;
    //---
    procedure _TCPServer;
    var
        AServer:TTCPConnection;
    begin
        AServer := TTCPConnection.Create;
        try
            with AServer do
            begin
                PassiveOpen;
                //---
                Acknowledge;
                Send;
                Send;
                //---
                Close;
            end;
        finally
            AServer.Free;
        end;
    end;
begin
    //_TCPClient;
    _TCPServer;
end;

procedure TTCPConnection.ChangeState(s: TTCPState);
begin
    FState := s;
end;

constructor TTCPConnection.Create;
begin
    inherited;
    //---
    FState := TTCPClosed.Instance;
end;

procedure TTCPConnection.ActiveOpen();
begin
    FState.ActiveOpen(self);
end;

procedure TTCPConnection.PassiveOpen();
begin
    FState.PassiveOpen(self);
end;

procedure TTCPConnection.Close();
begin
    FState.Close(self);
end;

procedure TTCPConnection.Send();
begin
    FState.Send(self);
end;

procedure TTCPConnection.Acknowledge();
begin
    FState.Acknowledge(self);
end;

procedure TTCPConnection.Synchronize();
begin
    FState.Synchronize(self);
end;

procedure TTCPConnection.ProcessOctet(os: TTCPOctetStream);
begin
end;

procedure TTCPState.ChangeState(c: TTCPConnection; s: TTCPState);
begin
    c.ChangeState(s);
end;

procedure TTCPState.Transmit(c: TTCPConnection; os: TTCPOctetStream);
begin
end;

procedure TTCPState.ActiveOpen(c: TTCPConnection);
begin
end;

procedure TTCPState.PassiveOpen(c: TTCPConnection);
begin
end;

procedure TTCPState.Close(c: TTCPConnection);
begin
end;

procedure TTCPState.Synchronize(c: TTCPConnection);
begin
end;

procedure TTCPState.Acknowledge(c: TTCPConnection);
begin
end;

procedure TTCPState.Send(c: TTCPConnection);
begin
end;

class function TTCPClosed.Instance(): TTCPState;
begin
    if FTCPClosed = nil then
        FTCPClosed := TTCPClosed.Create;
    //---
    result := FTCPClosed;
end;

procedure TTCPClosed.ActiveOpen(c: TTCPConnection);
{
SYN是TCP/IP建立连接时使用的握手信号。在客户机和服务器之间建立正常的TCP网络连接时，
客户机首先发出一个SYN消息，服务器使用SYN-ACK应答表示接收到了这个消息，
最后客户机再以ACK消息响应。这样在客户机和服务器之间才能建立起可靠的TCP连接，
数据才可以在客户机和服务器之间传递。
}
begin
    //发送SYN,接收SYN,ACK等
    ChangeState(c,TTCPEstablished.Instance);
end;

procedure TTCPClosed.PassiveOpen(c: TTCPConnection);
begin
    ChangeState(c,TTCPListening.Instance);
end;

procedure TTCPEstablished.Transmit(c: TTCPConnection; os: TTCPOctetStream);
begin
    c.ProcessOctet(os);
end;

procedure TTCPEstablished.Close(c: TTCPConnection);
{FIN是用来扫描保留的端口，发送一个FIN包（或者是任何没有ACK或SYN标记的包）到目标的一个开放的端口，
然后等待回应。许多系统会返回一个复位标记。 }
begin
    //发送FIN,接收ACK OF FIN等
    ChangeState(c,TTCPListening.Instance);
end;

constructor TTCPListening.Create;
begin
    if FTCPListening = nil then
        FTCPListening := Self
    else
        raise Exception.Create('Error');
end;

destructor TTCPListening.Destroy;
begin
    FTCPListening := nil;
    //---
    inherited;
end;

procedure TTCPListening.Acknowledge(c: TTCPConnection);
begin
    ShowMessage('Listening.Acknowledge');
end;

class function TTCPListening.Instance: TTCPState;
begin
    if FTCPListening = nil then
        FTCPListening := TTCPListening.Create;
    //---
    result := FTCPListening;
end;

procedure TTCPListening.Send(c: TTCPConnection);
begin
    //发送SYN,接收SYN,ACK等
    ChangeState(c,TTCPEstablished.Instance);
end;

constructor TTCPEstablished.Create;
begin
    if FTCPEstablished = nil then
        FTCPEstablished := Self
    else
        raise Exception.Create('Error');
end;

destructor TTCPEstablished.Destroy;
begin
    FTCPEstablished := nil;
    //---
    inherited;
end;

class function TTCPEstablished.Instance: TTCPState;
begin
    if FTCPEstablished = nil then
        FTCPEstablished := TTCPEstablished.Create;
    //---
    result := FTCPEstablished;
end;

procedure TTCPEstablished.Send(c: TTCPConnection);
begin
    ShowMessage('Established.Send');
end;

constructor TTCPClosed.Create;
begin
    if FTCPClosed = nil then
        FTCPClosed := Self
    else
        raise Exception.Create('Error');
end;

destructor TTCPClosed.Destroy;
begin
    FTCPClosed := nil;
    //---
    inherited;
end;

initialization
    FTCPClosed := nil;
    FTCPEstablished := nil;
    FTCPListening := nil;

finalization
    if FTCPClosed <> nil then
        FTCPClosed.Free;
    if FTCPEstablished <> nil then
        FTCPEstablished.Free;
    if FTCPListening <> nil then
        FTCPListening.Free;
end.