iggnet.pas

通信控件

unit IGgNet;

interface

uses
  Windows, WinSock, SysUtils, Classes, Controls, IGgPacket;

const
  CRLF = #13#10;

  MAX_PACKET_LIST   = 20;

type

  //Packet
  TPacketTag = record
    Data: PChar;
    DataSize: Integer;
    SockAddr: TSockAddr;
  end;
  PPacketTag = ^TPacketTag;

  { TIExt Abstract class }

  TINet = class
  protected
    function  GetOwner: TINet; dynamic;
    procedure ExitOwner; virtual; abstract;
  public
    destructor Destroy; override;
  end;

const
  MAX_IUDP_POOL = 2;
  MAX_ITCP_POOL = 8;
  MAX_INET_POOL = MAX_IUDP_POOL+MAX_ITCP_POOL;
  TCP_BLK_SIZE  = (1024*4);

type

  TINets = array[0..MAX_INET_POOL-1] of TINet;

  TINetMgr = class
  private
    FList: TINets;
    FUDPs: Integer;
    FTCPs: Integer;

  protected
    procedure Init;
    procedure QuitAll();
    
  public
    constructor Create();
    destructor Destroy(); override;

    property UDPs: Integer read FUDPs;
    property TCPs: Integer read FTCPs;

    function Find(var INet: TINet): Integer;
    function GetSlot(IsUDP: Boolean): Integer;
    function Put(INet: TINet): Boolean;
    function Remove(var INet: TINet): Boolean;
    function Quit(INet: TINet): Boolean;
  end;

  {  TINetThread }
  //inherited Create(CreateSuspended);

  TThreadProc = procedure of object;

  TINetThread = class(TThread)
  private
    FNet: TINet;
    FRunProc: TThreadProc;

  public
    constructor Create(ANet: TINet; CreateSuspended: Boolean);
    destructor Destroy(); override;

    property RunProc: TThreadProc read FRunProc write FRunProc default nil;

    procedure Stop;
  protected
    procedure Execute; override;
  end;


  TIWorkThread = class(TThread)
  private
    FRunProc: TThreadProc;
    FExit: Boolean;
    
  public
    constructor Create(CreateSuspended: Boolean);
    destructor Destroy(); override;

    property RunProc: TThreadProc read FRunProc write FRunProc default nil;

    procedure Stop;
    property Exit: Boolean read FExit;
  protected
    procedure Execute; override;
  end;

  { TIUDP }

  TOnUDPMsgNotify = procedure(var PktTag: TPacketTag) of object;

  TIUDP = class(TINet)
  private
    FIP  : DWORD;
    FPort: DWORD;
    FPktTag: TPacketTag;
    FBuffer: array[0..MAX_PACKET_SIZE-1] of Char;
    FThread: TINetThread;
    
  protected
    FSocket: TSocket;
    FEnable: Boolean;
    
    FOnUDPMsgNotify: TOnUDPMsgNotify;

    procedure Init;
    procedure Close();
    procedure SetThread(AThread: TINetThread);

  public
    constructor Create(); overload;
    constructor Create(AIP: DWORD; APort: DWORD; AOpen: Boolean=TRUE); overload;
    destructor Destroy(); override;

    procedure ExitOwner;

    //property ...
    property IP: DWORD read FIP;
    property Port: DWORD read FPort;
    property OnUDPMsgNotify: TOnUDPMsgNotify read FOnUDPMsgNotify write FOnUDPMsgNotify;
    property Thread: TINetThread write SetThread default nil;
    property Enable: Boolean read FEnable;

    //method ...
    function Open(AIP: DWORD; APort: DWORD): Boolean; overload;
    function Open(): Boolean; overload;

    procedure DoReceiveProc();
    //procedure DoSendMsg();
    procedure Send(var Data; DataSize: Integer; ToIP: DWORD; ToPort: WORD);
    function SendTo(Buffer: Pointer; BufferSize: Integer; ToIP: DWORD; ToPort: WORD): Integer; overload;
    function SendTo(Buffer: Pointer; BufferSize: Integer; ToIP: string; ToPort: WORD): Integer; overload;
    procedure QuerySend(Header: PSPKHeader; var PData; DataSize: Integer; ToIP: DWORD; ToPort: WORD); overload;
    procedure QuerySend(var Data; DataSize: Integer; ToIP: DWORD; ToPort: WORD; Cmd: WORD); overload;
  end;

  { TITCP }

  TITCP = class;
  TITCPPeer = TITCP;
  TITCPClient = TITCP;

  TOnTCPAcceptNotify = procedure(var TCPPeer: TITCPPeer) of Object;
  TOnTCPPeerNotify = procedure(Owner: TITCPPeer) of Object;
  TOnTCPQueryRespondNotify = procedure(PackR: TTCPPackR) of object;
  
  
  TITCP = class(TINet)
  private
    FIP  : DWORD;
    FPort: DWORD;
    FIsOpen: Boolean;
    FIsPeer: Boolean;
    FThread: TINetThread;
    
  protected
    FSocket: TSocket;
    FEnable: Boolean;
    
    FOnTCPAcceptNotify: TOnTCPAcceptNotify;
    FOnTCPPeerNotify: TOnTCPPeerNotify;

    procedure Init;
    procedure Close();
    procedure SetThread(AThread: TINetThread);

  public
    constructor Create(); overload;
    constructor Create(AIP: DWORD; APort: DWORD; AOpen: Boolean=TRUE; ASocket: TSocket=INVALID_SOCKET; AIsPeer: Boolean=FALSE); overload;
    destructor Destroy(); override;

    procedure ExitOwner; virtual;
    
    property IP: DWORD read FIP;
    property Port: DWORD read FPort;
    property IsOpen: Boolean read FIsOpen;
    property IsPeer: Boolean read FIsPeer;
    property Thread: TINetThread write SetThread default nil;
    property Enable: Boolean read FEnable;

    property OnTCPAcceptNotify: TOnTCPAcceptNotify read FOnTCPAcceptNotify write FOnTCPAcceptNotify;
    property OnTCPPeerNotify: TOnTCPPeerNotify read FOnTCPPeerNotify write FOnTCPPeerNotify;
    
    function Open(AIP: DWORD; APort: DWORD): Boolean; overload;
    function Open(): Boolean; overload;
    procedure DoAcceptProc();
    procedure DoPeerProc();
    function WriteBuffer(Buffer: Pointer; BufferSize: Integer): Integer;
    function ReadBuffer(var Buffer: Pointer; BufferSize: Integer): Integer;
    function Connect(IPString: string; Port: Integer): Boolean; overload;
    function Connect(IP: Integer; Port: Integer): Boolean; overload;
    class procedure TCreateClient(var TCPClient: TITCPClient);
    class function TConnect(IP: Integer; Port: Integer): TITCPClient; overload;
    class function TConnect(IP: string; Port: Integer): TITCPClient; overload;

    class function TQuery(Pack: TTCPPack; ToIP: DWORD; ToPort: WORD; Cmd: WORD; var PPackR: PTCPPackR): Integer; overload;
    class function TQuery(PackBuf: Pointer; PackBufSize: Integer; Cmd: WORD; Operate: WORD; ToIP: DWORD; ToPort: WORD; Para: WORD=0): Integer; overload;
    class function TQuery(PackBuf: Pointer; PackBufSize: Integer; Cmd: WORD; Operate: WORD; ToIP: string; ToPort: WORD; Para: WORD=0): Integer; overload;
    class function TQuery(var Rec; RecSize: Integer; Buf: Pointer; BufSize: Integer; Cmd: WORD; Operate: WORD; ToIP: DWORD; ToPort: WORD; Para: WORD=0): Integer; overload;
    class function TQuery(var Rec; RecSize: Integer; Buf: Pointer; BufSize: Integer; Cmd: WORD; Operate: WORD; ToIP: string; ToPort: WORD; Para: WORD=0): Integer; overload;
    class procedure TQuery(OnRespond: TOnTCPQueryRespondNotify; PackBuf: Pointer; PackBufSize: Integer; Cmd: WORD; Operate: WORD; ToIP: DWORD; ToPort: WORD; Para: WORD=0); overload;
    class procedure TQuery(OnRespond: TOnTCPQueryRespondNotify; PackBuf: Pointer; PackBufSize: Integer; Cmd: WORD; Operate: WORD; ToIP: string; ToPort: WORD; Para: WORD=0); overload;
    class procedure TQuery(OnRespond: TOnTCPQueryRespondNotify; var Rec; RecSize: Integer; Buf: Pointer; BufSize: Integer; Cmd: WORD; Operate: WORD; ToIP: DWORD; ToPort: WORD; Para: WORD=0); overload;
    class procedure TQuery(OnRespond: TOnTCPQueryRespondNotify; var Rec; RecSize: Integer; Buf: Pointer; BufSize: Integer; Cmd: WORD; Operate: WORD; ToIP: string; ToPort: WORD; Para: WORD=0); overload;
    class function TQuery(var PPackR: PTCPPackR; PackBuf: Pointer; PackBufSize: Integer; Cmd: WORD; Operate: WORD; ToIP: string; ToPort: WORD; Para: WORD=0): Integer; overload;
    class function TQuery(var PPackR: PTCPPackR; PackBuf: Pointer; PackBufSize: Integer; Cmd: WORD; Operate: WORD; ToIP: DWORD; ToPort: WORD; Para: WORD=0): Integer; overload;
    class function TQuery(var PPackR: PTCPPackR; var Rec; RecSize: Integer; Buf: Pointer; BufSize: Integer; Cmd: WORD; Operate: WORD; ToIP: DWORD; ToPort: WORD; Para: WORD=0): Integer; overload;
    class function TQuery(var PPackR: PTCPPackR; var Rec; RecSize: Integer; Buf: Pointer; BufSize: Integer; Cmd: WORD; Operate: WORD; ToIP: string; ToPort: WORD; Para: WORD=0): Integer; overload;
  end;

  ESocketError = class(Exception);

  function GetHostIP(Host: string): Integer;
  function IPToString(IP: Integer): string;
  function GetFreePort(IP: DWORD; Port: Integer; DGRAM: Boolean=TRUE): Integer;
  function CalculateID(StringID: string): DWORD;

