Read strings from .exe files(Like Strings.exe) in Delphi

Question

I want to write a program for read/extract all of the valid strings in a .exe files (For example: "This program must be run under Win" or "MZ"), Exactly like Strings.exe of sysinternals . Actually i want to scan a .exe file and if that contain special string value such as "ekrn.exe" or "Filrefox.exe" then detect that file as a suspicious file (Killing ekrn.exe or inject malcode to firefox.exe ).

I wrote the following code in Delphi :

const
  TargetName = 'E:\AntiDebugg.exe';
var
  hFile: THandle;
  tmp: AnsiString;
  dwFileSize, lChar, lSearch: Integer;
  dwNumRead: Cardinal;
  dwBuffer: array of AnsiChar;
begin
  mmo1.Clear;

  hFile := CreateFileA(TargetName, GENERIC_READ, FILE_SHARE_READ, nil,
    OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);

  dwFileSize := GetFileSize(hFile, nil);
  SetLength(dwBuffer, dwFileSize);

  lChar := 0;
  lSearch := 0;

  while lChar <= dwFileSize do
  begin
    ReadFile(hFile, dwBuffer[lChar], SizeOf(dwBuffer), dwNumRead, nil);
    while dwBuffer[lChar] <> '' do
    begin
      tmp := tmp + dwBuffer[lChar];
      Inc(lChar, 1);
    end;
    lSearch := 0;
    Inc(lChar, 1);
  end;
  mmo1.Text := (tmp);
  CloseHandle(hFile);

The result of running my code is (A small piece):

MZPےے¸@؛´   ح!¸Lح!گگThis program must be run under Win32
$7PEL
%0فQà´أ\
¤"0Bگب.textd­ .itext| .data`@.bssطN.idata\
@.didataب@.tls.rdata@.reloc¤"@.rsrc@@@Boolean@alseTrueSystem4@AnsiCharP@    Charےh@Integerے€@Byteک@Wordے°@Pointerؤ@Cardinalےےےà@    NativeIntےےےü@
NativeUIntے@ShortStringے,@  PAnsiChar0@D@stringT@TClassŒ@h@HRESULTے€@TGUID

But this isn't my desired result and my desired result is :

MZP
This program must be run under Win32
.text
`.itext
`.data
.bss
.idata
.didata
.tls
.rdata
@.reloc
B.rsrc
Boolean
False
True
System
AnsiChar
Char
Integer
Byte
Word
Pointer
Cardinal
NativeInt
NativeUInt
ShortString
PAnsiChar0
string
TClass
HRESULT
TGUID

• In this example the AntiDebugg.exe compiled by Delphi .

The result of Strings.exe for strings of "AntiDebugg.exe"

Any idea ? What should i to do ?

Answer 1

Try something like this:

const
  TargetName = 'E:\AntiDebugg.exe';
  MinStringLength = 2;

var
  hFile: THandle;
  hMapping: THandle;
  pView: Pointer;  
  dwFileSize: DWORD;
  pCurrent, pEOF, pStart: PAnsiChar;
  iLen: Integer;
