iggnet.pas

通信控件

  Init;
  FIP := AIP;
  FPort := APort;
  if AOpen then
    FEnable := Open();
end;
destructor TIUDP.Destroy();
begin
  Close;
end;
procedure TIUDP.ExitOwner;
begin
  Close;
  //其它处理
end;
procedure TIUDP.Init;
begin
  FIP     := 0;
  FPort   := 0;
  FEnable := FALSE;
  FSocket := INVALID_SOCKET;
end;
procedure TIUDP.SetThread(AThread: TINetThread);
begin
  if (FThread = nil) then
    FThread := AThread;
end;
function TIUDP.Open(AIP: DWORD; APort: DWORD): Boolean;
begin
  FIP     := AIP;
  FPort   := APort;
  FEnable := Open();
end;
function TIUDP.Open(): Boolean;
var
  Addr: TSockAddr;
  Value: Integer;
begin
  Result := FALSE;
  try
    FSocket := WinSock.socket(AF_INET, SOCK_DGRAM, IPPROTO_IP);
    if (FSocket <> INVALID_SOCKET) then
    begin
      Value := 1;
      //WinSock.ioctlsocket(FSocket, FIONBIO, Value);
      //WinSock.setsockopt(FSocket, SOL_SOCKET, SO_REUSEADDR, @Value, sizeof(Integer));

      FillChar(Addr, SizeOf(Addr), 0);
      Addr.sin_family := AF_INET;
      Addr.sin_addr.S_addr := FIP;
      Addr.sin_port := FPort;
      Result := WinSock.bind(FSocket, Addr, SizeOf(Addr)) <> SOCKET_ERROR;
    end;
  except  Result := FALSE;  end;
end;
procedure TIUDP.Close();
begin
  try
    if (FSocket <> INVALID_SOCKET) then
      WinSock.closesocket(FSocket);
  except end;
  FEnable := FALSE;
  FSocket := INVALID_SOCKET;
end;
procedure TIUDP.DoReceiveProc;
var
  AddrLen, bufSize: Integer;
begin
  FEnable := TRUE;
  AddrLen := SizeOf(TSockAddr);
  FillChar(FPktTag, SizeOf(FPktTag), 0);

  try
    try
      bufSize := 128*1024;
  		winsock.setsockopt(FSocket, SOL_SOCKET, SO_RCVBUF, @bufSize, SizeOf(Integer));
  		winsock.setsockopt(FSocket, SOL_SOCKET, SO_SNDBUF, @bufSize, SizeOf(Integer));

      FPktTag.Data := AllocMem(2048);
      while (FEnable and (FSocket > 0)) do
      begin
        FPktTag.DataSize := 0;
        FPktTag.DataSize := winsock.recvfrom(FSocket, FPktTag.Data^, MAX_PACKET_SIZE, 0, FPktTag.SockAddr, AddrLen);
        if ((FPktTag.DataSize >= 20) and (FPktTag.DataSize <= MAX_PACKET_SIZE)) then
        begin
          if Assigned(FOnUDPMsgNotify) then
            FOnUDPMsgNotify(FPktTag);
        end else begin
          if WSAGetLastError() = WSAEINTR then Break;
        end;
      end;
    except    end;
  finally
    FEnable := FALSE;
    Close();
    FreeMem(FPktTag.Data);
  end;
end;
procedure TIUDP.Send(var Data; DataSize: Integer; ToIP: DWORD; ToPort: WORD);
begin
end;

function TIUDP.SendTo(Buffer: Pointer; BufferSize: Integer; ToIP: DWORD; ToPort: WORD): Integer;
var
	Addr: TSockAddr;
begin
  FillChar(Addr, SizeOf(Addr), 0);
  Addr.sin_family := AF_INET;
  Addr.sin_addr.S_addr := ToIP;
  Addr.sin_port := ToPort;
  Result := WinSock.sendto(FSocket, Buffer^, BufferSize, 0, Addr, SizeOf(Addr));
  if Result <= 0 then
    Result := WSAGetLastError;
end;
function TIUDP.SendTo(Buffer: Pointer; BufferSize: Integer; ToIP: string; ToPort: WORD): Integer;
var
	Addr: TSockAddr;
