iggstreamserver.pas

通信控件

unit IGgStreamServer;

interface

uses
   Windows, Classes, SysUtils, WinSock, SyncObjs, ExtCtrls, IGgCommonType, IGgNet, IGgPacket;

const

  MAX_I_COUNT      = 32;
  MAX_I_TOOBJECT   = 8;
  MAX_I_POOL       = 101;
  HEART_I_V        = 3;

type

  TIToObject = record
    dwToID     : DWORD;
    dwTaskID   : DWORD;
    dwRouteIP  : DWORD;
    wRoutePort : WORD;
    wSelectMode: WORD;

    wActiveHeart: WORD;
    wSendLastErr: WORD;
    wRecvLastErr: WORD;
    wReserved   : WORD;

    iSize: Integer;
    PData: Pointer;
  end;
  PIToObject = ^TIToObject;
  TIToObjects = array[0..MAX_I_TOOBJECT-1] of TIToObject;

  TIToList = record
    Count : Integer;
    Objects: TIToObjects;
  end;
  PIToList = ^TIToList;

  PIRegister = ^TIRegister;
  TIRegister = record
    SessionID: WORD;
    Heart    : WORD;
    Describe  : TIDescribe;
    RegRoute  : TIRegRoute;
    List      : TIToList;
    PNext     : PIRegister;
  end;
  TIRegisterList = array[0..MAX_I_POOL-1] of PIRegister;

  PIUsersLink = ^TIUsersLink;
  TIUsersLink = record
    NameID: string;
    Info: Pointer;
    InfoSize: Integer;
    Status: Integer;
    IPStr: string;
    Link: PIUsersLink;
  end;

  { TIRegisterPool }
  
  TIRegisterPool = class
  private
    FList : TIRegisterList;
    FCount: Integer;
    FLock : TCriticalSection;

  protected
    procedure Init;
    procedure Clear;
    function CheckEnable: Boolean;
    procedure Reset(var PIReg: PIRegister);
    function NewSlot(const dwID: DWORD): PIRegister;
    function FreeSlot(var PIReg: PIRegister): PIRegister; overload;
    function FreeSlot(iIdx: Integer; var PIReg: PIRegister): PIRegister; overload;
    function FirstSlot(iIdx: Integer): PIRegister;
    function LastSlot(iIdx: Integer): PIRegister;
	  function NextSlot(var PIReg: PIRegister): PIRegister;
	  function PrevSlot(var PIReg: PIRegister; iIdx: Integer): PIRegister;
    function Find(const dwID: DWORD): PIRegister;
    function SearchIn(var iIdx: Integer; const PIReg: PIRegister): PIRegister;
    function IndexOf(const PIReg: PIRegister): Integer;

  public
    constructor Create();
    destructor Destroy(); override;

    property Enable: Boolean read CheckEnable;

    function Put(var Describe: TIDescribe; var RegRoute: TIRegRoute; SessionID: WORD=0): PIRegister;
    function Remove(const dwID: DWORD; SessionID: WORD): Boolean; overload;
    procedure Remove(const dwID: DWORD); overload;
    function Heart(dwID: DWORD; SessionID: WORD; wPort: WORD; Heart: WORD=HEART_I_V): Boolean;
    function Update(var Describe: TIDescribe): Boolean;
    function Get(var Describe: TIDescribe; const dwID: DWORD): Boolean; overload;
    function Get(var RegRoute: TIRegRoute; const dwID: DWORD): Boolean; overload;
    function IsExist(const dwID: DWORD; const SessionID: WORD): Boolean;
    function IsValid(const dwID: DWORD): Boolean;
    procedure CheckHeart();
  end;

  { TIServer}

const
  DEF_SERVER_PORT =10177;