implementation

uses
  MD5;

////////////////////////////////////////////////////////////////////////////////

function GetHostIP(Host: string): Integer;
var
  Hostname: array[0..127] of Char;
  PHost: PHostEnt;
begin
  Result := 0;
  try
    FillChar(Hostname, 128, 0);
    if (Host = '') then
      Result := WinSock.gethostname(Hostname, 128)
    else
      StrLCopy(Hostname, PChar(Host), Length(Host));
    PHost := WinSock.gethostbyname(Hostname);

    if (PHost <> nil) then begin
      Result := (PInteger(PHost.h_addr_list^))^;
      if (Result = INADDR_NONE) then
        Result := 0;
    end;
  except  Result := 0;  end;
end;

function IPToString(IP: Integer): string;
var
  ina: in_addr;
begin
  Result := '0.0.0.0';
  try
    FillChar(ina, sizeof(ina), 0);
    ina.S_addr := IP;
    Result := WinSock.inet_ntoa(Ina);
    if (Result = '') then
      Result := '0.0.0.0';
  except  Result := '0.0.0.0';  end;
end;

function CalculateID(StringID: string): DWORD;
var
  Str: string;
  Hex, I: Integer;
begin
  if StringID = '' then begin Result := 0; Exit; end;

  Str := MD5Print(MD5String(StringID));
  Result := 0;
  for I := 1 to 8 do begin
    Hex := Ord(Upcase(Str[I]));
    if (Hex >= Ord('0')) and (Hex <= Ord('9')) then
      Result := Result * 16 + Hex-Ord('0')
    else if (Hex >= Ord('A')) and (Hex <= Ord('F')) then
      Result := Result * 16 + Hex-Ord('A')+10;
  end;
  Result := (Result and $7fffffff);
