Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Начинающим";
Текущий архив: 2006.12.31;
Скачать: [xml.tar.bz2];

Вниз

Получение адреса функции по таблице экспорта.   Найти похожие ветки 

 
Riply ©   (2006-12-07 20:02) [0]

Здравствуйте !
Пытаюсь "замапить" Dll и получить адрес функции по ее имени.
Функцию найти удается, но ее адрес (вот негодяй) не хочет совпадать
с адресом, полученным при помощи GetProcAddress - GetModuleHandle.
Я понимаю, что они не обязаны совпадать, но иногда ведь должны :)
Что я делаю не так ? ( Надеюсь не все :).
type
PDWordArray = ^TDWordArray;
TDWordArray = array [0..$FFFFF] of DWord;

function Get_ExportProcAddres(const pMap: Pointer; const ProcName: string; var Addr: DWord): Boolean;
var
pExportDirectory: PImageExportDirectory;
pImSectHearder: PImageSectionHeader;
pNameRVAs: PDWordArray;
ImageName: string;
cbDirSize: DWord;
i: integer;
begin
Result:= False;
pExportDirectory := ImageDirectoryEntryToData(pMap,
                     False, IMAGE_DIRECTORY_ENTRY_EXPORT, cbDirSize);
if (pExportDirectory <> nil) then
 begin
  pImSectHearder := nil;
  pNameRVAs:= ImageRvaToVa(ImageNtHeader(pMap), pMap,
              DWord(pExportDirectory^.AddressOfNames), pImSectHearder);

  for i := 0 to pExportDirectory^.NumberOfNames - 1 do
   begin
    pImSectHearder := nil;
    ImageName := PChar(ImageRvaToVa(ImageNtHeader(pMap), pMap, pNameRVAs^[i], pImSectHearder));
    if CompareText(ProcName, ImageName) = 0 then
     begin
      Result:= True;
      Addr:= pNameRVAs^[i];
      Break;
     end;
   end;
 end;
end;

function TestFunctAddress(const pModName, pProcName: PChar): Boolean;
var
HFile, HMap: THandle;
Map: Pointer;
QSysInfo: Pointer;
cbAddr: DWord;
begin
Result := false;
HFile := CreateFileA(pModName, GENERIC_READ, FILE_SHARE_READ, nil,
  OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, INVALID_HANDLE_VALUE);
Win32Check(HFile <> INVALID_HANDLE_VALUE);
try
  HMap := CreateFileMappingA(HFile, nil, PAGE_READONLY, 0, 0, nil);
  Win32Check(HMap <> 0);
  try
    Map := MapViewOfFile(HMap, FILE_MAP_READ, 0, 0, 0);
    Win32Check(Assigned(Map));
    try
     QSysInfo := GetProcAddress(GetModuleHandle(pModName), pProcName);
      if Assigned(QSysInfo) then
       if Get_ExportProcAddres(Map, pProcName, cbAddr) then
        begin
         Result:= (cbAddr = DWord(QSysInfo) - GetModuleHandle(pModName));
         ShowMessage(IntToStr(cbAddr) + #13#10 + IntToStr(DWord(QSysInfo) - GetModuleHandle(pModName)));
        end;
    finally
      UnmapViewOfFile(Map);
    end;
  finally
    CloseHandle(HMap);
  end;
finally
  CloseHandle(HFile);
end;
end;

И вызов : TestFunctAddress("C:\Windows\system32\ntdll.dll", "NtQuerySystemInformation");


 
jack128 ©   (2006-12-07 20:56) [1]

Riply ©   (07.12.06 20:02)
Я понимаю, что они не обязаны совпадать, но иногда ведь должны :)

Хм. А почему должны?  Один и тот же файл замапин два раза (один раз виндой, другой - тобой) но замапин по разным адресам..

const
 FileName = "F:\p2p на E\download\Setup.exe";
var
 hMap1, hMap2: THandle;
 Addr1, Addr2: Pointer;
 fs: TFileStream;
begin
 fs := TFileStream.Create(FileName, fmOpenRead);
 try
   hMap1 := CreateFileMappingA(fs.Handle, nil, PAGE_READONLY, 0, 0, nil);
   hMap2 := CreateFileMappingA(fs.Handle, nil, PAGE_READONLY, 0, 0, nil);
   try
     Addr1 := MapViewOfFile(HMap1, FILE_MAP_READ, 0, 0, 0);
     Addr2 := MapViewOfFile(HMap2, FILE_MAP_READ, 0, 0, 0);
     try
       Assert(Addr1 = Addr2);
     finally
       UnmapViewOfFile(Addr1); UnmapViewOfFile(Addr2);
     end;
   finally
     CloseHandle(hMap1); CloseHandle(hMap2)
   end;
 finally
   fs.Free;
 end;
end;


 
Riply ©   (2006-12-07 21:23) [2]

>[1] jack128 ©   (07.12.06 20:56)
>Один и тот же файл замапин два раза (один раз виндой, другой - тобой) но замапин по разным адресам..
А я сравниваю не адреса "мапов", а адреса функций, найденых в этих "мапах"
Кстати, в приведенном тобой примере, они отлично совпадают .
function TestAddress: Boolean;
const
pModName = "C:\Windows\system32\ntdll.dll";
var
hFile, hMap1, hMap2: THandle;
Addr1, Addr2: Pointer;
fs: TFileStream;
Proc1, Proc2: DWord;
begin
Result:= False;
HFile := CreateFileA(pModName, GENERIC_READ, FILE_SHARE_READ, nil,
  OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, INVALID_HANDLE_VALUE);
try
  hMap1 := CreateFileMappingA(HFile, nil, PAGE_READONLY, 0, 0, nil);
  hMap2 := CreateFileMappingA(HFile, nil, PAGE_READONLY, 0, 0, nil);
  try
    Addr1 := MapViewOfFile(HMap1, FILE_MAP_READ, 0, 0, 0);
    Addr2 := MapViewOfFile(HMap2, FILE_MAP_READ, 0, 0, 0);
    try
     Get_ExportProcAddres(Addr1, "NtQuerySystemInformation", Proc1);
     Get_ExportProcAddres(Addr2, "NtQuerySystemInformation", Proc2);
     Result:= Proc1 = Proc2;
    finally
     UnmapViewOfFile(Addr1); UnmapViewOfFile(Addr2);
    end;
  finally
    CloseHandle(hMap1); CloseHandle(hMap2)
  end;
finally
 CloseHandle(HFile);
end;
end;

P.S. Функцию Get_ExportProcAddres см. выше


 
jack128 ©   (2006-12-08 00:26) [3]

Хем.. Я не спец, судя по MSDN:
The ImageRvaToVa function locates a relative virtual address (RVA)
выделенное слово переводится, как относительный...


 
jack128 ©   (2006-12-08 00:26) [4]

jack128 ©   (08.12.06 0:26) [3]
Я не спец, но судя по MSDN:


 
jack128 ©   (2006-12-08 00:29) [5]

собственно результаты, возвращаемые твой функций об этом и говорят.. Всё таки 32К - слишком маленький адрес...


 
oxffff ©   (2006-12-08 00:46) [6]

Поясни какие у тебя проблемы.

В секции импорта 2 таблицы
одна это OriginalFirstThunk
Вторая FirstThunk

C какой ты сравниваешь?