begin
  Result := SendTo(Buffer, BufferSize, inet_addr(PChar(ToIP)), htons(ToPort));
end;
procedure TIUDP.QuerySend(Header: PSPKHeader; var PData; DataSize: Integer; ToIP: DWORD; ToPort: WORD);
var
  Buf: PChar;
  PTH: PSPKHeader;
begin
  Buf := AllocMem(SizeOf(TSPKHeader)+DataSize);
  if Buf = nil then Exit;
  PTH := PSPKHeader(Buf);
  PTH^ := SPKHeader(Header, DataSize);
  Move(PData, PChar(Data(PTH))^, DataSize);
  SendTo(Buf, PTH.wpkSize, ToIP, ToPort);
  FreeMem(Buf);
end;

procedure TIUDP.QuerySend(var Data; DataSize: Integer; ToIP: DWORD; ToPort: WORD; Cmd: WORD);
begin
end;

  { TITCP }
  
constructor TITCP.Create();
begin
  Init;
end;

constructor TITCP.Create(AIP: DWORD; APort: DWORD; AOpen: Boolean; ASocket: TSocket; AIsPeer: Boolean);
begin
  Init;
  FIP     := AIP;
  FPort   := APort;
  FSocket := ASocket;
  FIsPeer := AIsPeer;
  if AOpen then
    FIsOpen := Open();
end;

destructor TITCP.Destroy();
begin
  Close();
end;

procedure TITCP.ExitOwner;
begin
  Close;
  //其它处理
end;

procedure TITCP.Init;
begin
  FIP     := 0;
  FPort   := 0;
  FIsOpen := FALSE;
  FSocket := INVALID_SOCKET;
  FIsPeer := FALSE;
end;

procedure TITCP.SetThread(AThread: TINetThread);
begin
  if (FThread = nil) then
    FThread := AThread;
end;

procedure TITCP.Close();
begin
  try
    if (FSocket <> INVALID_SOCKET) then
      WinSock.closesocket(FSocket);
  except end;
  FIsOpen := FALSE;
  FSocket := INVALID_SOCKET;
end;

function TITCP.Open(AIP: DWORD; APort: DWORD): Boolean;
begin
  FIP   := AIP;
  FPort := APort;
  FIsOpen := Open();
end;

function TITCP.Open(): Boolean;
var
  Addr: TSockAddr;
  Value: Integer;
begin
  Result := FALSE;
  try
    FSocket := WinSock.socket(AF_INET, SOCK_STREAM, IPPROTO_IP);
    Result := (FSocket <> INVALID_SOCKET);
    if Result then
    begin
      //Value := 1;
      //WinSock.setsockopt(FSocket, SOL_SOCKET, SO_REUSEADDR, @Value, sizeof(Integer));
      FillChar(Addr, SizeOf(Addr), 0);
      Addr.sin_family := AF_INET;
      Addr.sin_addr.S_addr := FIP;
      Addr.sin_port := FPort;
      Result := WinSock.bind(FSocket, Addr, SizeOf(Addr)) <> SOCKET_ERROR;
      if Result and (not FIsPeer)  then
        Result := WinSock.listen(FSocket, 4) <> SOCKET_ERROR;
    end;
  except  Result := FALSE;  end;
end;

procedure TITCP.DoAcceptProc();
var
  Addr: TSockAddr;
  AddrLen: Integer;
  TCPPeer: TITCPPeer;
  PeerHandle: TSocket;
begin
  AddrLen := SizeOf(Addr);
  FillChar(Addr, AddrLen, 0);
  FEnable := TRUE;
  try
    try
      while(FIsOpen and (FSocket > 0)) do
      begin
        PeerHandle := WinSock.accept(FSocket, @Addr, @AddrLen);
        if (PeerHandle <> INVALID_SOCKET) then begin
          TCPPeer := TITCPPeer.Create(Addr.sin_addr.S_addr, Addr.sin_port, FALSE, PeerHandle, TRUE);
          //TCPPeer.OnTCPPeerNotify := FOnTCPPeerNotify;
          if Assigned(FOnTCPAcceptNotify) then
            FOnTCPAcceptNotify(TCPPeer);
        end else begin
          if WSAGetLastError() = WSAEINTR then Break;
        end;
      end;
    except end;
  finally
    Close();
    FEnable := TRUE;
  end;
