Wie TClientSocket in einer dll verwenden ?

[Logimator]

Hallo,

ich möchte gernen in einer dll mittels TClientSocket von einem NTP-Server die Atomzeit erfragen, und diese mittels einer Funktion zurück geben. In einer normlen Delphi-App funktioniert das tadellos, nur sobald ich den Code in eine dll stecken möchte, funktioniert das nicht. Für mich sieht's so aus, als der TCLientSocket keinerlei Messages bekommt oder bearbeitet. Bin aber was dll's anbelangt absolut grün hinter den Ohren :oops:
Wäre echt nett, wenn mir jemand helfen könnte

Das hier ist meine dll ...

Code:

library NTPTest;

uses  ShareMem,
  SysUtils,
  Classes,
  Dialogs, Forms, Windows,
  MainUnit in 'MainUnit.pas' {DataModule1: TDataModule};

{$R *.res}

begin
     IsMultiThread := TRUE;
     DataModule1:=TDataModule1.Create(nil);
end.

... und hier die zugehörige Unit, die die Arbeit erledigen soll ...
Die Funktion, die die Zeit liefern soll ist die GetNTPHour. Das lustige ist, wenn das ShowMessage in der Funktion einkommentiert wird, geht's einwandfrei. Sobald die ShowMessage kommentiert wird, geht's nicht mehr

Code:

unit MainUnit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    ScktComp;

type
  TDataModule1 = class(TDataModule)
    TimeSocket: TClientSocket;
    procedure TimeSocketRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure TimeSocketError(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure TimeSocketConnect(Sender: TObject; Socket: TCustomWinSocket);
  private
    { Private-Deklarationen }


  public
    { Public-Deklarationen }
    function GetNTPHour( myText: pchar): Integer; stdcall;
  end;

var
  DataModule1: TDataModule1;
  str_Act_Ation: String;
  Datum, Uhrzeit: string;

implementation

{$R *.dfm}



function TDataModule1.GetNTPHour( myText: pchar): Integer; stdcall;
var
   i_Hour: Integer;
    i: Integer;
   Zahl: Array [1..4] of Byte;
   Sekunden: Longword;
   Zeitzone: Real;
   DatumZeit: TDateTime;
begin


        TimeSocket.Host := 'ptbtime1.ptb.de';
        TimeSocket.Port := 37;

        TimeSocket.Open;

        //ShowMessage('In Function GetNTPHour' ) ;  <-----  Wenn das einkommentiert ist, geht's

        Result := 1;
end;

procedure TDataModule1.TimeSocketRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
 i_Hour: Integer;
    i: Integer;
   Zahl: Array [1..4] of Byte;
   Sekunden: Longword;
   Zeitzone: Real;
   DatumZeit: TDateTime;
begin
        Socket.ReceiveBuf(Zahl, 4);
        // Bytes vertauschen
        for i := 1 to 4 do
           Sekunden := Sekunden * 256 + Zahl[i];

     //   Socket.Close;

        Zeitzone := 2/24;  // Winterzeit: +1/24, Sommerzeit: +2/24;
        DatumZeit :=  EncodeDate (1900,1,1)     { 1.1.1900 }
                      + Sekunden/86400            { + Tage }
                      + Zeitzone;                 { + Zeitzone gegenüber GNT }

        Datum := DateTimeToStr (trunc(DatumZeit));
        Uhrzeit := DateTimeToStr (DatumZeit);
        Delete (Uhrzeit,1,Pos(' ',Uhrzeit));

        ShowMessage('Datum: ' + Datum + ' Uhrzeit ' + Uhrzeit + ' Secs: ' + IntToStr( Sekunden) ) ;
end;

procedure TDataModule1.TimeSocketError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
      ShowMessage('Error: '  ) ;
      ErrorCode := 0;
end;

procedure TDataModule1.TimeSocketConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
          ShowMessage('Socket connect '  ) ;
end;

end.

[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';