И что ты вообще сравниваешь?


 
oxffff ©   (2006-12-08 00:49) [7]

Таблица OriginalFirstThunk во время работы программы не меняется.

Загрузчик заполняет таблицу по FirstThunk.

Поясни, что с чем ты сравниваешь и что не получается?


 
oxffff ©   (2006-12-08 00:51) [8]

Слушай а ты не ошибся таблицами.
Почему таблица экспорта?


 
oxffff ©   (2006-12-08 00:52) [9]

А вы девушка?

Тогда, что у вас не получается?


 
Riply ©   (2006-12-08 01:52) [10]

>[9] oxffff © (08.12.06 00:52)
>Тогда, что у вас не получается?
Давай без дискриминации :)
Суть вот в чем:
Игорь Шевченко приводил примерно такой код для определения перехвачена
функция или нет:
HFile := CreateFileA(DllPath, GENERIC_READ, FILE_SHARE_READ, nil,
  OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, INVALID_HANDLE_VALUE);
try
  HMap := CreateFileMappingA(HFile, nil, PAGE_READONLY, 0, 0, nil);
  try
    Map := MapViewOfFile(HMap, FILE_MAP_READ, 0, 0, 0);
    try
      Headers := RtlImageNtHeader(HMODULE(Map));
      if Assigned(Headers) then
       begin
        Result := Headers.OptionalHeader.ImageBase <> GetModuleHandle(Lib_NtDll);
        if not Result then
         begin
          QSysInfo := GetProcAddress(GetModuleHandle(Lib_NtDll), _NtQuerySysInfo);
          if Assigned(QSysInfo) then
           begin
            Result:= (Cardinal(QSysInfo) <= Headers.OptionalHeader.ImageBase)
                  or (Cardinal(QSysInfo) > Headers.OptionalHeader.ImageBase + Headers.OptionalHeader.SizeOfCode);
            if not Result then
              Result := IsNtDllCodeHooked(DllPath, ULONG(QSysInfo) - Headers.OptionalHeader.ImageBase);
           end else
            Result := true;
         end;
       end;
    finally
      UnmapViewOfFile(Map);
    end;
  finally
    CloseHandle(HMap);
  end;
finally
  CloseHandle(HFile);
end;

Так вот, интересует как можно вычислить смещение
ULONG(QSysInfo) - Headers.OptionalHeader.ImageBase
если мы не прошли условие:
(Cardinal(QSysInfo) <= Headers.OptionalHeader.ImageBase)
 or (Cardinal(QSysInfo) > Headers.OptionalHeader.ImageBase + Headers.OptionalHeader.SizeOfCode);
Игорь посоветовал смотреть в сторону экспорта.


 
Сергей М. ©   (2006-12-08 08:38) [11]


> Riply


Поясни, зачем тебе понадобилось это самое "замапить" ..

Тебе требуется перехватить вызов некоей ф-ции ?


 
oxffff ©   (2006-12-08 09:19) [12]


> Riply ©   (08.12.06 01:52) [10]
> >[9] oxffff © (08.12.06 00:52)
> >Тогда, что у вас не получается?
> Давай без дискриминации :)


Абсолютно без  дискриминации.
Просто это у меня вызывает уважение.


 
Riply ©   (2006-12-08 15:48) [13]

> [11] Сергей М. ©   (08.12.06 08:38)
>Поясни, зачем тебе понадобилось это самое "замапить" ..
>Тебе требуется перехватить вызов некоей ф-ции ?
С точностью до наоборот :)
Есть кем-то перехваченная функция.
А это попыка получить адрес настоящей.
Ну, хотя бы, не адрес а смещение, которое, в неперехваченом варианте,
равно GetProcAddress(GetModuleHandle(NtDll), NtQuerySysInfo) - GetModuleHandle(NtDll)
Сумбурно, но что делать :)


 
Игорь Шевченко ©   (2006-12-08 16:19) [14]

Если есть мой hsPEImage, то:

class TPEImage ...
private
 FExports: TStrings;
 procedure LoadExports;
public
 property ImageExports: TStrings read FExports;
end;

procedure TPEImage.LoadExports;
var
 Offset, RawOffset: Cardinal;
 ExportDirectory: PImageExportDirectory;
 I: DWORD;
 PFunctionsAddress: PDWORD;

 function FindNameForOrdinal (Ordinal: Word): string;
 var
   J, K: DWORD;
   POrdinals: PWordArray;
   PNames: PDwordArray;
   PName: DWORD;
 begin
   Result := "";
   POrdinals := PWordArray(RawData +
     RawAddress(Integer(ExportDirectory^.AddressOfNameOrdinals)));
   K := DWORD(-1);
   for J:=1 to ExportDirectory^.NumberOfNames do
     if POrdinals^[J-1] = Ordinal then begin
       K := J-1;
       Break;
     end;
   if K = DWORD(-1) then
     Exit;
   PNames := PDwordArray(RawData +
     RawAddress(Integer(ExportDirectory^.AddressOfNames)));
   PName := PNames^[K];
   Result := StrPas(RawData + RawAddress(PName));
 end;

begin
 FExports := TStringList.Create;
 Offset := FNtHeaders^.OptionalHeader.
       DataDirectory[IMAGE_DIRECTORY_ENTRY_EXPORT].VirtualAddress;
 if Offset = 0 then
   Exit;
 RawOffset := RawAddress(Offset);
 ExportDirectory := PImageExportDirectory(RawData + RawOffset);
 Offset := Cardinal(ExportDirectory^.AddressOfFunctions);
 RawOffset := RawAddress(Offset);
 PFunctionsAddress := PDWORD(RawData + RawOffset);
 for I:=1 to ExportDirectory^.NumberOfFunctions do begin
   if PFunctionsAddress^ <> 0 then
     FExports.AddObject(FindNameForOrdinal(Word(I-1)),
       TObject(PFunctionsAddress^));
   Inc(PFunctionsAddress);
 end;
end;


Вызвать после успешной загрузки Dll-я.

Использование:

unit GetProcImpl;

interface

function HSGetProcAddress(FileName, EntryName: string): Integer;

implementation
uses
 SysUtils, HSPEImage, Classes;

function HSGetProcAddress(FileName, EntryName: string): Integer;
var
 Image: TPEImage;
 I: Integer;
begin
 Result := 0;
 if not FileExists(FileName) then
   Exit;
 Image := TPEImage.Create(FileName);
 try
   I := Image.ImageExports.IndexOf(EntryName);
   if (I <> -1) then
     Result := Integer(Image.ImageExports.Objects[I]);
 finally
   Image.Free;
 end;
end;

end.


 
Riply ©   (2006-12-08 16:45) [15]

