program EnumModules;

uses
  {$I Build.inc}
  JwaNtStatus, JwaWinType,
  windows, JwaNative, sysutils, inifiles,
  codesitelogging;

function GetDeviceName(mappedLetter: char): string;
var
  buffer    : PChar;
  bufferSize: integer;
  device    : string;
begin
  Result := '';
  device := mappedLetter + ':';
  bufferSize := 256;
  GetMem(buffer, bufferSize * SizeOf(char));
  try
    repeat
      if QueryDosDevice(PChar(device), buffer, bufferSize-1) = 0 then begin
        if GetLastError <> ERROR_INSUFFICIENT_BUFFER then
          break //repeat
        else begin
          FreeMem(buffer);
          bufferSize := 2 * bufferSize;
          GetMem(buffer, bufferSize * SizeOf(char));
        end;
      end else begin
        result := string(buffer);
        break; //repeat
      end;
    until false;
  finally FreeMem(buffer); end;
end;

function NtSuccess(AStatus: TNtStatus): Boolean;
begin
  Result := AStatus >= 0;
end;

function Nativetranslate(Filename:String):String;
var
  DriveBits: set of 0..25;
  x,DriveNum: Integer;
  szname : string;
begin
  result := '';
  Integer(DriveBits) := GetLogicalDrives;
  for DriveNum := 0 to 25 do begin
    if not (DriveNum in DriveBits) then Continue;
    szname := GetDeviceName(Char(DriveNum + Ord('a')));
    x := pos(szName,filename);
    if x >= 1 then result := StringReplace(filename, szName, Uppercase(Char(DriveNum + Ord('a')) + ':'),[rfReplaceAll,rfIgnoreCase]);
  end;
end;

Function GetModuleFileNameByAddres(ph:THandle; Address : DWord):String;
var
  mSize,back: dword;
  mPtr: pointer;
  St: NTStatus;
begin
  result := '';
  mSize := 512;
  mPtr := AllocMem(mSize);
  St := NtQueryVirtualMemory(ph, Pointer(Address), MemorySectionName, mPtr,mSize,@back);
  if NtSuccess(st) then result :=strpas(PMEMORY_SECTION_NAME(mPtr).SectionFileName.Buffer);
  FreeMem(mPtr,mSize);
end;

function GetModuleSize(ph:THandle; ModuleHandle:DWord):DWord;
var
  IDH         : TImageDosHeader;
  INH         : TImageNtHeaders;
  Dwread      : DWord;
begin
  result := 0;

  { Read DosHeader }
  if not ReadProcessMemory(ph,Pointer(ModuleHandle), @IDH, Sizeof(TImageDosHeader), Dwread) and
    (dwRead = SizeOf(TImageDosHeader)) then begin
    {$IFDEF DebugMode}codesite.SendWinError('ReadProcessMemory TImageDosHeader',getlasterror);{$ENDIF}
    exit;
  end;

  { Check DosSignature }
  if (IDH.e_magic <> IMAGE_DOS_SIGNATURE) then begin
    {$IFDEF DebugMode}codesite.Send('Not IMAGE_DOS_SIGNATURE ');{$ENDIF}
    exit;
  end;

  { Read NTHeader }
  if not ReadProcessMemory(ph,Pointer(ModuleHandle+DWord(IDH._lfanew)), @INH, Sizeof(TImageNtHeaders), Dwread) and
    (dwRead = SizeOf(TImageNtHeaders)) then begin
    {$IFDEF DebugMode}codesite.SendWinError('ReadProcessMemory TImageNtHeaders',getlasterror);{$ENDIF}
    exit;
  end;

  { Check PE Header and get sizeofimage }
  if (INH.Signature = IMAGE_NT_SIGNATURE) then exit(INH.OptionalHeader.SizeOfImage);
end;

Procedure EnumModulesByMemory(ph:THandle);
var
  Info: TSystemBasicInformation;
  MemInfo : TMemoryBasicInformation;
  Base, Lower, Highest : DWord;
  {$IFDEF LogInternal} txt : string; {$ENDIF}
  ModuleList  : TStringHash;
  ModuleName  : String;
  ModuleSize  : DWord;
begin

  ModuleList :=  TStringHash.Create(500);
  try

    { Get Memori Information for UserSpace Address }
    if NtSuccess(NtQuerySystemInformation(SystemBasicInformation, @Info, sizeof(TSystemBasicInformation), nil)) then begin
      Lower := Info.LowestUserAddress;
      Highest := Info.HighestUserAddress;
      Highest := Highest and $FFFFF000;
    end else begin
      Lower := $00010000;
      Highest := $7FFFF000;
    end;

    { Enum All Memory Region }
    Base := Lower;
    while Base<Highest do begin

      { Get MEMORY_BASIC_INFORMATION}
      if not NtSuccess(NtQueryVirtualMemory(ph, Ptr(Base), MemoryBasicInformation,
        @MemInfo, sizeof(TMemoryBasicInformation),nil)) then begin
        {$IFDEF DebugMode}codesite.SendWinError('NtQueryVirtualMemory MemoryBasicInformation',getlasterror);{$ENDIF}
        break;
      end;

      with MemInfo do begin

        {$IFDEF LogInternal}
        txt := ' [' + inttohex(Cardinal(BaseAddress),8) + '-' + IntToHex(Cardinal(BaseAddress) + RegionSize, 8)+']';

        if State = MEM_COMMIT then Txt := Txt + ' [commited]'
        else if State = MEM_RESERVE then Txt := Txt + ' [reserved]'
        else if State = MEM_Free   then Txt := Txt + ' [free]';
        if Type_ = MEM_IMAGE  then Txt := Txt + ' (image)'
        else if Type_ = MEM_MAPPED  then Txt := Txt + ' [mapped]'
        else if Type_ = MEM_PRIVATE   then Txt := Txt + ' [private]';

        codesite.Send(csmblue,'%s',[Txt]);
        {$ENDIF}



        {Just process MEM_IMAGE region}
        if (Type_ = MEM_IMAGE) then begin

          { Get Modulename }
          Modulename := GetModuleFileNameByAddres(ph,Cardinal(BaseAddress));


          { check if this module alreadi added }
          if ModuleList.ValueOf(Modulename) = -1 then begin

            { Get ModuleSize }
            ModuleSize := GetModuleSize(ph,Cardinal(BaseAddress));
            {if failed just simple use regionsize isntead (maybe the malware free the header)
            if ModuleSize=0 then ModuleSize := RegionSize;

            {$IFDEF LogInternal}
            codesite.Send(csmgreen,'Modulename',Nativetranslate(Modulename));
            codesite.Send(csmnote,'ModuleSize',inttohex(Cardinal(ModuleSize),8));
            codesite.Send(csmnote,'BaseAddress',inttohex(Cardinal(BaseAddress),8));
            {$ENDIF}

            ModuleList.Add(Modulename,Cardinal(BaseAddress));
          end;

        end;

        base := Dword(BaseAddress)+RegionSize;
      end;
    end;

  finally
    ModuleList.Free;
  end;
end;

begin
  try
    EnumModulesByMemory(Thandle(-1));
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.

[培训]内核驱动高级班，冲击BAT一流互联网大厂工作，每周日13:00-18:00直播授课