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.