> [14] Игорь Шевченко ©   (08.12.06 16:19)
>Если есть мой hsPEImage, то:
Он у меня есть, но видимо устаревший :(
THSPEImage = class
private
  FMapper: THSFileMapper;
  FSections: TSectionList;
  function GetRVAData(AVirtualAddress: ULONG): Pointer;
public
  constructor Create (const AFileName: string);
  destructor Destroy; override;
  property RVAData[VirtualAddress: ULONG]: Pointer read GetRVAData;
end;

constructor THSPEImage.Create(const AFileName: string);
var
PSection: PImageSectionHeader;
I: Integer;
Header: PIMAGE_NT_HEADERS;
begin
FMapper:= THSFileMapper.Create(AFileName);
FSections:= TSectionList.Create;
Header:= PIMAGE_NT_HEADERS(FMapper.Map + PIMAGE_DOS_HEADER(FMapper.Map)^._lfanew);
PSection:= PImageSectionHeader(DWORD(@(Header^.OptionalHeader)) + Header^.FileHeader.SizeOfOptionalHeader);
for I:=1 to Header^.FileHeader.NumberOfSections do
 begin
  FSections.Add(PSection);
  Inc(PSection);
 end;
end;

destructor THSPEImage.Destroy;
begin
FSections.Free;
FMapper.Free;// Me_Add
inherited;
end;

function THSPEImage.GetRVAData(AVirtualAddress: ULONG): Pointer;
var
I: Integer;
begin
Result := nil;
for I:=0 to Pred(FSections.Count) do
 with FSections[I]^ do
  if (VirtualAddress <= AVirtualAddress) and ((VirtualAddress + Misc.VirtualSize) > AVirtualAddress) then
   begin
    Result:= FMapper.Map + PointerToRawData + (AVirtualAddress - VirtualAddress);
   end;
end;


 
Игорь Шевченко ©   (2006-12-08 16:57) [16]

unit HSPEImage;

interface
uses
 Windows, HSDosImage, HSFileMapper, Classes, SysUtils, HSImageUtils,
 HSObjectList;

type
 PDwordArray = ^TDwordArray;
 TDwordArray = array[0..8191] of DWORD;
 USHORT = Word;

 PIMAGE_NT_HEADERS = PImageNtHeaders;
 PIMAGE_DATA_DIRECTORY = ^IMAGE_DATA_DIRECTORY;

 PIMAGE_IMPORT_DESCRIPTOR = ^IMAGE_IMPORT_DESCRIPTOR;
 IMAGE_IMPORT_DESCRIPTOR = packed record
   Characteristics: Cardinal;
   TimeDateStamp: Cardinal;
   ForwarderChain: Cardinal;
   Name: Cardinal;
   FirstThunk: Cardinal;
 end;

 IMAGE_IMPORT_BY_NAME = packed record
   Hint: WORD;
   Name: Char;
 end;
 PIMAGE_IMPORT_BY_NAME = ^IMAGE_IMPORT_BY_NAME;

 TDelayLoadImportTableItem = packed record
   Flags: LongInt;
   DllName: Cardinal;
   Handle: Cardinal;
   EpAddresses: Cardinal;
   ImportNameTable: Cardinal;
   Reserved2: Cardinal;
   Reserved3: Cardinal;
   Reserved4: Cardinal;
 end;
 PDelayLoadImportTableItem = ^TDelayLoadImportTableItem;

 TDelayLoadImportTableItemArray = array [0..1024] of TDelayLoadImportTableItem;
 PDelayLoadImportTableItemArray = ^TDelayLoadImportTableItemArray;

 PDelayLoadEntryItem = PIMAGE_IMPORT_BY_NAME;

 TPEImage = class(TDosImage)
 private
   FMapper: THSFileMapper;
   FModuleReferences: TStrings;
   FImportLibraries: TStringList;
   FNtHeaders: PIMAGE_NT_HEADERS;
   FSections: TList;
   FImports: TStringList;
   FDelayImports: TStringList;
   FExports: TStringList;
   function GetSection(I: Integer): PImageSectionHeader;
   procedure LoadSections (Mapper: THSFileMapper);
   procedure LoadModuleReferences (Mapper: THSFileMapper);
   function GetImportedNameFromIATEntry (IATEntryRVA: DWORD;
     FullInfo: Boolean = false): string;
   function GetSubSystem: THSSubSystem;
   function GetImports: TStrings;
   procedure LoadImports;
   procedure LoadDelayImports;
   function GetDelayImports: TStrings;
   procedure LoadExports;
   function GetExports: TStrings;
 protected
   procedure Load (Mapper: THSFileMapper); override;
 public
   constructor Create (const FileName: string); override;
   destructor Destroy; override;
   function EpCode: PByteArray; override;
   function RawAddress (VirtualAddress: Cardinal): Cardinal;
   function GetFullImportedFunctionName(const DllName: string;
     IATEntryRVA: DWORD): string;
   function GetImportedFunctionName(const DllName: string;
     IATEntryRVA: DWORD): string;
   function FindSection (VirtualAddress: Cardinal): PImageSectionHeader;
   function FindVirtualSection (VirtualAddress: Cardinal): PImageSectionHeader;
   function ConvertRVA (const RVA: Cardinal; var ASectionNumber: Integer;
     var AOffset: Cardinal): Boolean;
   property Mapper: THSFileMapper read FMapper;
   property ModuleReferences: TStrings read FModuleReferences;
   property ImportLibraries: TStringList read FImportLibraries;
   property NtHeaders: PIMAGE_NT_HEADERS read FNtHeaders;
   property SectionList: TList read FSections;
   property Sections[I: Integer]: PImageSectionHeader read GetSection;
   property Subsystem: THSSubSystem read GetSubSystem;
   property Imports: TStrings read GetImports;
   property ImageExports: TStrings read GetExports;
   property DelayImports: TStrings read GetDelayImports;
 end;

const
 IMAGE_FILE_LARGE_ADDRESS_AWARE = $0020;

 IMAGE_SUBSYSTEM_NATIVE_WINDOWS = 8;
 IMAGE_SUBSYSTEM_WINDOWS_CE_GUI = 9;
 IMAGE_SUBSYSTEM_EFI_APPLICATION = 10;
 IMAGE_SUBSYSTEM_EFI_BOOT_SERVICE_DRIVER = 11;
 IMAGE_SUBSYSTEM_EFI_RUNTIME_DRIVER = 12;
 IMAGE_SUBSYSTEM_EFI_ROM = 13;
 IMAGE_SUBSYSTEM_XBOX = 14;

 IMAGE_DLLCHARACTERISTICS_NO_ISOLATION = $0200;
 IMAGE_DLLCHARACTERISTICS_NO_SEH = $0400;
 IMAGE_DLLCHARACTERISTICS_NO_BIND = $0800;
 IMAGE_DLLCHARACTERISTICS_WDM_DRIVER = $2000;
 IMAGE_DLLCHARACTERISTICS_TERMINAL_SERVER_AWARE = $8000;

 IMAGE_DIRECTORY_ENTRY_DELAY_IMPORT  = 13;
 IMAGE_DIRECTORY_ENTRY_COM_DESCRIPTOR = 14;

implementation

{ TPEImage }

function TPEImage.ConvertRVA(const RVA: Cardinal;
 var ASectionNumber: Integer; var AOffset: Cardinal): Boolean;
var
 Section: PImageSectionHeader;
begin
 Result := false;
 if RVA > FNtHeaders.OptionalHeader.ImageBase then
   AOffset := RVA - FNtHeaders.OptionalHeader.ImageBase
 else
   AOffset := RVA;
 Section := FindVirtualSection(AOffset);
 if Assigned(Section) then begin
   ASectionNumber := Succ(FSections.IndexOf(Section));
   Result := true;
 end;
end;

constructor TPEImage.Create(const FileName: string);
begin
 inherited Create(FileName);
 FSections := TList.Create;
 FModuleReferences := TStringList.Create;
 FImportLibraries := TStringList.Create;
 FExports := TStringList.Create;
 with FImportLibraries do begin
   Sorted := true;
   Duplicates := dupIgnore;
 end;
 FMapper := THSFileMapper.Create (FileName);
 Load (FMapper);
end;

destructor TPEImage.Destroy;
begin
 FMapper.Free;
 FImportLibraries.Free;
 FModuleReferences.Free;
 FSections.Free;
 FImports.Free;
 FDelayImports.Free;
 FExports.Free;
 inherited;
end;

function TPEImage.EpCode: PByteArray;
var
 EpAddr: DWORD;
begin
 EpAddr := RawAddress(NtHeaders^.OptionalHeader.AddressOfEntryPoint);
 if EpAddr <> 0 then
   Result := PByteArray(FMapper.Map + EpAddr)
 else
   Result := nil;
end;

function TPEImage.FindSection(
 VirtualAddress: Cardinal): PImageSectionHeader;
var
 I: Integer;
begin
 Result := nil;
 for I := 0 to Pred(FSections.Count) do
   if (Sections[I].VirtualAddress <= VirtualAddress) and
      (VirtualAddress < Sections[I].VirtualAddress +
       Sections[I].SizeOfRawData) then begin
     Result := Sections[I];
     Break;
   end;
end;


 
Игорь Шевченко ©   (2006-12-08 16:58) [17]

function TPEImage.FindVirtualSection(
 VirtualAddress: Cardinal): PImageSectionHeader;
var
 I: Integer;
begin
 Result := nil;
 for I := 0 to Pred(FSections.Count) do
   if (Sections[I].Characteristics and IMAGE_SCN_CNT_CODE) = 0 then begin
     if (Sections[I].VirtualAddress <= VirtualAddress) and
        (VirtualAddress < Sections[I].VirtualAddress +
         Sections[I].Misc.VirtualSize) then begin
       Result := Sections[I];
       Break;
     end
   end else
     if (Sections[I].VirtualAddress <= VirtualAddress) and
        (VirtualAddress < Sections[I].VirtualAddress +
         Sections[I].SizeOfRawData) then begin
       Result := Sections[I];
       Break;
     end;
end;

function TPEImage.GetDelayImports: TStrings;
begin
 if not Assigned(FDelayImports) then begin
   FDelayImports := TStringList.Create;
   FDelayImports.Sorted := true;
   FDelayImports.Duplicates := dupIgnore;
   LoadDelayImports;
 end;
 Result := FDelayImports;
end;

function TPEImage.GetExports: TStrings;
begin
 Result := FExports;
end;

function TPEImage.GetFullImportedFunctionName(const DllName: string;
 IATEntryRVA: DWORD): string;
begin
 if (IATEntryRVA and $80000000) <> 0 then
   Result := Format("%s.%d", [ChangeFileExt(DllName, ""),
     (IATEntryRVA and $7FFFFFFF)])
 else
   Result := Format("%s.%s", [ChangeFileExt(DllName, ""),
     GetImportedNameFromIATEntry(IATEntryRVA, true)]);
end;

function TPEImage.GetImportedFunctionName(const DllName: string;
 IATEntryRVA: DWORD): string;
begin
 if (IATEntryRVA and $80000000) <> 0 then
   Result := Format("%s.%d", [ChangeFileExt(DllName, ""),
     (IATEntryRVA and $7FFFFFFF)])
 else
   Result := Format("%s.%s", [ChangeFileExt(DllName, ""),
     GetImportedNameFromIATEntry(IATEntryRVA)]);
end;

function TPEImage.GetImportedNameFromIATEntry(IATEntryRVA: DWORD;
 FullInfo: Boolean): string;
var
 RawOffset: DWORD;
begin
 RawOffset := RawAddress (IATEntryRVA);
 Result := StrPas(RawData + RawOffset + SizeOf(Word));
 if FullInfo then
   Result := Format("%s (Hint=%.4x)", [Result,
     PIMAGE_IMPORT_BY_NAME(RawData + RawOffset)^.Hint]);
end;

function TPEImage.GetImports: TStrings;
begin
 if not Assigned(FImports) then begin
   FImports := TStringList.Create;
   FImports.Sorted := true;
   FImports.Duplicates := dupIgnore;
   LoadImports;
 end;
 Result := FImports;
end;

function TPEImage.GetSection(I: Integer): PImageSectionHeader;
begin
 Result := PImageSectionHeader(FSections[I]);
end;

function TPEImage.GetSubSystem: THSSubSystem;
begin
 with NtHeaders.OptionalHeader.DataDirectory[
     IMAGE_DIRECTORY_ENTRY_COM_DESCRIPTOR] do
   if (VirtualAddress <> 0) and (Size <> 0) then
     Result := hsssDotNet
   else
     case NtHeaders^.OptionalHeader.Subsystem of
     IMAGE_SUBSYSTEM_WINDOWS_GUI:
       Result := hsssGUI32;
     IMAGE_SUBSYSTEM_WINDOWS_CUI:
       Result := hsssCon32;
     IMAGE_SUBSYSTEM_NATIVE:
       Result := hsssNative;
     else
       Result := hsssUnknown;
     end;
end;

procedure TPEImage.Load(Mapper: THSFileMapper);
begin
 inherited;
 FNtHeaders := PIMAGE_NT_HEADERS(Mapper.Map + DosHeader^._lfanew);
 LoadSections (Mapper);
 LoadModuleReferences (Mapper);
 LoadExports;
end;

procedure TPEImage.LoadDelayImports;
var
 RawOffset: Integer;
 ImportDescriptor: PDelayLoadImportTableItem;
 DllName: string;
 PFunctionsAddress: PDWORD;
 ImportAddress: DWORD;
begin
 with NtHeaders^.OptionalHeader.DataDirectory[
     IMAGE_DIRECTORY_ENTRY_DELAY_IMPORT] do begin
   if (VirtualAddress = 0) or (Size = 0) then
     Exit;
   RawOffset := RawAddress(VirtualAddress);
 end;
 ImportDescriptor := PDelayLoadImportTableItem(RawData + RawOffset);
 while ImportDescriptor^.DllName <> 0 do begin
   if ImportDescriptor^.Flags = 1 then begin
     RawOffset := RawAddress(ImportDescriptor^.DllName);
     if RawOffset <> 0 then
       DllName := UpperCase(StrPas(RawData + RawOffset));
     RawOffset := RawAddress(ImportDescriptor^.ImportNameTable);
     PFunctionsAddress := PDWORD(RawData + RawOffset);
     while PFunctionsAddress^ <> 0 do begin
       ImportAddress := PFunctionsAddress^;
       FDelayImports.Add(GetImportedFunctionName(DllName, ImportAddress));
       Inc(PFunctionsAddress);
     end;
   end;
   Inc(ImportDescriptor);
 end;
end;

procedure TPEImage.LoadExports;
var
 Offset, RawOffset: Cardinal;
 ExportDirectory: PImageExportDirectory;
 I: DWORD;
 PFunctionsAddress: PDWORD;

 function FindNameForOrdinal (Ordinal: Word): string;
 var
   J, K: DWORD;
   POrdinals: PWordArray;
   PNames: PDwordArray;
   PName: DWORD;
 begin
   Result := "";
   POrdinals := PWordArray(RawData +
     RawAddress(Integer(ExportDirectory^.AddressOfNameOrdinals)));
   K := DWORD(-1);
   for J:=1 to ExportDirectory^.NumberOfNames do
     if POrdinals^[J-1] = Ordinal then begin
       K := J-1;
       Break;
     end;
   if K = DWORD(-1) then
     Exit;
   PNames := PDwordArray(RawData +
     RawAddress(Integer(ExportDirectory^.AddressOfNames)));
   PName := PNames^[K];
   Result := StrPas(RawData + RawAddress(PName));
 end;

begin
 Offset := FNtHeaders^.OptionalHeader.
       DataDirectory[IMAGE_DIRECTORY_ENTRY_EXPORT].VirtualAddress;
 if Offset = 0 then
   Exit;
 RawOffset := RawAddress(Offset);
 ExportDirectory := PImageExportDirectory(RawData + RawOffset);
 Offset := Cardinal(ExportDirectory^.AddressOfFunctions);
 RawOffset := RawAddress(Offset);
 PFunctionsAddress := PDWORD(RawData + RawOffset);
 for I:=1 to ExportDirectory^.NumberOfFunctions do begin
   if PFunctionsAddress^ <> 0 then
     FExports.AddObject(FindNameForOrdinal(Word(I-1)),
       TObject(PFunctionsAddress^));
   Inc(PFunctionsAddress);
 end;
end;

procedure TPEImage.LoadImports;
var
 RawOffset: Integer;
 ImportDescriptor: PIMAGE_IMPORT_DESCRIPTOR;
 DllName: string;
 PFunctionsAddress: PDWORD;
 ImportAddress: DWORD;
begin
 with NtHeaders^.OptionalHeader.DataDirectory[
     IMAGE_DIRECTORY_ENTRY_IMPORT] do begin
   if (VirtualAddress = 0) or (Size = 0) then
     Exit;
   RawOffset := RawAddress(VirtualAddress);
 end;
 ImportDescriptor := PIMAGE_IMPORT_DESCRIPTOR(RawData + RawOffset);
 while ImportDescriptor^.Name <> 0 do begin
   RawOffset := RawAddress(ImportDescriptor^.Name);
   if RawOffset <> 0 then
     DllName := UpperCase(StrPas(RawData + RawOffset));
   if ImportDescriptor^.Characteristics = 0 then
     RawOffset := RawAddress(ImportDescriptor^.FirstThunk)
   else
     RawOffset := RawAddress(ImportDescriptor^.Characteristics);
   PFunctionsAddress := PDWORD(RawData + RawOffset);
   while PFunctionsAddress^ <> 0 do begin
     ImportAddress := PFunctionsAddress^;
     FImports.Add(GetImportedFunctionName(DllName, ImportAddress));
     Inc(PFunctionsAddress);
   end;
   Inc(ImportDescriptor);
 end;
end;



 
Игорь Шевченко ©   (2006-12-08 16:59) [18]

procedure TPEImage.LoadModuleReferences(Mapper: THSFileMapper);
var
 IAddr: DWORD;
 PImport: PIMAGE_IMPORT_DESCRIPTOR;
 PModName: PChar;
begin
 with NtHeaders^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT] do
   if Size <> 0 then begin
     IAddr := RawAddress(VirtualAddress);
     PImport := PIMAGE_IMPORT_DESCRIPTOR(Mapper.Map + IAddr);
     while PImport^.Name <> 0 do begin
       PModName := Mapper.Map + RawAddress(PImport^.Name);
       FModuleReferences.Add(PModName);
       FImportLibraries.Add(UpperCase(PModName));
       Inc(PImport);
     end;
   end;