begin
  mmo1.Clear;

  hFile := CreateFile(TargetName, GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
  if hFile = INVALID_HANDLE_VALUE then RaiseLastOSError;
  try
    dwFileSize := GetFileSize(hFile, nil);
    if dwFileSize = $FFFFFFFF then RaiseLastOSError;

    hMapping := CreateFileMapping(hFile, nil, PAGE_READONLY, 0, dwFileSize, nil);
    if hMapping = 0 then RaiseLastOSError;
    try
      pView := MapViewOfFile(hMapping, FILE_MAP_READ, 0, 0, dwFileSize);
      if pView = nil then RaiseLastOSError;
      try
        pCurrent := PAnsiChar(pView);
        pEOF := pCurrent + dwFileSize;
        pStart := nil;

        while pCurrent < pEOF do
        begin
          if pCurrent^ in [#9, #10, #13, #32..#128] then
          begin
            if pStart = nil then
              pStart := pCurrent;
          end
          else if pStart <> nil then
          begin
            iLen := Integer(pCurrent - pStart);
            if iLen >= MinStringLength then
            begin
              SetString(tmp, pStart, iLen);
              mmo1.Lines.Add(tmp);
            end;
            pStart := nil;
          end;
          Inc(pCurrent);
        end;
      finally
        UnmapViewOfFile(pView);
      end;
    finally
     CloseHandle(hMapping);
    end;
  finally
    CloseHandle(hFile);
  end;
end;

Answer 2

AsciiDump coded by {steve10120@ic0de.org}

function FileToPtr(szFilePath: string; var pFile: Pointer;

  var dwFileSize: DWORD): Boolean;

var

  hFile: DWORD;

  dwRead: DWORD;

begin

  Result := FALSE;

  hFile := CreateFile(PChar(szFilePath), GENERIC_READ, 0, nil,

    OPEN_EXISTING, 0, 0);

  if (hFile <> INVALID_HANDLE_VALUE) then

  begin

    dwFileSize := GetFileSize(hFile, nil);

    if (dwFileSize > 0) then                                  

    begin

      pFile := VirtualAlloc(nil, dwFileSize, MEM_COMMIT, PAGE_READWRITE);

      if (Assigned(pFile)) then

      begin

        SetFilePointer(hFile, 0, nil, FILE_BEGIN);

        ReadFile(hFile, pFile^, dwFileSize, dwRead, nil);

        if (dwRead = dwFileSize) then

          Result := TRUE;

      end;

    end;

    CloseHandle(hFile);

  end;

end;



function FindASCIIStringsA(szFilePath: string; dwMinLength: DWORD;

  szDumpPath: string): Boolean;

var

  pFile: Pointer;

  dwFileSize: DWORD;

  i: DWORD;

  szDump: string;

  dwLength: DWORD;

  hFile: TextFile;

begin

  Result := FALSE;

  if (FileToPtr(szFilePath, pFile, dwFileSize)) then

  begin

    dwLength := 0;

    AssignFile(hFile, szDumpPath);

    // yeah I don't like it but its easiest for writing lines..

    Rewrite(hFile);

    for i := 0 to (dwFileSize - 1) do

    begin

      if (PByte(DWORD(pFile) + i)^ in [$20 .. $7E]) then

      begin

        szDump := szDump + Char(PByte(DWORD(pFile) + i)^);

//        WriteLn(hFile, '0x' + IntToHex(i - dwLength, 8) + ': ' + szDump);

        Inc(dwLength);

      end

      else

      begin

        if (dwLength >= dwMinLength) then

          WriteLn(hFile, '0x' + IntToHex(i - dwLength, 8) + ': ' + szDump);

        dwLength := 0;

        szDump := '';

      end;

    end;

    if (FileSize(hFile) > 0) then

      Result := TRUE;

    CloseFile(hFile);

    VirtualFree(pFile, 0, MEM_RELEASE);

  end;

end;

function FindASCIIStrings(szFilePath:string; dwMinLength:DWORD; szDumpPath:string):Boolean;

var

  pFile:      Pointer;

  dwFileSize: DWORD;

  IDH:        PImageDosHeader;

  INH:        PImageNtHeaders;

  i:          DWORD;

  szDump:     string;

  dwLength:   DWORD;

  hFile:      TextFile;

begin

  Result := FALSE;

  if (FileToPtr(szFilePath, pFile, dwFileSize)) then

  begin

    IDH := pFile;

    if (IDH^.e_magic = IMAGE_DOS_SIGNATURE) then

    begin

      INH := Pointer(DWORD(pFile) + IDH^._lfanew);

      if (INH^.Signature = IMAGE_NT_SIGNATURE) then

      begin

        dwLength := 0;

        AssignFile(hFile, szDumpPath); // yeah I don't like it but its easiest for writing lines..

        Rewrite(hFile);

        for i := INH^.OptionalHeader.SizeOfHeaders to (dwFileSize - 1) do

        begin

          if (PByte(DWORD(pFile) + i)^ in [$20..$7E]) then

          begin

            szDump := szDump + Char(PByte(DWORD(pFile) + i)^);

            Inc(dwLength);

          end

          else

          begin

            if (dwLength >= dwMinLength) then

              WriteLn(hFile, '0x' + IntToHex(i - dwLength, 8) + ': ' + szDump);

            dwLength := 0;

            szDump := '';

          end;

        end;

        if (FileSize(hFile) > 0) then

          Result := TRUE;

        CloseFile(hFile);

      end;

    end;

    VirtualFree(pFile, 0, MEM_RELEASE);

  end;

end;

procedure TForm2.btn1Click(Sender: TObject);

begin

FindASCIIStrings('e:\AntiDebugg.exe', 2,

    IncludeTrailingPathDelimiter(ExtractFilePath(param  str(0))) +

    ExtractFileName(paramstr(1)) + '.dmp')

end;