type
  THeart = record
    dwID : DWORD;
    dwIP : DWORD;
    wPort: WORD;
    wSessionID: WORD;
    Reserved: Integer;
  end;
  PHeart = ^THeart;

  TOnStartupNotify = procedure(Sender: TObject) of object;
  TOnStopNotify = procedure(Sender: TObject) of object;

  TIServer = class(TINetMgr)
  private
    FRegPool	: TIRegisterPool;
    FUDPServer: TIUDP;
    FTCPServer: TITCP;
    FThread: TIWorkThread;
    FBindIP  : DWORD;
    FBindPort: DWORD;
    FActive	 : Boolean;
    FUniqueID: DWORD;

    FThdBuffer : PChar;
    FTime: TTimer;
    FOnStartupNotify: TOnStartupNotify;
    FOnStopNotify: TOnStopNotify;

  protected
    procedure Init;
    procedure Clear;
    procedure SetNative;
    function CheckValidValue: Boolean;
    procedure SetActive(V: Boolean);
    function CreateNetService: Integer;
    function FreeNetService: Integer;
    procedure CreateThread;
    procedure StopThread;
    procedure ThreadProc(Sender: TObject);
    procedure CheckRegisterPool;
    procedure OnRegister(PHeader: PSPKHeader; dwIP: DWORD; wPort: WORD);
    procedure OnUnRegister(PHeader: PSPKHeader; dwIP: DWORD; wPort: WORD);
    procedure OnHeart(PHeader: PSPKHeader; dwIP: DWORD; wPort: WORD);
    procedure OnToServer(PHeader: PSPKHeader; dwIP: DWORD; wPort: WORD);
    procedure OnToClient(PHeader: PSPKHeader; dwIP: DWORD; wPort: WORD);
    procedure SendStatus(FromID: DWORD; ToID: DWORD=0; Status: Integer=0);
    procedure FwrWidePacket(PWPKH: PWPKHeader; IP: DWORD; Port: WORD);

    procedure OnSetUserInfo(PData: Pointer; Pack: PTCPPack; var PackR: TTCPPackR);
    procedure OnGetUserInfo(PData: Pointer; Pack: PTCPPack; var PackR: TTCPPackR);
    procedure OnCheckConnectSyn(PData: Pointer; Pack: PTCPPack; var PackR: TTCPPackR);

    procedure OnUDPProc(var PktTag: TPacketTag);
    procedure OnTCPProc(var TCPPeer: TITCPPeer);
    procedure OnTCPPeerProc(Owner: TITCPPeer);

    procedure DoStartupNotify;
    procedure DoStopNotify;
    
    //procedure UDPSend(var Describe; DescribeSize: Integer; dwIP: DWORD; wPort: WORD);

  public
    constructor Create();
    destructor Destroy(); override;

    function GetBindAddress: string;
    procedure SetBindAddress(const Value: string);
    function GetBindPort: Integer;
    procedure SetBindPort(const Value: Integer);

    function SetUserInfo(NameID: string; Info: Pointer; InfoSize: Integer): Integer;
    function GetUserInfo(NameID: string; var Info: Pointer): Integer;
    function GetUsersInfo(var Infos: Pointer; Status: Integer=0): Integer;
    procedure FreeUsersInfo(Infos: Pointer);
    procedure DeleteUser(Status: Integer=0); overload;
    function DeleteUser(NameID: string): Boolean; overload;

    property BindIP: DWORD read FBindIP;
    property BindPort: DWORD read FBindPort;
    property Active: Boolean read FActive write SetActive default FALSE;
    property OnStartupNotify: TOnStartupNotify read FOnStartupNotify write FOnStartupNotify;
    property OnStopNotify: TOnStopNotify read FOnStopNotify write FOnStopNotify;
  end;

implementation


{ TIRegisterPool }

constructor TIRegisterPool.Create();
begin
  FLock := TCriticalSection.Create;
  Init;
end;
destructor TIRegisterPool.Destroy();
begin
  Clear;
  FLock.Free;
end;
procedure TIRegisterPool.Init;
var
  I: Integer;
begin
  for I := 0 to MAX_I_POOL-1 do
  begin
    FList[I] := nil;
  end;
  FCount := 0;
end;
procedure TIRegisterPool.Clear;
var
  iIdx: Integer;
  PIReg, PIReg1: PIRegister;
begin
  FLock.Enter;
  try
  iIdx  := 0;
  PIReg := nil;
  while(TRUE)do
  begin
    PIReg := SearchIn(iIdx, PIReg);
    if PIReg = nil then Break;
    PIReg1 := FreeSlot(iIdx, PIReg);
    PIReg  := PIReg1;
  end;
  finally FLock.Leave; end;
end;
function TIRegisterPool.CheckEnable: Boolean;
begin
  Result := FALSE;
end;
procedure TIRegisterPool.Reset(var PIReg: PIRegister);
var
  I: Integer;
begin
  try
    if (PIReg <> nil) and Assigned(PIReg) then
    begin
      if (PIReg.Describe.Info <> nil) then
        FreeMem(PIReg.Describe.Info);
      for I := 0 to PIReg.List.Count-1 do begin
        if (PIReg.List.Objects[I].PData <> nil) and Assigned(PIReg.List.Objects[I].PData) then
          Dispose(PIReg.List.Objects[I].PData);
      end;
      FillChar(PIReg^, SizeOf(TIRegister), 0);
    end;
  except
    PIReg := nil;
  end;
end;
function TIRegisterPool.NewSlot(const dwID: DWORD): PIRegister;
begin
  Result := nil;
  try
    New(Result);   FillChar(Result^, SizeOf(Result^), 0);
    Reset(Result);
    Result.Describe.ID := dwID;
    Result.Heart       := 0;
    Result.PNext       := nil;
  except  end;
end;
function TIRegisterPool.FreeSlot(var PIReg: PIRegister): PIRegister;
begin
  Result := nil;
  try
    if (PIReg <> nil) and Assigned(PIReg) then begin
      Result := PIReg.PNext;
      Reset(PIReg);
      Dispose(PIReg);
      PIReg := nil;
    end;
  except  PIReg := nil;  end;