end;

procedure TPEImage.LoadSections(Mapper: THSFileMapper);
var
 PSection: PImageSectionHeader;
 I: Integer;
begin
 PSection := PImageSectionHeader(DWORD(@(NtHeaders^.OptionalHeader)) +
       NtHeaders^.FileHeader.SizeOfOptionalHeader);
 for I:=1 to NtHeaders^.FileHeader.NumberOfSections do begin
   FSections.Add (PSection);
   Inc(PSection);
 end;
end;

function TPEImage.RawAddress(VirtualAddress: Cardinal): Cardinal;
var
 I: Integer;
 Position: Cardinal;
begin
 Result := 0;
 for I := 0 to Pred(FSections.Count) do
   if (Sections[I].VirtualAddress <= VirtualAddress) and
      (VirtualAddress < Sections[I].VirtualAddress +
       Sections[I].SizeOfRawData) then begin
     Position := VirtualAddress - Sections[I].VirtualAddress;
     Result := Sections[I].PointerToRawData + Position;
     Break;
   end;
end;

end.


 
Игорь Шевченко ©   (2006-12-08 16:59) [19]

unit HSDosImage;

interface
uses
 Windows, HsFileMapper, SysUtils;

type
 PIMAGE_DOS_HEADER = ^IMAGE_DOS_HEADER;
 
 TDosImage = class
   FDosHeader: PIMAGE_DOS_HEADER;
 private
   FFileName: string;
   function GetRawData: PChar;
 protected
   procedure Load (Mapper: THSFileMapper); virtual;
 public
   constructor Create (const AFileName: string); virtual;
   constructor CreateAndLoad (Mapper: THSFileMapper); virtual;
   function EpCode: PByteArray; virtual;
   property DosHeader: PIMAGE_DOS_HEADER read FDosHeader;
   property FileName: string read FFileName;
   property RawData: PChar read GetRawData;
 end;

