Wie TClientSocket in einer dll verwenden ?

[Astat]

Hi, mit den Client Socket Komponenten ist dies nur sehr umständlich zu implementieren.
Msg-Pump der Host App muss vorhanden sein usw..
Versuchs so.

Delphi-Quellcode:

library synccli;

{$IMAGEBASE $03000000}

uses
  windows,
  classes,
  Sysutils,
  Winsock;

  {$INCLUDE sync.inc}

const
  SOCKET_BUFFER_SIZE = WSOCK_SYNC_READ_BUFFER_SIZE * 8;
  RECV_BUFFER_SIZE   = WSOCK_SYNC_READ_BUFFER_SIZE;

var
  _WSData     : TWSAData;
  _SocketLock : TRTLCriticalSection;

function SetSocketOptions(ASocket: TSocket): LongBool;
var
  bNoDelay: LongBool;
  nRecvBuf: integer;
  nSendBuf: integer;
begin
  EnterCriticalSection(_SocketLock);
  try
    result := false;

    bNoDelay := true;
    if setsockopt(ASocket, IPPROTO_TCP, TCP_NODELAY, @bNoDelay,
      SizeOf(bNoDelay)) = Socket_Error then
    begin
      EXIT;
    end;

    nRecvBuf := WSOCK_SYNC_READ_BUFFER_SIZE;
    if setsockopt(ASocket, SOL_SOCKET, SO_RCVBUF, @nRecvBuf,
      SizeOf(nRecvBuf)) = Socket_Error then
    begin
      EXIT;
    end;

    nSendBuf := WSOCK_SYNC_SEND_BUFFER_SIZE;
    if setsockopt(ASocket, SOL_SOCKET, SO_SNDBUF, @nSendBuf,
      SizeOf(nSendBuf)) = Socket_Error then
    begin
      EXIT;
    end;

    result := true;
  finally
    LeaveCriticalSection(_SocketLock);
  end;
end;

function SyncSend(var SyncClientStruct: TSyncClientStruct): LongBool; stdcall;
var
  sSendData: string;
  ret, cbRcv, cb, cbRead: integer;
  sockaddr: TSockAddr;
  szBuf: array of char;
  ClientSocket: TSocket;
  hMem: HGLOBAL;