end;

procedure TITCP.DoPeerProc();
begin
  try
    if Assigned(FOnTCPPeerNotify) then
      FOnTCPPeerNotify(Self);
  except end;
end;

function TITCP.Connect(IP: Integer; Port: Integer): Boolean;
var
  Addr: TSockAddr;
begin
  FillChar(Addr, SizeOf(Addr), 0);
  Addr.sin_addr.S_addr := IP;
  Addr.sin_port := Port;
  Addr.sin_family := AF_INET;
  Result := WinSock.connect(FSocket, Addr, SizeOf(Addr)) = 0;
end;

function TITCP.Connect(IPString: string; Port: Integer): Boolean;
begin
  Result := FALSE;
  if (IPString <> '') then
    Result := Connect(WinSock.inet_addr(PChar(IPString)), htons(Port));
end;

function TITCP.WriteBuffer(Buffer: Pointer; BufferSize: Integer): Integer;
var
  BlkSize: Integer;
begin
  BlkSize := TCP_BLK_SIZE;
  while BufferSize > 0 do begin
    if BufferSize < BlkSize then  BlkSize := BufferSize;
    Result := WinSock.send(FSocket, Buffer^, BlkSize, 0);
    if (Result <= 0) then Break;
    Dec(BufferSize, BlkSize);
    Buffer := PChar(Buffer) + BlkSize;
  end;
end;

function TITCP.ReadBuffer(var Buffer: Pointer; BufferSize: Integer): Integer;
var
  BlkSize, TempSize: Integer;
  PTemp: PChar;
begin
  Result := 0;
  BlkSize := TCP_BLK_SIZE;  TempSize := 0;

  if (BufferSize <= 0) then Exit;
  
  if (Buffer = nil) then
    Buffer := AllocMem(BufferSize);

  if (Buffer = nil) then Exit;

  PTemp := PChar(Buffer);
  while TempSize < BufferSize do begin
    if (TempSize + BlkSize) > BufferSize then BlkSize := BufferSize - TempSize;
    Result := WinSock.recv(FSocket, PTemp^, BlkSize, 0);
    if (Result <= 0) then Break;
    Inc(TempSize, BlkSize);
    PTemp := PTemp + TempSize;
  end;
end;

class procedure TITCP.TCreateClient(var TCPClient: TITCPClient);
begin
  TCPClient := TITCPClient.Create(0, 0, TRUE, -1, TRUE);
end;

class function TITCP.TConnect(IP: Integer; Port: Integer): TITCPClient;
begin
  Result := nil;
  TCreateClient(Result);
  if (Result <> nil) and (Result.IsOpen) then
    Result.Connect(IP, Port);
end;

class function TITCP.TConnect(IP: string; Port: Integer): TITCPClient;
begin
  Result := nil;
  TCreateClient(Result);
  if (Result <> nil) and (Result.IsOpen) then begin
    try
      if not Result.Connect(IP, Port) then begin
        Result.Free;
        Result := nil;
      end;
    except Result := nil; end;
  end;
end;

class function TITCP.TQuery(Pack: TTCPPack; ToIP: DWORD; ToPort: WORD; Cmd: WORD; var PPackR: PTCPPackR): Integer;
var
  Client: TITCPClient;
  Header: PSPKHeader;
begin
  Header := TCPPacket(0, Cmd);
  Move(Pack, Data(Header)^, SizeOf(Pack));
  Result := Header.wpkSize;
  Client := TConnect(ToIP, ToPort);
  if (Client <> nil) then
  begin
    if Result > 0 then
      Result := Client.WriteBuffer(Header, Header.wpkSize);

    if (Result > 0) then
      Result := Client.WriteBuffer(Pack.Pack, Pack.PackSize);

    if (PPackR <> nil) and (Result > 0) then
    begin
      Result := Client.ReadBuffer(Pointer(PPackR), SizeOf(TTCPPackR)-SizeOf(Pointer));
      if (Result > 0) and (PPackR.PackSize > 0) then  begin
        if (PPackR.Pack = nil) then  begin
          PPackR.Pack := AllocMem(PPackR.PackSize);
          PPackR.PackSour := 1;
        end;
        Result := Client.ReadBuffer(PPackR.Pack, PPackR.PackSize);
      end;
    end;
    Client.Free;
  end;