implementation

{ TDosImage }

constructor TDosImage.Create(const AFileName: string);
begin
 FFileName := AFileName;
end;

constructor TDosImage.CreateAndLoad(Mapper: THSFileMapper);
begin
 Create (Mapper.FileName);
 Load (Mapper);
end;

function TDosImage.EpCode: PByteArray;
begin
 Result := nil;
end;

function TDosImage.GetRawData: PChar;
begin
 Result := PChar(FDosHeader);
end;

procedure TDosImage.Load(Mapper: THSFileMapper);
begin
 FDosHeader := PIMAGE_DOS_HEADER(Mapper.Map);
end;

end.


 
Игорь Шевченко ©   (2006-12-08 17:00) [20]

unit HSImageUtils;
interface

type
 THSBinaryType = (hsbtError, hsbtWin32, hsbtWin16, hsbtDos16, hsbtCom,
   hsbtVxd, hsbtW3, hsBtUnknown);
 THSSubsystem = (hsssUnknown, hsssGUI32, hsssCon32, hsssNative, hsssDotNet,
   hsssWin16, hsssDos, hsssConPosix);

 THSVersionInfo = packed record
   Version: string;
   CompanyName: string;
   Description: string;
   Comment: string;
 end;

function HSGetBinaryType (const FileName: string): THSBinaryType;
function HSBinaryTypeToString (Value: THSBinaryType): string;
function HSSubSystemToString (Value: THSSubSystem): string;
procedure HSGetVersionInfo (const FileName: string; var Info: THSVersionInfo);

implementation
uses
 Windows, SysUtils, HSFileMapper;

const
 HSBinaryTypeStrings : array[THSBinaryType] of string = (
   "Error", "Win32", "Win16", "MSDOS", "COM", "VxD", "W3", "Unknown"
 );
 HSSubSystemStrings : array[THSSubsystem] of string = (
   "Unknown", "GUI32", "Con32", "Native", ".Net", "Win16", "DOS", "PosIX"
 );
 IMAGE_W3_SIGNATURE                     = $3357;      { W3 }

