iggstreamclient.pas

通信控件

unit IGgStreamClient;

interface

uses
  WinSock, Windows, Classes, SysUtils, StdCtrls, Controls, RTLConsts, IGgCommonType, IGgNet, IGgClientPool, IGgPacket;

const
  DEF_CLIENT_PORT = 10199;

type

  { TIClient }

  TOnConnectStatusNotify = procedure(NameID: string; Statue: Integer; IP: string; Port: Integer) of object;
  TOnSendBufferNotify = procedure(NameID: string; BufferSize: Integer; ErrString: string='') of object;
  TOnReceiveBufferNotify = procedure(NameID: string; Buffer: Pointer; BufferSize: Integer; ErrCode: Integer=0) of object;
  TOnSendStartNotify = procedure(NameID: string; BufferSize: Integer; ErrString: string='') of object;
  TOnReceiveStartNotify = procedure(NameID: string; BufferSize: Integer) of object;

  TICheckThread = TINetThread;

  TIClient = class(TINetMgr)
  private
    FUDPServer: TIUDP;
    FRoutePool: TIRoutePool;
    FMsgPool	: TGGMessagePool;
    FOutPool 	: TGGOutPool;
    FInPool	 	: TGGInPool;
    FRecvSequ	: TGGRecvSequ;
    FReadBuffers: TIBufferPool;
    FWriteBuffers: TIBufferPool;
    FCheckThd: TIWorkThread;
    
    FActive  : Boolean;
    FSelfID  : DWORD;
    FNameID  : string;
    FInteSec : Integer;
    FLastErr : Integer;
    FRegister: Boolean;

    FLocalIP	 : Integer;
    FLocalPort : Integer;
    FServerIP	 : Integer;
    FServerPort: Integer;
    FLoginIP	 : Integer;
    FLoginPort : Integer;

    FOnConnectNotify: TOnConnectStatusNotify;
    FOnSendNotify: TOnSendBufferNotify;
    FOnReceiveNotify: TOnReceiveBufferNotify;

    FNameStrings: TStringList;

  protected
    procedure Init;
    procedure Clear;
    procedure SetNative;
    function CheckValidValue: Boolean;
    procedure SetActive(V: Boolean);
    function CreateNetService: Integer;
    function FreeNetService: Integer;
    procedure CreateCheckThread;
    procedure StopCheckThread;
    procedure DoCheckProc;
    procedure OnUDPProc(var PktTag: TPacketTag);
    function DoBufferPool(var PTag: TPacketTag; Check: Boolean): Integer;
    function DoRoutePool(var PTag: TPacketTag; Check: Boolean): Integer;
    function DoMsgPool(var PTag: TPacketTag; Check: Boolean): Integer;
    function DoOutPool(var PTag: TPacketTag; Check: Boolean): Integer;
    function DoInPool(var PTag: TPacketTag; Check: Boolean): Integer;
    procedure AroundDealInBlock(var PItem: PInItem; IP: Integer; Port: Integer);
    procedure AroundDealOutBlock(var PItem: POutItem; IP: Integer=0; Port: Integer=0);
    function Packeted(var PItem: PMessageItem; var Route: TRoute; SelBV: Integer=ThdBUF_): Pointer;
    function GetRoute(AttachID: DWORD): TRoute;
    function GetNameOfID(ID: DWORD): string;
    procedure DoConnectNotify(AttachID: DWORD; Status: Integer; IP: Integer; Port: Integer);
    procedure DoSendNotify(ID: DWORD; SendSize: Integer; ErrCode: Integer=0);
    procedure DoReceiveNotify(ID: DWORD; Buffer: Pointer; BufferSize: Integer; ErrCode: Integer=0);
    procedure TIBufferCallback(AttachID: DWORD; var Rec; RecSize: Integer; PData: Pointer; DataSize: WORD; Cmd: WORD);
    function QueryWorkBuffer(AttachID: DWORD; IsRead: Boolean=TRUE): Integer;
    procedure StartWaitBuffer(AttachID: DWORD);

    procedure DoRegister(NameID: string);
    procedure OnRegister(PHeader: PSPKHeader);
    procedure DoUnregister();
    procedure OnUnRegister(PHeader: PSPKHeader);
  public
    constructor Create();
    destructor Destroy(); override;

    function GetBindAddress: string;
    procedure SetBindAddress(Value: string);
    function GetBindPort: Integer;
    procedure SetBindPort(Value: Integer);
    function GetServerAddress: string;
    procedure SetServerAddress(Value: string);
    function GetServerPort: Integer;
    procedure SetServerPort(Value: Integer);
    function GetExternalIP: string;
    function GetExternalPort: Integer;

    function Send(RecvID: Integer; Sequ: Integer): Integer;
    function SendRecMsgProc(RecvID: DWord; var Rec; RecSize: Integer; Command: Word; Respond: Word; Rule: Integer=0): Integer;
    function SendMsgProc(RecvID: DWord; var Rec; RecSize: Integer; Data: Pointer; DataSize: Integer; Command: Word; Respond: Word; Rule: Integer=0): Integer;
    procedure Open(NameID: string; ServerAddr: string; BindAddr: string='');
    procedure Close();
    procedure SetOwnerInfo(Info: Pointer; InfoSize: Integer);
    function GetOwnerInfo(): Pointer;
    function GetUserInfo(NameID: string): Pointer;
    procedure Connect(NameID: string); overload;
    function Connect(AttachID: DWORD; IsCheckSyn: Boolean=FALSE): Integer; overload;
    procedure Disconnect(NameID: string); overload;
    procedure Disconnect(AttachID: DWORD); overload;
    function GetConnectSyn(AttachID: DWORD; Operator: DWORD): TConnectSyn;
    function PackedInReadBuffer(AttachID: DWORD; SynID: DWORD; Buffer: Pointer; BufferSize: Integer): Integer;
    procedure SendBuffer(NameID: string; Buffer: Pointer; BufferSize: Integer); overload;
    procedure SendBuffer(AttachID: Integer; Buffer: Pointer; BufferSize: Integer); overload;
    function PackedBuffer(var PItem: PMessageItem; var Route: TRoute): Pointer;
    function SendBufferMsgProc(RecvID: DWord; var Rec; RecSize: Integer; Cmd: Word;
 			Rule: Word; Data: Pointer; DataSize: Integer): Integer;
    property Active: Boolean read FActive Write SetActive;
    property OnConnectNotify: TOnConnectStatusNotify read FOnConnectNotify write FOnConnectNotify;
    property OnSendNotify: TOnSendBufferNotify read FOnSendNotify write FOnSendNotify;
    property OnReceiveNotify: TOnReceiveBufferNotify read FOnReceiveNotify write FOnReceiveNotify;
  end;