end;

function GetFreePort(IP: DWORD; Port: Integer; DGRAM: Boolean=TRUE): Integer;
var
  Sock, I: Integer;
  SockAddr: TSockAddrIn;
begin
  Result := 0;
  try
    if not DGRAM then
      Sock := WinSock.socket(AF_INET, SOCK_STREAM, IPPROTO_IP)
    else
      Sock := WinSock.socket(AF_INET, SOCK_DGRAM, IPPROTO_IP);

    if Sock = INVALID_SOCKET then Exit;

    Result := Port;
    for I := 0 to 255 do
    begin
      SockAddr.sin_family := AF_INET;
      SockAddr.sin_addr.S_addr := htonl(IP);
      SockAddr.sin_port := WinSock.htons(Result);
      if WinSock.bind(Sock, SockAddr, SizeOf(SockAddr)) <> SOCKET_ERROR then Break;
      Inc(Result);
    end;
    WinSock.closesocket(Sock);
  finally
  end;
end;

   { TINet }

function  TINet.GetOwner: TINet;
begin
  Result := nil;
end;
destructor TINet.Destroy;
begin
end;

  { TINetMgr }
  
constructor TINetMgr.Create();
begin
  Init;
end;
destructor TINetMgr.Destroy();
begin
  QuitAll();
end;
procedure TINetMgr.Init;
var
  I: Integer;
begin
  try
    FUDPs := 0;    FTCPs := 0;
    for I := 0 to MAX_INET_POOL-1 do
      FList[I] := nil;
  except end;
end;
procedure TINetMgr.QuitAll();
var
  I: Integer;
  INet: TINet;
  IsTCP: Boolean;