function HSGetBinaryType (const FileName: string): THSBinaryType;
type
 PIMAGE_DOS_HEADER = ^IMAGE_DOS_HEADER;
 PIMAGE_NT_HEADERS = PImageNtHeaders;
var
 Mapper: THSFileMapper;
 DosHeader: PIMAGE_DOS_HEADER;
 FileHeader: PIMAGE_NT_HEADERS;
begin
 Result := hsbtError;
 Mapper := THSFileMapper.Create (FileName);
 try
   if (Mapper.Map[0] <> "M") or (Mapper.Map[1] <> "Z") then begin
     if UpperCase(ExtractFileExt(FileName)) = ".COM" then
       Result := hsbtCom;
     Exit;
   end else if Mapper.FileSize >= SizeOf(IMAGE_DOS_HEADER) then begin
     DosHeader := PIMAGE_DOS_HEADER(Mapper.Map);
     if (DosHeader^._lfanew > $40) { Matt Pietrek } and
        (DWORD(DosHeader^._lfanew) < Mapper.FileSize - SizeOf(WORD)) then begin
       FileHeader := PIMAGE_NT_HEADERS(DWORD(DosHeader) +
                                       DWORD(DosHeader^._lfanew));
       if FileHeader^.Signature = IMAGE_NT_SIGNATURE then
         Result := hsbtWin32
       else if WORD(FileHeader^.Signature) = IMAGE_OS2_SIGNATURE then
         Result := hsbtWin16
       else if WORD(FileHeader^.Signature) = IMAGE_VXD_SIGNATURE then
         Result := hsbtVxd
       else if WORD(FileHeader^.Signature) = IMAGE_W3_SIGNATURE then
         Result := hsbtW3
       else
         Result := hsbtUnknown;
     end else
       Result := hsbtDos16;
   end;
 finally
   Mapper.Free;
 end;
end;

function HSBinaryTypeToString (Value : THSBinaryType) : String;
begin
 Result := HSBinaryTypeStrings[Value];
end;

function HSSubSystemToString (Value: THSSubSystem): string;
begin
 Result := HSSubSystemStrings[Value];
end;

type
 PVerLang = ^TVerLang;
 TVerLang = record
   Charset : Word;
   LangID  : Word;
 end;

procedure HSGetVersionInfo (const FileName: string; var Info: THSVersionInfo);
var
 InfoSize: DWORD;
 Dummy: DWORD;
 VerInfo: Pointer;
 FileInfo: PVSFixedFileInfo;
 VTranslation: PVerLang;
 VerKey, LangID: string;
 VerDesc: PChar;
begin
 Info.Version := "";
 Info.CompanyName := "";
 Info.Description := "";
 Info.Comment := "";
 InfoSize := GetFileVersionInfoSize(PChar(FileName), Dummy);
 if InfoSize = 0 then
   Exit;
 GetMem (VerInfo, InfoSize);
 try
   if not GetFileVersionInfo(PChar(FileName), 0, InfoSize, VerInfo) then
     Exit;
   VerQueryValue (VerInfo, "\", Pointer(FileInfo), Dummy);
   Info.Version := Format("%d.%d.%d.%d", [FileInfo.dwFileVersionMS shr 16,
     FileInfo.dwFileVersionMS and $FFFF, FileInfo.dwFileVersionLS shr 16,
     FileInfo.dwFileVersionLS and $FFFF]);
   VerQueryValue( VerInfo, "\VarFileInfo\Translation", Pointer(VTranslation),
     Dummy);
   if Dummy = 4 then begin
     LangID := Format("%.4x%.4x", [VTranslation^.CharSet,
       VTranslation^.LangID]);
     VerKey := "\StringFileInfo\"+LangID+"\FileDescription";
     if VerQueryValue (VerInfo, PChar(VerKey), Pointer(VerDesc), Dummy) and
         (Dummy <> 0) then
       Info.Description := VerDesc;
     VerKey := "\StringFileInfo\"+LangID+"\CompanyName";
     if VerQueryValue (VerInfo, PChar(VerKey), Pointer(VerDesc), Dummy) and
         (Dummy <> 0) then
       Info.CompanyName := VerDesc;
     VerKey := "\StringFileInfo\"+LangID+"\Comments";
     if VerQueryValue (VerInfo, PChar(VerKey), Pointer(VerDesc), Dummy) and
         (Dummy <> 0) then
       Info.Comment := VerDesc;
   end;
 finally
   FreeMem(VerInfo);
 end;
end;

end.


 
Riply ©   (2006-12-08 20:07) [21]

>[20] Игорь Шевченко ©   (08.12.06 17:00)
Спасибо ! Работает как часы. Здорово !


 
Riply ©   (2006-12-09 06:38) [22]

Доклад о результатах.
В одном экземпляре. :)
Вообщем-то это все - исковерканный код Игоря Шевченко.
Тестировалось под XP SP2.
ZwQuerySystemInformation и NtQuerySystemInformation перехватывались по
Дж. Рихтеру (внедрение DLL).
P.S. Если, вдруг, кто будет тестировать - у юнитов надо убрать префикс "Shv_"

unit DetectHooked;

interface
uses
SysUtils,
Windows,
Classes,
Shv_HsPEImage;

type
PSysCallData = ^TSysCallData;
TSysCallData = array[0..13] of Byte;

function MakeRealQS(const SysCallData: TSysCallData; const cbSize: DWord): Pointer;
function IsNtFunctionHookedEx(PEImage: TPEImage; hMod: HMODULE; const ProcName: string; var ExprtInd: integer; var SysCall: TSysCallData): Boolean;
function IsNtFunctionHooked(const FileName, ProcName: string; var ExpFound: Boolean; var SysCall: TSysCallData): Boolean;
function IsFunctionHooked(const FileName, ProcName: string): Boolean;

implementation
uses
Dialogs,
Shv_NtDll, Shv_NtStatus;

function MakeRealQS(const SysCallData: TSysCallData; const cbSize: DWord): Pointer;
var
OldProtect: DWord;
begin
Result := VirtualAlloc(nil, cbSize, MEM_COMMIT, PAGE_READWRITE);
if Assigned(Result) then
 begin
  Move(SysCallData, Result^, SizeOf(SysCallData));
  if not VirtualProtect(Result, SizeOf(SysCallData), PAGE_EXECUTE, OldProtect) then
   begin
    VirtualFree(Result, cbSize, MEM_DECOMMIT);
    Result:= nil;
   end;
 end;
end;

function FindNearestDll(const pProcAddr: Pointer; var hMod: HMODULE; var DllName: string): Boolean;
var
ModuleArr: SYSTEM_MODULE_ARR;
i: integer;
List: TStringList;
Ind: integer;
begin
Result:= False;
if Rtl_QueryProcessModules(GetCurrentProcessId, ModuleArr) = STATUS_SUCCESS then
 begin
  List:= TStringList.Create;
  try
   for i:= Low(ModuleArr) to High(ModuleArr) do
    with ModuleArr[i] do List.AddObject(ImageName, Base);
   List.SortByObj;
   List.FindObjSortedH(pProcAddr, Ind);
   if Ind <> - 1 then
    begin
     DllName:= List[Ind];
     hMod:= DWord(List.Objects[Ind]);
     Result:= True;
    end
  finally
   List.Free;
  end;
 end;