implementation

  { TIClent }

constructor TIClient.Create();
begin
  Init;
end;
destructor TIClient.Destroy();
begin
  Clear;
end;
procedure TIClient.Init;
begin
  try
    //FillChar(Self, SizeOf(TIClient), 0);
    FActive      := FALSE;
    FRoutePool   := TIRoutePool.Create;
    FMsgPool	   := TGGMessagePool.Create;
    FOutPool 	   := TGGOutPool.Create;
    FInPool	 	   := TGGInPool.Create;
    FRecvSEQU	   := TGGRecvSEQU.Create;
    FNameStrings := TStringList.Create;
    FReadBuffers := TIBufferPool.Create;
    FWriteBuffers := TIBufferPool.Create;
    SetNative;
  except end;
end;
procedure TIClient.Clear;
begin
  SetActive(FALSE);

  try
    if Assigned(FUDPServer) then  begin
      FUDPServer.Free;
    end;
  except  end;

  try
    if Assigned(FRoutePool) then
      FRoutePool.Free;
    if Assigned(FOutPool) then
      FOutPool.Free;
    if Assigned(FInPool) then
      FInPool.Free;
    if Assigned(FMsgPool) then
      FMsgPool.Free;
    if Assigned(FRecvSEQU) then
      FRecvSEQU.Free;
    if Assigned(FNameStrings) then
      FNameStrings.Free;
    try
    if Assigned(FReadBuffers) then
      FReadBuffers.Free;
    except end;
    try
    if Assigned(FWriteBuffers) then
      FWriteBuffers.Free;
    except end;
  except  end;
end;
procedure TIClient.SetNative;
begin
  SetServerAddress('');
  SetServerPort(10177);
  SetBindAddress('');
  SetBindPort(DEF_CLIENT_PORT);
end;
function TIClient.GetBindAddress: string;
begin
  Result := IPToString(FLocalIP);
end;
procedure TIClient.SetBindAddress(Value: string);
begin
  FLocalIP := GetHostIP(Value);
end;
function TIClient.GetBindPort: Integer;
begin
  Result := WinSock.ntohs(FLocalPort);
end;
procedure TIClient.SetBindPort(Value: Integer);
begin
  if (Value > 2048) and (Value < 65535) then
  begin
    FLocalPort := WinSock.htons(Value);
  end;
end;
function TIClient.GetServerAddress: string;
begin
  Result := IPToString(FServerIP);
end;
procedure TIClient.SetServerAddress(Value: string);
begin
  FServerIP := GetHostIP(Value);
end;
function TIClient.GetServerPort: Integer;
begin
  Result := WinSock.ntohs(FServerPort);
end;
procedure TIClient.SetServerPort(Value: Integer);
begin
  if (Value > 2048) and (Value < 65535) then
  begin
    FServerPort := WinSock.htons(Value);
  end;
end;
function TIClient.GetExternalIP: string;
begin
  Result := IPToString(FLoginIP);
end;
function TIClient.GetExternalPort: Integer;
begin
  Result := WinSock.ntohs(FLoginPort);
end;
function TIClient.CheckValidValue: Boolean;
begin
  Result := FALSE;
end;
procedure TIClient.SetActive(V: Boolean);
begin
  if V <> FActive then
  begin
    if V then begin
      FActive := CreateNetService() = 0;
    end else begin
      FActive := (not FreeNetService() = 0);
    end;
  end;
end;