begin
  result := false;
  try
    EnterCriticalSection(_SocketLock);
    try
      ClientSocket := Socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
    finally
      LeaveCriticalSection(_SocketLock);
    end;

    if (ClientSocket = INVALID_SOCKET) then EXIT;

    if not SetSocketOptions(ClientSocket) then
      Raise Exception.Create('ERROR: SetSocketOptions: ' + IntToStr(WSAGetLastError));

    FillChar(sockaddr, SizeOf(TSockAddr), #0);

    with sockaddr do begin
      sin_Family := AF_INET;
      sin_Port   := htons(SyncClientStruct.Port);
      sin_Addr   := TInAddr(Inet_Addr(SyncClientStruct.Host));
    end;

    EnterCriticalSection(_SocketLock);
    try
      ret := Connect(ClientSocket, sockaddr, SizeOf(sockaddr));
    finally
      LeaveCriticalSection(_SocketLock);
    end;

    if (Ret = Socket_Error) then EXIT;

    SetLength(sSendData, SizeOf(integer) + SizeOf(VALID_HEADER_ID) + SyncClientStruct.cbSize);
    move(SyncClientStruct.cbSize, sSendData[1], SizeOf(integer));
    move(VALID_HEADER_ID, sSendData[SizeOf(integer) + 1], SizeOf(VALID_HEADER_ID));
    move(SyncClientStruct.ptrData^, sSendData[SizeOf(integer) + SizeOf(VALID_HEADER_ID) + 1], SyncClientStruct.cbSize);

    EnterCriticalSection(_SocketLock);
    try
      ret := Send(ClientSocket, sSendData[1], Length(sSendData), 0);
    finally
      LeaveCriticalSection(_SocketLock);
    end;

    if (ret = SOCKET_ERROR) then EXIT;

    setlength(szBuf, SOCKET_BUFFER_SIZE);

    cb := 0;
    szBuf[0] := #0;

    while true do begin

      cbRcv := Recv(ClientSocket, szBuf[cb], RECV_BUFFER_SIZE, 0);
      if cbRcv = 0 then EXIT;

      if (cbRcv = WSAECONNRESET) or (cbRcv = SOCKET_ERROR) then EXIT;

      cb := cb + cbRcv;
      if cb + RECV_BUFFER_SIZE > Length(szBuf) then SetLength(szBuf, Length(szBuf) * 2);


      EnterCriticalSection(_SocketLock);
      try
        ret := ioctlsocket(ClientSocket, FIONREAD, cbRead);
      finally
        LeaveCriticalSection(_SocketLock);
      end;
      
      if (ret = SOCKET_ERROR) then EXIT;
      if cbRead = 0 then break;

    end;

    szBuf[cb] := #0;

    SyncClientStruct.cbSize := cb;

    hMem := GlobalAlloc(GMEM_FIXED, cb);
    move(szBuf[0], Pointer(hMem)^, cb);
    SyncClientStruct.ptrData := Pointer(hMem);
    result := true;
  finally
    if ClientSocket > 0 then begin
      shutdown(ClientSocket, SD_BOTH);
      Closesocket(ClientSocket);
    end;
  end;
end;

procedure DLLEntryPoint(dwReason: DWORD);
begin
  case dwReason of
    DLL_PROCESS_ATTACH :
      begin
        if (WSAStartup($0020, _WSData) <> S_OK) then
          raise Exception.Create('[synccli.dll]: ERROR: DLL_PROCESS_ATTACH: WSAStartup: ' +
            IntToStr(WSAGetLastError));
        InitializeCriticalSection(_SocketLock);
      end;
    DLL_PROCESS_DETACH :
      begin
        DeleteCriticalSection(_SocketLock);
        if (WSACleanup <> S_OK) then
          raise Exception.Create('[synccli.dll]: ERROR: DLL_PROCESS_DETACH: WSACleanup: ' +
            IntToStr(WSAGetLastError));
      end;
    DLL_THREAD_ATTACH  :
      begin
      end;
    DLL_THREAD_DETACH  :
      begin
      end;
  end;
end;

exports
  SyncSend;


{$R *.RES}

begin
  DisableThreadLibraryCalls(hInstance);
  DllProc := @DLLEntryPoint;
  DLLEntryPoint(DLL_PROCESS_ATTACH);
end.


{*------------------------------------------------------------------------------
  Include Datei mit Definitionen, Constanten und Exportfunktionen,
  verwendet von syncsvr.dll und synccli.dll für Synchrone Socket Kommunikation.

  History:
    Version 0.1 vom 05.07.2008 ASTAT
      - Initial

    Version 0.2 vom 23.10.2008 ASTAT
      - TSyncServerStartUpStruct erweitert

  Copyright ESOC © 2005 - 2008

  @Author ASTAT
  @Aktuell gültige API-Version vom 30.10.2008 ASTAT v0.2
-------------------------------------------------------------------------------}

const
  //     Protokoll für Header Validierung
  // +-------------------------------+-------+
  // |        HEADER_LENGTH 8Byte    | Daten |
  // +-------------------------------+-------+
  // |       4Byte     |   4Byte     | Daten |
  // +-----------------+-------------+-------+
  // | VALID_HEADER_ID | HEADER_SIZE | Daten |
  // +-----------------+-------------+-------+

  VALID_HEADER_ID        : integer = 1234567890;
  HEADER_SIZE            : integer = SizeOf(Integer) + SizeOf(VALID_HEADER_ID);

  //-- Socket-Einstellungen für Client und Server optimiert auf 100 MB/Full Duplex
  WSOCK_SYNC_PACKET_SIZE                = 1460;
  WSOCK_SYNC_SEND_BUFFER_SIZE           = WSOCK_SYNC_PACKET_SIZE * 44;
  WSOCK_SYNC_READ_BUFFER_SIZE           = WSOCK_SYNC_PACKET_SIZE * 44;
  WSOCK_SYNC_MAX_SEND_SIZE    : integer = WSOCK_SYNC_PACKET_SIZE * 44;
  WSOCK_SYNC_RECV_TIMEOUT     : integer = 1000 * 60 * 30; // 30 minutes timeout
  WSOCK_SYNC_SEND_TIMEOUT     : integer = 1000 * 60 * 30; // 30 minutes timeout
  TRY_LATER                   : integer = -1;

type
  TSyncDataStruct = packed record
    ptrData : Pointer;
    cbSize  : integer;
    Socket  : integer;
  end;
  PSyncDataStruct = ^TSyncDataStruct;

  TOnSyncData = function(var ptrSyncDataStruct: PSyncDataStruct): LongBool; stdcall;
  TOnSyncError = function(szSyncError: PChar; nSyncError: integer): LongBool; stdcall;
  TOnSyncConnect = function(SyncSocket: integer): LongBool; stdcall;
  TOnSyncDisConnect = function(SyncSocket: integer): LongBool; stdcall;

  TSyncServerStartUpStruct = record
    Port          : word;
    ThreadsPerCPU : Byte;
    OnData        : TOnSyncData;
    OnError       : TOnSyncError;
  end;
  PSyncServerStartUpStruct = ^TSyncServerStartUpStruct;

  TSyncClientStruct = record
    Port    : word;
    Host    : PChar;
    ptrData : Pointer;
    cbSize  : integer;
  end;
  PSyncClientStruct = ^TSyncClientStruct ;

//-- DLL Exports
function SyncClientSend(var SyncClientStruct: TSyncClientStruct): LongBool; stdcall;
   external 'synccli.dll' name 'SyncSend';

function SyncServerStartUp(SyncServerStartUpStruct: TSyncServerStartUpStruct): LongBool; stdcall;
  external 'syncsvr.dll' name 'SyncStartUp';

function SyncServerStop: LongBool; stdcall;
  external 'syncsvr.dll' name 'SyncStop';