end;

function DetectDllName(const pProcAddr: Pointer; var hMod: HMODULE; var DllName: string): Boolean;
var
CurrCall, SysCall: TSysCallData;
PEImage: TPEImage;
pRVAData: Pointer;
begin
Result:= False;
if not FindNearestDll(pProcAddr, hMod, DllName) then Exit;

if not FileExists(DllName) then
 begin
  ShowMessage("Can""t to find file" + #13#10 + DllName);
  Exit;
 end;

Move(pProcAddr^, CurrCall, SizeOf(CurrCall));
PEImage:= TPEImage.Create(DllName);
try
 pRVAData:= PEImage.GetRVAData(DWord(pProcAddr) - hMod);
 if pRVAData <> nil then
  begin
   Move(pRVAData^, SysCall, SizeOf(SysCall));
   Result:= CompareMem(@CurrCall, @SysCall, SizeOf(CurrCall));
  end;
finally
 PEImage.Free;
end;
end;

function IsNtFunctionHookedEx(PEImage: TPEImage; hMod: HMODULE; const ProcName: string; var ExprtInd: integer; var SysCall: TSysCallData): Boolean;
var
CurrCall: TSysCallData;
cbProcAddr, ProcOffset, hDll: DWord;
DllName: string;
begin
Result:= True;
cbProcAddr := DWord(GetProcAddress(hMod, PChar(ProcName)));
if cbProcAddr <> 0 then
 with PEImage do
  try
   ExprtInd := ImageExports.IndexOf(ProcName);
   if ExprtInd <> -1 then
    begin
     ProcOffset := Integer(ImageExports.Objects[ExprtInd]);
     Move(GetRVAData(ProcOffset)^, SysCall, Length(SysCall));
    end
   else Exit;

   with NtHeaders.OptionalHeader do
    if ImageBase = hMod then
     if (cbProcAddr > ImageBase) and (cbProcAddr <= ImageBase + SizeOfCode) then
      begin
       Move(Pointer(cbProcAddr)^, CurrCall, SizeOf(CurrCall));
       Result := not CompareMem(@SysCall, @CurrCall, SizeOf(SysCall));
      end;

  if Result then
   if DetectDllName(Pointer(cbProcAddr), hDll, DllName)
    then ShowMessage("You are is hooked by" + #13#10 + DllName + " = " + IntToStr(hDll));

  finally
  end
else ExprtInd:= -1;
end;

function IsNtFunctionHooked(const FileName, ProcName: string; var ExpFound: Boolean; var SysCall: TSysCallData): Boolean;
var
PEImage: TPEImage;
ExprtInd: integer;
begin
PEImage:= TPEImage.Create(FileName);
try
 Result:= IsNtFunctionHookedEx(PEImage, GetModuleHandle(PChar(FileName)), ProcName, ExprtInd, SysCall);
 ExpFound:= ExprtInd <> -1;
finally
 PEImage.Free;
end;
end;

function IsFunctionHooked(const FileName, ProcName: string): Boolean;
var
SysCall: TSysCallData;
PEImage: TPEImage;
ExprtInd: integer;
begin
PEImage:= TPEImage.Create(FileName);
try
 Result:= IsNtFunctionHookedEx(PEImage, GetModuleHandle(PChar(FileName)), ProcName, ExprtInd, SysCall);
finally
 PEImage.Free;
end;
end;

end.


 
Riply ©   (2006-12-09 06:40) [23]

Извините, забыла выделить "код"

Дополнения:

TPEImageHlp = class Helper for TPEImage
 public
  function GetRVAData(AVirtualAddress: ULONG): Pointer;
 end;

function TPEImageHlp.GetRVAData(AVirtualAddress: ULONG): Pointer;
var
I: Integer;
begin
Result := nil;
for I:= 0 to Pred(FSections.Count) do
 with Sections[I]^ do
  if (VirtualAddress <= AVirtualAddress) and ((VirtualAddress + Misc.VirtualSize) > AVirtualAddress) then
   begin
    Result:= FMapper.Map + PointerToRawData + (AVirtualAddress - VirtualAddress);
    Break;
   end;
end;

type
SYSTEM_MODULE_ARR = array of SYSTEM_MODULE_INFORMATION;

function Rtl_QueryProcessModules(const ProcID: DWord; var SysModuleArr: SYSTEM_MODULE_ARR): NTSTATUS;
var
Ind: integer;
pDbgBuffer: PRTL_DEBUG_INFORMATION;
begin
pDbgBuffer:= RtlCreateQueryDebugBuffer(0, False);
if pDbgBuffer <> nil then
 try
  Result:= RtlQueryProcessDebugInformation(ProcID, PDI_MODULES, pDbgBuffer);
  if Result = STATUS_SUCCESS then
   with pDbgBuffer.ModuleInformation^ do
    begin
     Ind:= 1;
     if DWord(Length(SysModuleArr)) <> Count - 1 then SetLength(SysModuleArr, Count - 1);
     if Count > 1 then Move(Data[Ind], SysModuleArr[0], (Count - 1) * SizeOf(SYSTEM_MODULE_INFORMATION));
    end;
 finally
  RtlDestroyQueryDebugBuffer(pDbgBuffer);
 end
else Result:= NTSTATUS(STATUS_NO_MEMORY); // Different definitions from Windows and Shevchenko
end;

type
TObjStrings = class Helper for TStrings
 procedure SortByObj;
 function FindObjSortedH(const Obj: Pointer; var Index: Integer): Boolean;
end;

procedure TObjStrings.SortByObj;

procedure Quick_Sort(iLo, iHi: Integer);
var
 iL, iH: Integer;
 Mid: DWord;
begin
 iL := iLo;
 iH := iHi;
 Mid := DWord(Objects[(iL + iH) shr 1]);
 repeat
  while DWord(Objects[iL]) < Mid do Inc(iL);
  while DWord(Objects[iH]) > Mid do Dec(iH);
   if iL <= iH then
    begin  
     Exchange(iL, iH);
     Inc(iL);
     Dec(iH);
   end;
 until iL > iH;
 if iH > iLo then Quick_Sort(iLo, iH);
 if iL < iHi then Quick_Sort(iL, iHi);
end;

begin
if Count > 1 then Quick_Sort(0, Count - 1);
end;

function TObjStrings.FindObjSortedH(const Obj: Pointer; var Index: Integer): Boolean;
var
dObj: DWord;
L, H, I: Integer;
begin
dObj:= DWord(Obj);
L := 0;
H := Count - 1;
while L <= H do
 begin
  I := (L + H) shr 1;
  if DWord(Objects[I]) > dObj then H := I - 1 else L := I + 1;
 end;
if H > -1 then Result := Objects[H] = Obj else Result:= False;
Index := H;
end;



 
Riply ©   (2006-12-09 06:41) [24]

И сам тест:

unit TempTest;

interface
uses
SysUtils,
Classes,
Windows;

function NtDllUnHookedProcessList(List: TStrings): Boolean;

implementation
uses
Dialogs,
Shv_HsPEImage, Shv_NtDll, Shv_HsNtDef, Shv_NtStatus,
DetectHooked;

function RealQueryListInformation(InfoClass: Integer; const pRealAddr: Pointer; var rc: NTSTATUS; var ReturnLength: DWORD): Pointer;
var
ListSize: Integer;
FRealQuerySystemInformation: TNtQuerySystemInformation;
begin
ListSize := $400;
@FRealQuerySystemInformation:= pRealAddr;
GetMem(Result, ListSize);
rc := FRealQuerySystemInformation(InfoClass, Result, ListSize, @ReturnLength);
while rc = STATUS_INFO_LENGTH_MISMATCH do begin
  FreeMem(Result);
  ListSize := ListSize * 2;
  GetMem(Result, ListSize);
  rc := FRealQuerySystemInformation(InfoClass, Result, ListSize, @ReturnLength);
end;
if rc <> STATUS_SUCCESS then begin
  FreeMem(Result);
  Result := nil;
end;
end;

function IsSysQueryInfoHooked(const ProcName: string; List: TStrings): Boolean;
const
SDllPath = "%SystemRoot%\system32\ntdll.dll";
var
pSysProcNt: PSYSTEM_PROCESSES_NT4;
SysCall: TSysCallData;
Dummy: ULONG;
rc: NTSTATUS;
ExpFound: Boolean;
cbSize: DWord;
pTmp, pRealAddr: Pointer;
DllPath: ZString;
begin
Result:= False;
if ExpandEnvironmentStringsA(SDllPath, DllPath, SizeOf(DllPath)) = 0 then Exit;
Result:= IsNtFunctionHooked(DllPath, ProcName, ExpFound, SysCall);
if Result then
 begin
  ShowMessage("NtDll is Hooked !");
  List.Add(ProcName);
  if ExpFound then
   begin
    cbSize:= $1000;
    pRealAddr:= MakeRealQS(SysCall, cbSize);
    if pRealAddr <> nil then
     try
       pTmp:= nil;
       pSysProcNt:= RealQueryListInformation(SystemProcessesAndThreadsInformation, pRealAddr, rc, Dummy);
       if pSysProcNt <> nil then
        try
         pTmp:= pSysProcNt;
         while True do
          begin
           List.AddObject(pSysProcNt.ProcessName.Buffer, Pointer(pSysProcNt.ProcessId));
           if pSysProcNt.NextEntryDelta = 0 then Break;
           Inc(Integer(pSysProcNt), pSysProcNt.NextEntryDelta);
          end;
        finally
         ReallocMem(pTmp, 0);
        end;
     finally
      VirtualFree(pRealAddr, cbSize, MEM_DECOMMIT);
     end;
   end
  else ShowMessage(ProcName + " was not found on the Export table");
end;
end;

function NtDllUnHookedProcessList(List: TStrings): Boolean;
begin
List.Clear;    
Result:= IsSysQueryInfoHooked("ZwQuerySystemInformation", List)
         or IsSysQueryInfoHooked("NtQuerySystemInformation", List);
end;

end.


 
Anatoly Podgoretsky ©   (2006-12-09 13:14) [25]

> Riply  (09.12.2006 6:38:22)  [22]

Также забыла привести результаты, оставила это дело читателям :-)


 
Leonid Troyanovsky ©   (2006-12-09 13:59) [26]


> Riply ©   (07.12.06 20:02)  

> Функцию найти удается, но ее адрес (вот негодяй) не хочет

By Peter Below

http://groups.google.com/group/fido7.ru.delphi/msg/a41c4631b22b034c

--
Regards, LVT.


 
Riply ©   (2006-12-09 17:08) [27]

>[25] Anatoly Podgoretsky ©   (09.12.06 13:14)
> Также забыла привести результаты, оставила это дело читателям :-)