function TIClient.CreateNetService: Integer;
var
  Thread: TINetThread;
begin
  Result := -1;
  try
    FLocalPort := htons(GetFreePort(ntohl(FLocalIP),ntohs(FLocalPort)));
    FUDPServer := TIUDP.Create(FLocalIP, FLocalPort);
    if (FUDPServer.Enable) then
    begin
      Thread := TINetThread.Create(FUDPServer, TRUE);
      Put(FUDPServer);
      FUDPServer.Thread := Thread;
      Thread.RunProc    := FUDPServer.DoReceiveProc;
      FUDPServer.OnUDPMsgNotify := OnUDPProc;
      Thread.FreeOnTerminate    := TRUE;
      Thread.Resume;
    end;
    Sleep(100);
    if FUDPServer.Enable then
    begin
      CreateCheckThread;
      Result := 0;
    end;
  except  end;
end;

function TIClient.FreeNetService: Integer;
begin
  Result := -1;
  try
    FRoutePool.Cancel(0);
    StopCheckThread;
    QuitAll();
    Result := 0;
  finally
    FUDPServer := nil;
  end;
end;

procedure TIClient.DoCheckProc;
var
  Tag: TPacketTag;
begin
  try
    try
      Sleep(1000);
      while(FActive and Assigned(FCheckThd) and (not FCheckThd.Exit)) do
      begin
        if not FRegister then
          DoRegister(FNameID);
        DoRoutePool(Tag, TRUE);
        DoMsgPool(Tag, TRUE);
        DoBufferPool(Tag, TRUE);
        Sleep(1000);
      end;
    except
    end;
  finally
    DoUnRegister();
  end;
end;

procedure TIClient.CreateCheckThread;
begin
  FCheckThd := TIWorkThread.Create(TRUE);
  FCheckThd.RunProc := DoCheckProc;
  FCheckThd.FreeOnTerminate := TRUE;
  FCheckThd.Resume;
end;

procedure TIClient.StopCheckThread;
begin
  try
    if Assigned(FCheckThd) then
    begin
      FCheckThd.Stop;
    end;
    Sleep(150);
  except end;
  FCheckThd := nil;
end;

procedure TIClient.Open(NameID: string; ServerAddr: string; BindAddr: string);
begin
  SetServerAddress(ServerAddr);
  SetBindAddress(BindAddr);
  SetActive(TRUE);
  if FActive then
  begin
    DoRegister(NameID);
  end;
end;

procedure TIClient.Close();
begin
  if FActive then
  begin
    DoUnregister();
  end;
  SetActive(FALSE);
end;

procedure TIClient.OnUDPProc(var PktTag: TPacketTag);
var
  PWPK: PWPKHeader;
  Data: PChar;
begin
  try
    PWPK := PWPKHeader(PktTag.Data);
    //if check packet invalid then exit;
    case PWPK.SPK.bpkType of
      pkRPKH:begin
          DoRoutePool(PktTag, FALSE);
      end;
      pkBPKH:begin
        case PWPK.SPK.wCommand of
          RS_SOCK_REQBLK,SB_SOCK_REQ:
            DoInPool(PktTag, FALSE);
          SB_SOCK_REQBLK:
            DoOutPool(PktTag, FALSE);
        end;
      end;
      pkSPKH, pkWPKH:begin
        case PWPK.SPK.wCommand of
          RS_USER_REGISTER:
            OnRegister(PSPKHeader(PWPK));
          RS_USER_UNREGIST:
            OnUnRegister(PSPKHeader(PWPK));
        else
          DoMsgPool(PktTag, FALSE);
        end;
      end;
      pkMPKH:begin
        DoBufferPool(PktTag, FALSE);
      end;
    end;
  except end;
end;

procedure TIClient.DoRegister(NameID: string);

  procedure SetDescribe(NameID: string);
  begin
    FSelfID := CalculateID(NameID);
    FNameID := NameID;
    PktBox.FSelfID := FSelfID;
  end;

  procedure UDPRegister();
  var
    Data: TRegisterData;
  begin
    FillChar(Data, SizeOf(Data), 0);
    
    Data.dwID := FSelfID;
    Data.RegRoute.dwLocalIP := FLocalIP;
    Data.RegRoute.wLocalPort := FLocalPort;
    StrLCopy(Data.szNameID, PChar(FNameID), Length(FNameID));
    SendRecMsgProc(0, Data, SizeOf(Data), SB_USER_REGISTER, RS_USER_REGISTER);
  end;

var
  WaitSec: Integer;
begin
  if (NameID = '') then Exit;
  
  try
    SetDescribe(NameID);
    WaitSec := 5*1000;
    while(not FRegister and (WaitSec > 0)) do
    begin
      UDPRegister();
      Sleep(1000);
      Dec(WaitSec, 1000);
    end;
    if (not FRegister) then
      //DoClientError(ErrCode);
  except end;
end;

procedure TIClient.OnRegister(PHeader: PSPKHeader);
var
  PData: PRsRegisterData;
begin
  PData := Data(PHeader);

  if (PData.dwResult = 1) and (PData.dwID = FSelfID) then
  begin