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

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;