Announcement

**Andreas Kosch** · 12.06.2001, 06:52

Hallo,

die folgende Unit demonstriert, wie man die Zeit von einem Server holen kann.

Aufruf:
<pre>
procedure TForm1.ButtonServerTimeClick(Sender: TObject);
var
ServerUTC: TDateTime;
sServerName : String;
begin
sServerName := StaticTextSelServer.Caption;
Screen.Cursor := crHourGlass;
ButtonServerTime.Enabled := false;
try
ServerUTC := ServerTime(sServerName);
StaticTextLocal.Caption := DateTimeToStr(Now);
StaticTextLocalTZ.Caption := DateTimeToStr(ServerUTC - GetLocalTimeZoneOffSet);
StaticTextServer.Caption := DateTimeToStr(ServerUTC);
StaticTextServerTZ.Caption := DateTimeToStr(ServerUTC -
ServerTimeZoneOffset(sServerName));
finally
ButtonServerTime.Enabled := true;
Screen.Cursor := crDefault;
end;
end;
</pre>
Implementierung der Funktion ServerTime:
<pre>
unit SrvTime;

interface

uses
Windows, SysUtils;

function ServerTime(ServerName: string): TDateTime;
function GetLocalTimeZoneOffSet: TDateTime;
function ServerTimeZoneOffset(ServerName: string): TDateTime;

implementation

type
ENetTODError = Exception;

PTIMEOFDAYINFO = ^TTimeofDayInfo;
TTimeofDayInfo = record
tod_Elapsedt: DWORD; // Seconds since 1-jan-1970 00:00:00
tod_MSecs: DWORD;
tod_Hours: DWORD;
tod_Mins: DWORD;
tod_Secs: DWORD;
tod_Hunds: DWORD;
tod_TimeZone: Integer; // Minutes from GMT [ -1 = undefined ]
tod_TInterval: DWORD;
tod_Day: DWord;
tod_Month: DWORD;
tod_Year: DWORD;
tod_WeekDay: DWORD;
end;

NET_API_STATUS = Integer;

const
NERR_Success = 0;
MINUTESPERDAY = 1440;

TIME_ZONE_ID_UNKNOWN = 0;
TIME_ZONE_ID_STANDARD = 1;
TIME_ZONE_ID_DAYLIGHT = 2;

function GetLocalTimeZoneOffSet: TDateTime;
var
TZInfo: TTimeZoneInformation;
begin
case GetTimeZoneInformation(TZInfo) of
TIME_ZONE_ID_UNKNOWN:
Result := TZInfo.bias / MINUTESPERDAY;
TIME_ZONE_ID_STANDARD:
Result := (TZInfo.bias + TZInfo.standardbias) / MINUTESPERDAY;
TIME_ZONE_ID_DAYLIGHT:
Result := (TZInfo.bias + TZInfo.daylightbias) / MINUTESPERDAY;
else
// TIME_ZONE_ID_INVALID
Result := TZInfo.bias / MINUTESPERDAY;
end;
end;

procedure NetCheck(ErrCode: NET_API_STATUS);
begin
if ErrCode <> NERR_Success then
begin
case ErrCode of
ERROR_ACCESS_DENIED:
raise ENetTODError.Create('Zugriff wird verweigert!');
ERROR_INVALID_OWNER:
raise ENetTODError.Create('Objektbesitzer unerreichbar!');
ERROR_INSUFFICIENT_BUFFER:
raise ENetTODError.Create('Datenpuffer ist zu kein!');
else
raise Exception.Create('Error Code: ' + IntToStr(ErrCode) + #13 +
SysErrorMessage(ErrCode));
end;
end;
end;

procedure GetTOD(TimeServer: String; var TOD: TTimeofDayInfo);
resourcestring
cLERROR = 'LoadLibrary-Fehler: ';
const
NTlib = 'NETAPI32.DLL';
Win95lib = 'RADMIN32.DLL';
var
PresentUTC, Tzo: TDateTime;
ErrMode: Word;
nYear, nMonth, nDay, nHours, nMins, nSecs, nMsecs: Word;
wsSystem: array[1..80] of WideChar;
LibHandle: THandle;
pTOD: PTIMEOFDAYINFO;
NTNetRemoteTODA: function(server: PChar;
var pTOD: PTimeofDayInfo): NET_API_STATUS; stdcall;
NTNetRemoteTOD: function(server: PWideChar;
var pTOD: PTimeofDayInfo): NET_API_STATUS; stdcall;
NTNetApiBufferFree: function(lpBuffer: Pointer): NET_API_STATUS; stdcall;
IsWinNT : Boolean;
szComputerName : array[0..99] of Char;
dwSIZE : DWord;
begin
LibHandle := 0;
FillChar(TOD, SizeOf(TOD), 0);
// eigener oder fremder Rechner ?
GetComputerName(@szComputerName, dwSIZE);
if Uppercase(TimeServer) = '\\' + szComputerName then
// eigener Rechner
with TOD do
begin
Tzo := GetLocalTimeZoneOffSet;
tod_TimeZone := Round(Tzo * MINUTESPERDAY);
PresentUTC := Now + Tzo;
DecodeDate(PresentUTC, nYear, nMonth, nDay);
DecodeTime(PresentUTC, nHours, nMins, nSecs, nMsecs);
tod_Year := nYear;
tod_Month := nMonth;
tod_Day := nDay;
tod_Hours := nHours;
tod_Mins := nMins;
tod_Secs := nSecs;
tod_Hunds := nMsecs div 10;
tod_Elapsedt := Round((PresentUTC - 25569) * 86400);
tod_MSecs := GetTickCount;
tod_TInterval := 1000;
end
else
// fremder Rechner
begin
try
IsWinNT := (Win32Platform = Ver_PlatForm_Win32_NT);
if IsWinNT then
// Rechner verwendet Windows NT
begin
ErrMode := SetErrorMode(SEM_NOOPENFILEERRORBOX);
LibHandle := LoadLibrary(NTlib);
SetErrorMode(ErrMode);
if LibHandle = 0 then
raise ENetTODError.Create(cLERROR + NTlib);
@NTNetRemoteTOD := GetProcAddress(LibHandle, 'NetRemoteTOD');
@NTNetApiBufferFree := GetProcAddress(LibHandle, 'NetApiBufferFree');
StringtoWideChar(pChar(TimeServer), @wsSystem, sizeof(wsSystem));
try
NetCheck(NTNetRemoteTOD(@wsSystem, pTOD));
TOD := pTOD^;
finally
NetCheck(NTNetApiBufferFree(pTOD));
end;
end
else
// Rechner verwendet Windows 95 mit Radmin32
begin
ErrMode := SetErrorMode(SEM_NOOPENFILEERRORBOX);
LibHandle := LoadLibrary(Win95lib);
SetErrorMode(ErrMode);
if LibHandle = 0 then
raise ENetTODError.Create(cLERROR + Win95lib);
@NTNetRemoteTODA := GetProcAddress(LibHandle, 'NetRemoteTODA');
@NTNetApiBufferFree := GetProcAddress(LibHandle, 'NetApiBufferFree');
try
NetCheck(NTNetRemoteTODA(pChar(TimeServer), pTOD));
TOD := pTOD^;
finally
// pTOD = nil nach eine Exception, eventl. �berfl�ssig
NetCheck(NTNetApiBufferFree(pTOD));
end;
end;
finally
if LibHandle <> 0 then
begin
FreeLibrary(Libhandle);
LibHandle := 0;
end;
end;
end;
end;

function ServerTimeZoneOffset(ServerName: string): TDateTime;
var
TOD: TTimeofDayInfo;
begin
GetTOD(ServerName, TOD);
Result := TOD.tod_TimeZone / MINUTESPERDAY;
end;

function ServerTime(ServerName: string): TDateTime;
var
TOD: TTimeofDayInfo;
begin
GetTOD(ServerName, TOD);
with TOD do
Result := EncodeDate(tod_Year, tod_Month, tod_Day) +
EncodeTime(tod_Hours, tod_Mins, tod_Secs, tod_Hunds * 10);
end;

end.
</pre&gt

**Hagen Reddmann** · 12.06.2001, 08:32

Hi Andreas

Sch�n und gut, ich habe Win95 und keine RADMIN32.dll ??
Ich habe Workgroups + Novel-Server + NT-Server Netzwerk, daran kanns also nicht scheitern. Alle �blichen Protokolle wie TCP/IP, NDISWAN, NetBEUI, IPX/SPX und Clienten sind installiert.

Hagen

PS: Ich hasse es wenn ich nicht sicher sein kann das solche DLL's zu System geh�ren. Funktioniert den NT/2000 denn richtig

**Andreas Richter** · 12.06.2001, 11:47

Hallo Herr Kosch und Herr Reddmann,

genau um diese Probleme zu vermeiden, hatte ich an einen "unsichtbaren" Aufruf von NET gedacht. Der NET - Befehl funktioniert nach meinen Erfahrungen immer.

Freundliche Gr��e, Andreas Richte

**Digidrag** · 20.06.2001, 12:11

Unsichtbarer Aufruf von programm und umleitung des outputs in in eine Datei: 
 
procedure TForm2.testspeedClick(Sender: TObject); 
var 
aSA : TSecurityAttributes; 
aSI : TStartupInfo; 
aPI : TProcessInformation; 
szTemp : array[0..199] of Char; 
FName : String; 
hLogFile : THandle; 
dwExit : DWORD; 
i,j :integer; 
s :string; 
tim :real; 
 
Procedure Loadit; 
var r:integer; 
begin 
if getmyfilesize(FName)<5 then exit; 
//funtioniert nicht, wenn datei noch geschrieben wird: 
//foutput.free; 
//foutput:=TStringList.Create; 
//foutput.LoadFromFile(FName); 
//foutput.free; 
FileMode:=0; 
assignfile(rsrctxt,dateiname); 
reset(rsrctxt); 
.....readln in array datei 
 
closefile(rsrctxt); 
end; 
 
Begin 
 
FillChar(aSA, SizeOf(aSA), #0); 
aSA.nLength := SizeOf(aSA); 
aSA.bInheritHandle := True; 
 
// temp. Dateinamen f�r Output generieren 
FillChar(szTemp, SizeOf(szTemp), #0); 
GetEnvironmentVariable(PCHar('TEMP'), szTemp, 180); 
FName := szTemp + '\MRay.txt'; 
// Output-Datei �ffnen 
hLogFile := CreateFile(PCHar(FName), GENERIC_WRITE or GENERIC_READ,
FILE_SHARE_READ or FILE_SHARE_WRITE,
@aSA, CREATE_ALWAYS, 0, 0); 
// Standard-Output in Datei umleiten 
{FillChar(aSI, SizeOf(aSI), 0); 
aSI.cb := SizeOf(aSI);aSI.lpReserved:=nil;aSI.lpDesktop:=nil ; 
aSI.lpReserved2:=nil;aSi.cbReserved2:=0;} 
GetStartupInfo(aSI); 
aSI.dwflags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW; 
aSI.wShowWindow := SW_SHOWNORMAL;//<= aendern, wenn garnichts zu sehen sein soll 
aSI.hStdOutput := hLogFile; 
aSI.hStdError := hLogFile; 
 
ASI.lpTitle:=pchar('No output visible, can take a few minutes'); 
i:=1; 
if CreateProcess(PChar(ppfad+'bat\c_'+computername+'. bat'), nil, nil, nil, True, Normal_Priority_Class, nil, PChar(ppfad), aSI, aPI) 
then
begin 
repeat 
Application.ProcessMessages; 
sleep(1000); 
GetExitCodeProcess(aPI.hProcess, dwExit); 
inc(i); 
if i mod 5=0 then 
begin 
i:=1; 
loadit; 
end; 
until dwExit <> STILL_ACTIVE; 
CloseHandle(aPI.hThread); 
CloseHandle(aPI.hProcess); 
CloseHandle(hLogFile); 
end 
else exit; 
sleep(200); 
if getmyfilesize(FName)<30 then 
begin 
Showmessage('No verbose file was created, can''t calculate'); 
exit; 
end; 
loadit; 
i:=1; 
//While (i<(foutput.count-1)) and (pos('TIME',upstring(foutput.Strings[i]))<=0) do inc(i); 
While (i<maxdatei) and (pos('TIME',upstring(datei[i]))<=0) do inc(i); 
if (pos('TIME',upstring(datei[i]))=0) then 
begin 
Showmessage('Not found'); 
end 
else 
begin 
s:=datei[i]; 
auslesen 
end; 
//foutput.free; 
//foutput:=nil; 
DeleteFile(FName); 
end;<br&gt

**Gesine Kuhlmann** · 11.07.2001, 02:05

Hi,

Noch k�rzer ist's doch wohl, die Arbeitsstation so zu konfigurieren, dass sie sich beim Anmelden das Systemdatum automatisch vom Server holt. Danach reicht ein Aufruf von Time().

Gru�
Gesin

Announcement

Zeit vom Netzwerk holen

Zeit vom Netzwerk holen

Comment

Comment

Comment

Comment

Comment