Fonte: www.activedelphi.com.br
Esta dica apresenta uma função simples, porém útil, para ajustar a data e a hora do sistema operacional. Ela foi postada pelo membro Rubem Rocha, na lista de discussão lista-delphi (link no final da dica). Fiz os testes e agora compartilho com vocês.
Segue o código da função:
function SetComputerDateTime(ADateTime: TDateTime): boolean;
const
SE_SYSTEMTIME_NAME = 'SeSystemtimePrivilege';
var
hToken: THandle;
ReturnLength: DWORD;
tkp, PrevTokenPriv: TTokenPrivileges;
luid: TLargeInteger;
dSysTime: TSystemTime;
begin
Result := False;
if Win32Platform = VER_PLATFORM_WIN32_NT then
if OpenProcessToken(GetCurrentProcess,
TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then
try
if not LookupPrivilegeValue(nil, SE_SYSTEMTIME_NAME, luid) then
Exit;
tkp.PrivilegeCount := 1;
tkp.Privileges[0].luid := luid;
tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
if not AdjustTokenPrivileges(hToken, False, tkp,
SizeOf(TTOKENPRIVILEGES), PrevTokenPriv, ReturnLength) then
Exit;
if GetLastError <> ERROR_SUCCESS then
begin
raise Exception.Create(SysErrorMessage(GetLastError));
Exit;
end;
finally
CloseHandle(hToken);
end;
DateTimeToSystemTime(ADateTime, dSysTime);
Result := SetLocalTime(dSysTime);
if Result then
PostMessage(HWND_BROADCAST, WM_TIMECHANGE, 0, 0);
end;
Para testá-la, faça no onClick de um Button, por exemplo, o seguinte código:
procedure TForm1.Button1Click(Sender: TObject);
var
Correta, Nova: TDateTime;
begin
Correta := Now; //recupera a hora correta
Nova := StrToDateTime('01/01/2011 12:34:56'); //gera uma nova data qualquer
SetComputerDateTime(Nova); //altera a data
ShowMessage('Clique em OK para voltar a data correta!'); //alerta o usuário
SetComputerDateTime(Correta); //volta a data correta
end;
Esta dica apresenta uma função simples, porém útil, para ajustar a data e a hora do sistema operacional. Ela foi postada pelo membro Rubem Rocha, na lista de discussão lista-delphi (link no final da dica). Fiz os testes e agora compartilho com vocês.
Segue o código da função:
function SetComputerDateTime(ADateTime: TDateTime): boolean;
const
SE_SYSTEMTIME_NAME = 'SeSystemtimePrivilege';
var
hToken: THandle;
ReturnLength: DWORD;
tkp, PrevTokenPriv: TTokenPrivileges;
luid: TLargeInteger;
dSysTime: TSystemTime;
begin
Result := False;
if Win32Platform = VER_PLATFORM_WIN32_NT then
if OpenProcessToken(GetCurrentProcess,
TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then
try
if not LookupPrivilegeValue(nil, SE_SYSTEMTIME_NAME, luid) then
Exit;
tkp.PrivilegeCount := 1;
tkp.Privileges[0].luid := luid;
tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
if not AdjustTokenPrivileges(hToken, False, tkp,
SizeOf(TTOKENPRIVILEGES), PrevTokenPriv, ReturnLength) then
Exit;
if GetLastError <> ERROR_SUCCESS then
begin
raise Exception.Create(SysErrorMessage(GetLastError));
Exit;
end;
finally
CloseHandle(hToken);
end;
DateTimeToSystemTime(ADateTime, dSysTime);
Result := SetLocalTime(dSysTime);
if Result then
PostMessage(HWND_BROADCAST, WM_TIMECHANGE, 0, 0);
end;
Para testá-la, faça no onClick de um Button, por exemplo, o seguinte código:
procedure TForm1.Button1Click(Sender: TObject);
var
Correta, Nova: TDateTime;
begin
Correta := Now; //recupera a hora correta
Nova := StrToDateTime('01/01/2011 12:34:56'); //gera uma nova data qualquer
SetComputerDateTime(Nova); //altera a data
ShowMessage('Clique em OK para voltar a data correta!'); //alerta o usuário
SetComputerDateTime(Correta); //volta a data correta
end;
Nenhum comentário:
Postar um comentário