end;

class function TITCP.TQuery(PackBuf: Pointer; PackBufSize: Integer; Cmd: WORD; Operate: WORD; ToIP: DWORD; ToPort: WORD; Para: WORD): Integer;
var
  Pack: TTCPPack;
  PPackR: PTCPPackR;
begin
  Result := -1;
  FillChar(Pack, SizeOf(Pack), 0);
  Pack.Operate := Operate;
  Pack.Para := Para;
  Pack.PackSize := PackBufSize;
  Pack.Pack := PackBuf;
  New(PPackR); FillChar(PPackR^, SizeOf(TTCPPackR), 0);
  if TQuery(Pack, ToIP, ToPort, Cmd, PPackR) > 0 then
    Result := PPackR.Result;
  Dispose(PPackR);
end;

class function TITCP.TQuery(PackBuf: Pointer; PackBufSize: Integer; Cmd: WORD; Operate: WORD; ToIP: string; ToPort: WORD; Para: WORD): Integer;
begin
  Result := TQuery(PackBuf, PackBufSize, Cmd, Operate, inet_addr(PChar(ToIP)), htons(ToPort), Para);
end;

class function TITCP.TQuery(var Rec; RecSize: Integer; Buf: Pointer; BufSize: Integer; Cmd: WORD; Operate: WORD; ToIP: DWORD; ToPort: WORD; Para: WORD): Integer;
var
  PackBuf: Pointer;
  PackBufSize: Integer;
begin
  Result := -1;
  PackBufSize := RecSize+BufSize;
  PackBuf := AllocMem(PackBufSize);
  if (PackBuf = nil) then Exit;
  try
    if (RecSize > 0) then
      Move(Rec, PackBuf^, RecSize);
    if (BufSize > 0) then
      Move(Buf^, (PChar(PackBuf)+RecSize)^, BufSize);
    if (PackBufSize > 0) then
      Result := TQuery(PackBuf, PackBufSize, Cmd, Operate, ToIP, ToPort, Para);
  except end;
  FreeMem(PackBuf);
end;

class function TITCP.TQuery(var Rec; RecSize: Integer; Buf: Pointer; BufSize: Integer; Cmd: WORD; Operate: WORD; ToIP: string; ToPort: WORD; Para: WORD): Integer;
begin
  Result := TQuery(Rec, RecSize, Buf, BufSize, Cmd, Operate, inet_addr(PChar(ToIP)), htons(ToPort), Para);
end;

class procedure TITCP.TQuery(OnRespond: TOnTCPQueryRespondNotify; PackBuf: Pointer; PackBufSize: Integer; Cmd: WORD; Operate: WORD; ToIP: DWORD; ToPort: WORD; Para: WORD);
var
  Pack: TTCPPack;
  PPackR: PTCPPackR;
begin
  FillChar(Pack, SizeOf(Pack), 0);
  Pack.Operate := Operate;
  Pack.Para := Para;
  Pack.PackSize := PackBufSize;
  Pack.Pack := PackBuf;
  New(PPackR); FillChar(PPackR^, SizeOf(TTCPPackR), 0);
  if TQuery(Pack, ToIP, ToPort, Cmd, PPackR) > 0 then
    if Assigned(OnRespond) then
      OnRespond(PPackR^);
  Dispose(PPackR);
end;

class procedure TITCP.TQuery(OnRespond: TOnTCPQueryRespondNotify; PackBuf: Pointer; PackBufSize: Integer; Cmd: WORD; Operate: WORD; ToIP: string; ToPort: WORD; Para: WORD);
begin
  TQuery(OnRespond, PackBuf, PackBufSize, Cmd, Operate, inet_addr(PChar(ToIP)), htons(ToPort), Para);
end;

class procedure TITCP.TQuery(OnRespond: TOnTCPQueryRespondNotify; var Rec; RecSize: Integer; Buf: Pointer; BufSize: Integer; Cmd: WORD; Operate: WORD; ToIP: DWORD; ToPort: WORD; Para: WORD);
var
  PackBuf: Pointer;
  PackBufSize: Integer;