end;
function TIRegisterPool.FreeSlot(iIdx: Integer; var PIReg: PIRegister): PIRegister;
begin
  if (FirstSlot(iIdx) = PIReg) then
  begin
    Result := FreeSlot(PIReg);
    FList[iIdx] := Result;
  end else
    Result := FreeSlot(PIReg);
end;
function TIRegisterPool.FirstSlot(iIdx: Integer): PIRegister;
begin
  Result := nil;
  try
    if (iIdx>=0) and (iIdx<MAX_I_POOL) and Assigned(FList[iIdx]) then begin
      Result := FList[iIdx];
    end;
  except  end;
end;
function TIRegisterPool.LastSlot(iIdx: Integer): PIRegister;
begin
  try
    Result := FirstSlot(iIdx);
    while (Result <> nil) and (Result.PNext <> nil) and Assigned(Result.PNext) do
      Result := Result.PNext;
  except  Result := nil;  end;
end;
function TIRegisterPool.NextSlot(var PIReg: PIRegister): PIRegister;
begin
  Result := nil;
  try
    if (PIReg <> nil) and Assigned(PIReg) then
      Result := PIReg.PNext;
  except  end;     
end;
function TIRegisterPool.PrevSlot(var PIReg: PIRegister; iIdx: Integer): PIRegister;
begin
  try
    Result := FirstSlot(iIdx);
    if (Result <> nil) and (Result <> PIReg) then begin
      while (Result.PNext <> PIReg) do
        Result := Result.PNext;
    end else Result := nil;
  except Result := nil; end;
end;
function TIRegisterPool.Find(const dwID: DWORD): PIRegister;
var
  iIdx: Integer;
begin
  iIdx := dwID mod MAX_I_POOL;
  Result := FirstSlot(iIdx);
  while (Result <> nil) and (Result.Describe.ID <> dwID) do
    Result := Result.PNext;
end;
function TIRegisterPool.SearchIn(var iIdx: Integer; const PIReg: PIRegister): PIRegister;
begin
  FLock.Enter;
  Result := nil;
  try
    try
      if (PIReg <> nil) then
        Result := PIReg.PNext;

      while (Result = nil) do begin
        if (iIdx = MAX_I_POOL) then Break;
        Result := FirstSlot(iIdx);
        Inc(iIdx);
      end;
    except Result := nil; end;
  finally
    FLock.Leave;
  end;
end;
function TIRegisterPool.IndexOf(const PIReg: PIRegister): Integer;
var
  PITemp: PIRegister;
begin
  Result := 0;
  PITemp := nil;
  while (PIReg <> PITemp) do
  begin
    PITemp := SearchIn(Result, PITemp);
    if PITemp = nil then Break;
  end;
  if PIReg <> PITemp then Result := -1;
end;
function TIRegisterPool.Put(var Describe: TIDescribe; var RegRoute: TIRegRoute; SessionID: WORD): PIRegister;
var
  PEnd: PIRegister;
  iIdx: Integer;
begin
  FLock.Enter;
  try
    try
      Result := Find(Describe.ID);
      if (Result = nil) then
      begin
        Result := NewSlot(Describe.ID);
        if (Result <> nil)then
        begin
          iIdx := Describe.ID mod MAX_I_POOL;
          PEnd := LastSlot(iIdx);
          if (PEnd <> nil) then
            PEnd.PNext := Result
          else
            FList[iIdx] := Result;
          Inc(FCount);
        end;
      end;

      if (Result <> nil) then
      begin
        StrLCopy(Result.Describe.NameID, Describe.NameID, MAX_I_NAMEID-1);
        if (Describe.InfoSize > 0) and (Describe.InfoSize <> Result.Describe.InfoSize) then
        begin
          FreeMem(Result.Describe.Info);
          Result.Describe.Info := AllocMem(Describe.InfoSize + 1);
          Result.Describe.InfoSize := Describe.InfoSize;
          Move(Describe.Info^, Result.Describe.Info^, Describe.InfoSize);
        end;
        Result.RegRoute   := RegRoute;
        Result.SessionID  := SessionID;
      end;
    except Result := nil; end;
  finally
    FLock.Leave;
  end;
end;

function TIRegisterPool.Remove(const dwID: DWORD; SessionID: WORD): Boolean;
var
  PRemove: PIRegister;
begin
  FLock.Enter;
  try
    PRemove := Find(dwID);
    Result := (PRemove <> nil) and (PRemove.SessionID = SessionID);
    if (Result) then
      Remove(dwID);
  finally
    FLock.Leave;
  end;
end;

procedure TIRegisterPool.Remove(const dwID: DWORD);
var
  PRemove, PPrev: PIRegister;
  iIdx: Integer;
begin
  PRemove := Find(dwID);
  if (PRemove <> nil) then begin
    iIdx := dwID mod MAX_I_POOL;
    PPrev := PrevSlot(PRemove, iIdx);
    if (PPrev = nil) then
      FList[iIdx] := PRemove.PNext
    else
      PPrev.PNext := PRemove.PNext;