begin
  try
    if (FUDPs > 0) or (FTCPs > 0) then
    begin
      //处理对象退出
      for I := 0 to MAX_INET_POOL-1 do begin
        try
          INet := FList[i];
          if Assigned(INet) then begin
            IsTCP := INet.ClassName = 'TITCP';
            if IsTCP then
              TITCP(INet).ExitOwner
            else
              TIUDP(INet).ExitOwner;
            INet.Free;
          end;
        except end;
        FList[i] := nil;
      end;
    end;
  finally
    FUDPs := 0;    FTCPs := 0;
  end;
end;
function TINetMgr.Quit(INet: TINet): Boolean;
var
  IsTCP: Boolean;
begin
  Result := FALSE;
  Remove(INet);
  try
    if Assigned(INet) then begin
      IsTCP := INet.ClassName = 'TITCP';
      if IsTCP then
        TITCP(INet).ExitOwner
      else
        TIUDP(INet).ExitOwner;
      //INet.Free;
      //INet := nil; //....
      Result := TRUE;
    end;
  except end;
end;
function TINetMgr.Find(var INet: TINet): Integer;
var
  I: Integer;
begin
  Result := -1;
  if (INet = nil) then Exit;

  try
    for I := 0 to MAX_INET_POOL-1 do
    begin
      if FList[I] = INet then begin
        Result := I;  Break;
      end;
    end;
  except end;
end;
function TINetMgr.GetSlot(IsUDP: Boolean): Integer;
begin
  Result := -1;
  if IsUDP then begin
    if FUDPs < MAX_IUDP_POOL then
      Result := FUDPs;
  end else begin
    if FTCPs < MAX_ITCP_POOL then
      Result := MAX_IUDP_POOL + FTCPs;
  end;     
end;
function TINetMgr.Put(INet: TINet): Boolean;
var
  iSlot: Integer;
  IsTCP: Boolean;
begin
  iSlot := -1;
  try
    //有必要了解对象的真实性
    Result := (INet <> nil) and Assigned(INet);

    if Result and (Find(INet) = -1) then
    begin
      IsTCP := INet.ClassName = 'TITCP';
      iSlot := GetSlot(not IsTCP);
      Result := (iSlot <> -1);
      if Result then begin
        FList[iSlot] := INet;
        if IsTCP then
          Inc(FTCPs)
        else
          Inc(FUDPs);
      end;
    end else
      Result := FALSE;
  except end;
end;
function TINetMgr.Remove(var INet: TINet): Boolean;
var
  iSlot: Integer;
  IsTCP: Boolean;
begin
  Result := FALSE;
  iSlot := Find(INet);
  try
    if (iSlot > -1) then
    begin
      FList[iSlot] := nil;
      IsTCP := INet.ClassName = 'TITCP';
      if (IsTCP) then begin
        FList[iSlot] := FList[MAX_IUDP_POOL+FTCPs-1];
        Dec(FTCPs);
      end else begin
        FList[iSlot] := FList[FUDPs-1];
        Dec(FUDPs);
      end;
      Result := TRUE;
    end;
  except  end;
end;

  { TINetThread }

constructor TINetThread.Create(ANet: TINet; CreateSuspended: Boolean);
begin
  inherited Create(CreateSuspended);
  FNet := ANet;
  FRunProc := nil;
end;
destructor TINetThread.Destroy();
begin
  inherited Destroy;
end;
procedure TINetThread.Execute;
begin
  try
    if (FNet <> nil) and Assigned(FNet) and Assigned(FRunProc) then
      FRunProc();
  except end;
end;
procedure TINetThread.Stop;
begin
  try
    if not Terminated then
    begin
      if (FNet <> nil) and Assigned(FNet) then
        FNet.ExitOwner;
      Terminate;
    end;
  except  end;
end;

  { TIWorkThread }

constructor TIWorkThread.Create(CreateSuspended: Boolean);
begin
  inherited Create(CreateSuspended);
  FRunProc := nil;
  FExit := FALSE;
end;
destructor TIWorkThread.Destroy();
begin
  inherited Destroy;
end;
procedure TIWorkThread.Execute;
begin
  try
    if Assigned(FRunProc) then
      FRunProc();
  except end;
end;
procedure TIWorkThread.Stop;
begin
  try
    if not Terminated then
    begin
      Terminate;
    end;
    FExit := TRUE;
  except  end;
end;

  { TIUDP }

constructor TIUDP.Create();
begin
  Init;
end;
constructor TIUDP.Create(AIP: DWORD; APort: DWORD; AOpen: Boolean);
begin