[Dream Worker]

library TimeShift;
uses
Windows,TLHelp32;

type
OldCode = packed record
One: dword;
two: word;
end;


far_jmp = packed record
PuhsOp: byte;
PushArg: pointer;
RetOp: byte;
end;

var
JmpGlt : far_jmp;
OldGlt : OldCode;
GltAdr : pointer;

JmpGst : far_jmp;
OldGst : OldCode;
GstAdr : pointer;

Function OpenThread(dwDesiredAccess: dword;
bInheritHandle: bool;
dwThreadId: dword): dword; stdcall;
external 'kernel32.dll';


Procedure StopThreads;
var
h, CurrTh, ThrHandle, CurrPr: dword;
Thread: TThreadEntry32;
begin
CurrTh := GetCurrentThreadId;
CurrPr := GetCurrentProcessId;
h := CreateToolhelp32Snapshot(TH32CS_SNAPTHREAD, 0);
if h <> INVALID_HANDLE_VALUE then
begin
Thread.dwSize := SizeOf(TThreadEntry32);
if Thread32First(h, Thread) then
repeat
if (Thread.th32ThreadID <> CurrTh) and (Thread.th32OwnerProcessID = CurrPr) then
begin
ThrHandle := OpenThread(0002, false, Thread.th32ThreadID);
if ThrHandle>0 then
begin
SuspendThread(ThrHandle);
CloseHandle(ThrHandle);
end;
end;
until not Thread32Next(h, Thread);
CloseHandle(h);
end;
end;

Procedure RunThreads;
var
h, CurrTh, ThrHandle, CurrPr: dword;
Thread: TThreadEntry32;
begin
CurrTh := GetCurrentThreadId;
CurrPr := GetCurrentProcessId;
h := CreateToolhelp32Snapshot(TH32CS_SNAPTHREAD, 0);
if h <> INVALID_HANDLE_VALUE then
begin
Thread.dwSize := SizeOf(TThreadEntry32);
if Thread32First(h, Thread) then
repeat
if (Thread.th32ThreadID <> CurrTh) and (Thread.th32OwnerProcessID = CurrPr) then
begin
ThrHandle := OpenThread(2, false, Thread.th32ThreadID);
if ThrHandle>0 then
begin
ResumeThread(ThrHandle);
CloseHandle(ThrHandle);
end;
end;
until not Thread32Next(h, Thread);
CloseHandle(h);
end;
end;

procedure TrueGetLocalTime(var lpSystemTime: TSystemTime); stdcall;
var
Written: dword;
begin
WriteProcessMemory(INVALID_HANDLE_VALUE, GltAdr, @OldGlt, SizeOf(OldCode), Written);
GetLocalTime(lpSystemTime) ;
WriteProcessMemory(INVALID_HANDLE_VALUE, GltAdr,@JmpGlt, SizeOf(far_jmp), Written);
end;

procedure NewGetLocalTime(var lpSystemTime: TSystemTime); stdcall;
begin
TrueGetLocalTime(lpSystemTime) ;
lpSystemTime.wYear:=2008;
lpSystemTime.wDayOfWeek:=2;
end;

procedure TrueGetSystemTime(var lpSystemTime: TSystemTime); stdcall;
var
Written: dword;
begin
WriteProcessMemory(INVALID_HANDLE_VALUE, GstAdr,@OldGst, SizeOf(OldCode), Written);
GetSystemTime(lpSystemTime) ;
WriteProcessMemory(INVALID_HANDLE_VALUE, GstAdr,@JmpGst, SizeOf(far_jmp), Written);
end;

procedure NewGetSystemTime(var lpSystemTime: TSystemTime); stdcall;
begin
TrueGetSystemTime(lpSystemTime) ;
lpSystemTime.wYear:=2008;
end;

Procedure SetHook();
var
Khernel32: dword;
Bytes: dword;
begin
Khernel32 := GetModuleHandle('Kernel32.dll');

GltAdr := GetProcAddress(Khernel32, 'GetLocalTime');
ReadProcessMemory(INVALID_HANDLE_VALUE, GltAdr, @OldGlt, SizeOf(OldCode), Bytes);
JmpGlt.PuhsOp := $68;
JmpGlt.PushArg := @NewGetLocalTime;
JmpGlt.RetOp := $C3;
WriteProcessMemory(INVALID_HANDLE_VALUE, GltAdr, @JmpGlt, SizeOf(far_jmp), Bytes);

GstAdr := GetProcAddress(Khernel32, 'GetSystemTime');
ReadProcessMemory(INVALID_HANDLE_VALUE, GstAdr, @OldGst, SizeOf(OldCode), Bytes);
JmpGst.PuhsOp := $68;
JmpGst.PushArg := @NewGetSystemTime;
JmpGst.RetOp := $C3;
WriteProcessMemory(INVALID_HANDLE_VALUE, GstAdr, @JmpGst, SizeOf(far_jmp), Bytes);


end;

Procedure Unhook();
var
Bytes: dword;
begin
WriteProcessMemory(INVALID_HANDLE_VALUE, GltAdr, @OldGlt, SizeOf(OldCode), Bytes);
WriteProcessMemory(INVALID_HANDLE_VALUE, GstAdr, @OldGst, SizeOf(OldCode), Bytes);
end;


// залепа
Function MessageProc(code : integer; wParam : word;
lParam : longint) : longint; stdcall;
begin
CallNextHookEx(0, Code, wParam, lparam);
Result := 0;
end;

Procedure SetGlobalHookProc();
begin
SetWindowsHookEx(WH_GETMESSAGE, @MessageProc, HInstance, 0);
Sleep(INFINITE);
end;
//

Procedure SetGlobalHook();
var
hMutex: dword;
TrId: dword;
begin
hMutex := CreateMutex(nil, false, 'AdvareHook');
if GetLastError = 0 then
CreateThread(nil, 0, @SetGlobalHookProc, nil, 0, TrId) else
CloseHandle(hMutex);
end;


procedure DLLEntryPoint(dwReason: DWord);
begin
case dwReason of
DLL_PROCESS_ATTACH: begin
SetGlobalHook();
Randomize();
StopThreads;
SetHook();
RunThreads;
end;
DLL_PROCESS_DETACH: UnHook();
end;
end;


begin
DllProc := @DLLEntryPoint;
DLLEntryPoint(DLL_PROCESS_ATTACH);
end.

ну вот при мерно так как-то... (жалко что при добалении форматирование кода калечитсмя )