begin
  PackBufSize := RecSize+BufSize;
  PackBuf := AllocMem(PackBufSize);
  if (PackBuf = nil) then Exit;
  try
    if (RecSize > 0) then
      Move(Rec, PackBuf^, RecSize);
    if (BufSize > 0) then
      Move(Buf^, (PChar(PackBuf)+RecSize)^, BufSize);
    if (PackBufSize > 0) then
      TQuery(OnRespond, PackBuf, PackBufSize, Cmd, Operate, ToIP, ToPort, Para);
  except end;
  FreeMem(PackBuf);
end;

class procedure TITCP.TQuery(OnRespond: TOnTCPQueryRespondNotify; var Rec; RecSize: Integer; Buf: Pointer; BufSize: Integer; Cmd: WORD; Operate: WORD; ToIP: string; ToPort: WORD; Para: WORD);
begin
  TQuery(OnRespond, Rec, RecSize, Buf, BufSize, Cmd, Operate, inet_addr(PChar(ToIP)), htons(ToPort), Para);
end;

class function TITCP.TQuery(var PPackR: PTCPPackR; PackBuf: Pointer; PackBufSize: Integer; Cmd: WORD; Operate: WORD; ToIP: DWORD; ToPort: WORD; Para: WORD): Integer;
var
  Pack: TTCPPack;
begin
  Result := -1;
  if not Assigned(PPackR) then Exit;
  
  FillChar(Pack, SizeOf(Pack), 0);
  Pack.Operate := Operate;
  Pack.Para := Para;
  Pack.PackSize := PackBufSize;
  Pack.Pack := PackBuf;
  Result := TQuery(Pack, ToIP, ToPort, Cmd, PPackR);
end;

class function TITCP.TQuery(var PPackR: PTCPPackR; PackBuf: Pointer; PackBufSize: Integer; Cmd: WORD; Operate: WORD; ToIP: string; ToPort: WORD; Para: WORD): Integer;
begin
  Result := TQuery(PPackR, PackBuf, PackBufSize, Cmd, Operate, inet_addr(PChar(ToIP)), htons(ToPort), Para);
end;

class function TITCP.TQuery(var PPackR: PTCPPackR; var Rec; RecSize: Integer; Buf: Pointer; BufSize: Integer; Cmd: WORD; Operate: WORD; ToIP: DWORD; ToPort: WORD; Para: WORD): Integer;
var
  PackBuf: Pointer;
  PackBufSize: Integer;
begin
  Result := -1;
  PackBufSize := RecSize+BufSize;
  PackBuf := AllocMem(PackBufSize);
  if (PackBuf = nil) then Exit;
  try
    if (RecSize > 0) then
      Move(Rec, PackBuf^, RecSize);
    if (BufSize > 0) then
      Move(Buf^, (PChar(PackBuf)+RecSize)^, BufSize);
    if (PackBufSize > 0) then
      Result := TQuery(PPackR, PackBuf, PackBufSize, Cmd, Operate, ToIP, ToPort, Para);
  except end;
  FreeMem(PackBuf);
end;

class function TITCP.TQuery(var PPackR: PTCPPackR; var Rec; RecSize: Integer; Buf: Pointer; BufSize: Integer; Cmd: WORD; Operate: WORD; ToIP: string; ToPort: WORD; Para: WORD): Integer;
begin
  Result := TQuery(PPackR, Rec, RecSize, Buf, BufSize, Cmd, Operate, inet_addr(PChar(ToIP)), htons(ToPort), Para);
end;


{$IFDEF MSWINDOWS}
var
  WSAData: TWSAData;

procedure Startup;
var
  ErrorCode: Integer;
begin
  ErrorCode := WSAStartup($0202, WSAData);
  if ErrorCode <> 0 then
    raise ESocketError.Create('WSAStartup');
end;

procedure Cleanup;
var
  ErrorCode: Integer;
begin
  ErrorCode := WSACleanup;
  if ErrorCode <> 0 then
    raise ESocketError.Create('WSACleanup');
end;

initialization
  Startup;

finalization
  Cleanup;
{$ENDIF}


end.