Привожу результаты :)

NtDll is Hooked !

Hooked function :   ZwQuerySystemInformation
Hooked by :         E:\Delphi Source\Delphi 2006\Library\Inject\ReplaceAPI\jacked.dll
Module ID :         151126016
ProcOffset:         57770
Hided process :     winlogon.exe
Hided Process ID:   728

Real process list:
System
smss.exe
csrss.exe
winlogon.exe
services.exe
lsass.exe
svchost.exe
svchost.exe
svchost.exe
svchost.exe
svchost.exe
CCSETMGR.EXE
CCEVTMGR.EXE
ibguard.exe
mdm.exe
NAVAPSVC.EXE
NPROTECT.EXE
SAVSCAN.EXE
NOPDB.exe
symlcsvc.exe
wdfmgr.exe
SymWSC.exe
ibserver.exe
alg.exe
explorer.exe
Nessenok.exe
LvAgent.exe
CCAPP.EXE
ctfmon.exe
bds.exe
Nessi.exe


 
Riply ©   (2006-12-09 18:47) [28]

А что перехватывают "опытные люди", чтобы спрятать сервис ?
EnumServicesStatus, EnumServicesStatusEx или есть
"поглубже" функции ?


 
Игорь Шевченко ©   (2006-12-11 10:35) [29]


> А что перехватывают "опытные люди", чтобы спрятать сервис
> ?


а нафига его прятать ?


 
Riply ©   (2006-12-11 13:59) [30]

>Игорь Шевченко ©   (11.12.06 10:35) [29]
>а нафига его прятать ?
А я не прятать, а находить собралась :)
Просто пробовала определять перехвачена ф-ия или нет и на других библиотека ( не ntdll ) - вроде работает. Вот и ищу практическое применение  :)


 
Игорь Шевченко ©   (2006-12-11 14:07) [31]

Riply ©   (11.12.06 13:59) [30]


> А я не прятать, а находить собралась :)


Тогда тебе прямой путь изучать
http://www.microsoft.com/technet/sysinternals/Security/RootkitRevealer.mspx
они много чего находят _спрятанного_


 
Riply ©   (2006-12-11 17:38) [32]

> [31] Игорь Шевченко ©   (11.12.06 14:07)
>Тогда тебе прямой путь изучать
>http://www.microsoft.com/technet/sysinternals/Security/RootkitRevealer.mspx
>они много чего находят _спрятанного_

Отчет о попытке изучения RootkitRevealer.exe :))
Первые результаты:
1. После первого сканирования системы, при попытке сохранить результаты
   "выполнил недопустимую операцию" ( повторное прошло удачно )
2. Создал сервис QUOYXLAORQC.exe, поместив его в C:\WINDOWS\Temp (?!)
  и, почему - то, не убрал за собой (сервис остался зарегистрированным)
3. Создал драйвер, C:\WINDOWS\system32\Drivers\RKREVEAL150.SYS
   который находит SystemQueryInformation(..SystemModuleInformation..
   и... не показывает (?!) Explorer


 
Игорь Шевченко ©   (2006-12-11 17:45) [33]

Riply ©   (11.12.06 17:38) [32]

Но тем не менее, находит он много интересного. А то, что драйверы не показываются - так они удаляются после загрузки.



Страницы: 1 вся ветка

Форум: "Начинающим";
Текущий архив: 2006.12.31;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.63 MB
Время: 0.031 c
15-1165855670
Гоблин
2006-12-11 19:47
2006.12.31
MSSQL - посоветуйте книжку


2-1165837189
YuMB
2006-12-11 14:39
2006.12.31
Как программно выключить компьютер?


2-1165911751
Aks13
2006-12-12 11:22
2006.12.31
Программно нажать кнопку на форме


2-1165934770
Ezorcist
2006-12-12 17:46
2006.12.31
как запихнуть картинку в файл ресурсов?


2-1166105483
Dfe
2006-12-14 17:11
2006.12.31
Int64





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский