How to set the Windows Date and Time.
Author unknown.
Type
TOSType = (os95, os98, osOSR2, osNT4, os2K);
procedure SetDateTime(dDateTime: TDateTime);
var
dSysTime: TSystemTime;
buffer: DWord;
tkp, tpko: TTokenPrivileges;
hToken: THandle;
begin
if IsOSNT then
begin
if not OpenProcessToken(GetCurrentProcess(),
TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,
hToken) then exit;
LookupPrivilegeValue(nil, 'SE_SYSTEMTIME_NAME',
tkp.Privileges[0].Luid);
tkp.PrivilegeCount := 1;
tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
if not AdjustTokenPrivileges(hToken, FALSE, tkp,
sizeof(tkp), tpko, buffer) then exit;
end;
DateTimeToSystemTime(dDateTime, dSysTime);
Windows.SetLocalTime(dSysTime);
end
function IsOSNT: boolean;
var
OS: TOSVersionInfo;
begin
ZeroMemory(@OS, SizeOf(OS));
OS.dwOSVersionInfoSize := SizeOf(OS);
GetVersionEx(OS);
result := OS.dwPlatformId = VER_PLATFORM_WIN32_NT;
end;
function IsOS95: boolean;
var
OS: TOSVersionInfo;
begin
ZeroMemory(@OS, SizeOf(OS));
OS.dwOSVersionInfoSize := SizeOf(OS);
GetVersionEx(OS);
result := (OS.dwMajorVersion >= 4) and (OS.dwMinorVersion = 0)
and (OS.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS);
end;
function IsOS98: boolean;
var
OS: TOSVersionInfo;
begin
ZeroMemory(@OS, SizeOf(OS));
OS.dwOSVersionInfoSize := SizeOf(OS);
GetVersionEx(OS);
result := (OS.dwMajorVersion >= 4) and (OS.dwMinorVersion > 0)
and (OS.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS);
end;
function IsOSOSR2: boolean;
var
OS: TOSVersionInfo;
begin
ZeroMemory(@OS, SizeOf(OS));
OS.dwOSVersionInfoSize := SizeOf(OS);
GetVersionEx(OS);
result := (OS.dwMajorVersion >= 4) and (OS.dwMinorVersion = 0)
and (lo(OS.dwBuildNumber) > 1000) and
(OS.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS);
end;
function IsOS2000: boolean;
var
OS: TOSVersionInfo;
begin
ZeroMemory(@OS, SizeOf(OS));
OS.dwOSVersionInfoSize := SizeOf(OS);
GetVersionEx(OS);
result := (OS.dwMajorVersion >= 5) and
(OS.dwPlatformId = VER_PLATFORM_WIN32_NT);
end;
function GetOSType: TOSType;
begin
if IsOSNT then
begin
if IsOS2000 then
Result := os2K
else
Result := osNT4;
end
else if IsOS95 then
Result := os95
else if IsOS98 then
Result := os98
else if IsOSOSR2 then
Result := osOSR2;
end