program SpecialLaucher;
{$APPTYPE CONSOLE}
{$WARN SYMBOL_PLATFORM OFF}
uses
Windows, Psapi, SysUtils;
const
Values : Array[0..4] of byte = ($C2,$00,$00,$90,$90);
var
bSeenInitialBP: Boolean;
hProcess: THandle;
function GetFileNameFromHandle(hFile: THandle): string;
const BUFSIZE = 1024;
var fName, devName: string;
hFileMap: THandle;
dwFileSizeHi, dwFileSizeLo: LONGINT;
pMem: pointer;
x: LongWord;
DrvLetter: char;
Drv: string;
begin
result:= '';
dwFileSizeHi := 0;
dwFileSizeLo := GetFileSize(hFile, @dwFileSizeHi);
if (dwFileSizeLo = 0) and (dwFileSizeHi = 0) then
fName := 'Cannot map a file with a length of zero.';
hFileMap := CreateFileMapping(hFile, nil, PAGE_READONLY, 0, 1, nil);
if (hFileMap <> 0) then
begin
pMem := MapViewOfFile(hFileMap, FILE_MAP_READ, 0, 0, 1);
//GetMem(fName, Max_Path);
if (pMem <> nil) then
begin
SetLength(fName, MAX_PATH);
if GetMappedFileName(GetCurrentProcess(), pMem,
pchar(fName), MAX_PATH) <> 0 then
begin
for DrvLetter:= 'A' to 'Z' do
begin
Drv:= DrvLetter+':';
SetLength(devName, BufSize);
x:= QueryDosDevice(pchar(Drv), pchar(devName), BufSize-1);
SetLength(devName, x-2);
if Pos(devName, fName) <> 0 then
begin
fName:= StringReplace(fName, devName, Drv, []);
break;
end;
end;
end
else fName := 'Error mapping file';
UnmapViewOfFile(pMem);
end;
CloseHandle(hFileMap);
end;
result:= fName;
end;
function GetDllEntryPoint(hFile: DWORD; hModule: pointer): pointer;
var
hMapFile, dwFSizeLow, dwFSizeHight: DWORD;
pMemory, EntryPoint: pointer;
idh: PImageDosHeader;
inh: PImageNtHeaders;
begin
EntryPoint := nil;
pMemory := nil;
dwFSizeHight := 0;
dwFSizeLow := GetFileSize(hFile, @dwFSizeHight);
if ((hFile > 0) and (dwFSizeLow > 0) and (dwFSizeHight > 0)) then
begin
writeln(dwFSizeLow);
hMapFile := CreateFileMapping(hFile, nil, PAGE_READWRITE, dwFSizeHight, dwFSizeLow, nil);
Writeln(Format('Error: 0x%.08x', [GetLastError]));
pMemory := MapViewOfFile(hMapFile, FILE_MAP_WRITE or FILE_MAP_READ,
0, 0, 0);
if (Assigned(pMemory)) then
begin
idh := pointer(pMemory);
inh := pointer(DWORD(idh) + idh^._lfanew);
EntryPoint := PBYTE(hModule) + inh^.OptionalHeader.AddressOfEntryPoint;
end;
UnmapViewOfFile(pMemory);
CloseHandle(hMapFile);
// CloseHandle(hFile);
end;
Result := EntryPoint;
end;
procedure WriteBytes(hProcess: THandle; Address: Pointer; const Buffer: array of Byte);
var
Read: THandle;
oldprot, tmp: DWORD;
begin
if (VirtualProtectEx(hProcess, Address, Length(Buffer), PAGE_EXECUTE_READWRITE, @oldprot)) then
Writeln('1 - VirtualProtectEx() successfully!');
if (ReadProcessMemory(hProcess, Address, @Buffer, Length(Buffer), Read)) then
Writeln('ReadProcessMemory() successfully!');
if (VirtualProtectEx(hProcess, Address, Length(Buffer), oldprot, @tmp)) then
Writeln('2 - VirtualProtectEx() successfully!');
end;
procedure Help;
begin
WriteLn(ExtractFileName(ParamStr(0)) + ' <program to debug> ');
end;
type
TDebugEventHandler = function(const de: TDebugEvent): DWORD;
const
DebugEventNames: array [EXCEPTION_DEBUG_EVENT .. RIP_EVENT]
of string = ('EXCEPTION_DEBUG_EVENT', 'CREATE_THREAD_DEBUG_EVENT',
'CREATE_PROCESS_DEBUG_EVENT', 'EXIT_THREAD_DEBUG_EVENT',
'EXIT_PROCESS_DEBUG_EVENT', 'LOAD_DLL_DEBUG_EVENT',
'UNLOAD_DLL_DEBUG_EVENT', 'OUTPUT_DEBUG_STRING_EVENT', 'RIP_EVENT');
function DefaultDebugEventHandler(const de: TDebugEvent): DWORD;
begin
WriteLn('========================================');
WriteLn(Format('Debug Event [%d] : %s', [de.dwDebugEventCode,
DebugEventNames[de.dwDebugEventCode]]));
Result := DBG_CONTINUE;
end;
function ExceptionHandler(const de: TDebugEvent): DWORD;
procedure ShowExceptionRecord(const per: PExceptionRecord);
var
I: Integer;
begin
if Assigned(per) and not IsBadReadPtr(per, SizeOf(TExceptionRecord))
then with per^ do
begin
WriteLn;
WriteLn(Format(' ExceptionCode : 0x%.08x', [ExceptionCode]));
WriteLn(Format(' ExceptionFlags : 0x%.08x', [ExceptionFlags]));
WriteLn(Format(' ExceptionRecord : 0x%p', [ExceptionRecord]));
WriteLn(Format(' ExceptionAddress : 0x%p', [ExceptionAddress]));
WriteLn(Format(' NumberParameters : 0x%.08x',
[NumberParameters]));
if NumberParameters > 0 then
for I := 0 to NumberParameters - 1 do
WriteLn(Format(' ExceptionInformation[%d] : 0x%.08x',
[I, ExceptionInformation[I]]));
ShowExceptionRecord(ExceptionRecord);
end;
end;
begin
if not bSeenInitialBP then
begin
bSeenInitialBP := True;
Result := DBG_CONTINUE;
end
else
begin
DefaultDebugEventHandler(de);
with de.Exception do
begin
WriteLn(Format(' dwFirstChance : 0x%.08x', [dwFirstChance]));
ShowExceptionRecord(@ExceptionRecord);
end;
Result := DBG_EXCEPTION_NOT_HANDLED
end;
end;
function CreateProcessHandler(const de: TDebugEvent): DWORD;
begin
Result := DefaultDebugEventHandler(de);
hProcess := de.CreateProcessInfo.hProcess;
with de.CreateProcessInfo do
begin
WriteLn(Format(' hFile : 0x%.08x', [hFile]));
WriteLn(Format(' hProcess : 0x%.08x', [hProcess]));
WriteLn(Format(' hThread : 0x%.08x', [hThread]));
WriteLn(Format(' lpBaseOfImage : 0x%p', [lpBaseOfImage]));
WriteLn(Format(' dwDebugInfoFileOffset : 0x%.08x',[dwDebugInfoFileOffset]));
WriteLn(Format(' nDebugInfoSize : 0x%.08x', [nDebugInfoSize]));
WriteLn(Format(' lpThreadLocalBase : 0x%p', [lpThreadLocalBase]));
WriteLn(Format(' lpStartAddress : 0x%p', [lpStartAddress]));
WriteLn(Format(' lpImageName : 0x%p', [lpImageName]));
// WriteLn(Format(' ImageName : %s', [GetFileNameFromHandle(hFile)]));
WriteLn(Format(' fUnicode : 0x%.08x', [fUnicode]));
end;
end;
function ExitProcessHandler(const de: TDebugEvent): DWORD;
begin
Result := DefaultDebugEventHandler(de);
with de.ExitProcess do
WriteLn(Format(' dwExitCode : 0x%.08x', [dwExitCode]));
end;
function CreateThreadHandler(const de: TDebugEvent): DWORD;
begin
Result := DefaultDebugEventHandler(de);
with de.CreateThread do
begin
WriteLn(Format(' hThread : 0x%.08x', [hThread]));
WriteLn(Format(' lpThreadLocalBase : 0x%p', [lpThreadLocalBase]));
WriteLn(Format(' lpStartAddress : 0x%p', [lpStartAddress]));
end;
end;
function ExitThreadHandler(const de: TDebugEvent): DWORD;
begin
Result := DefaultDebugEventHandler(de);
with de.ExitThread do
WriteLn(Format(' dwExitCode : 0x%.08x', [dwExitCode]));
end;
function LoadDllHandler(const de: TDebugEvent): DWORD;
var
EntryP: Pointer;
DllName: string;
begin
Result := DefaultDebugEventHandler(de);
with de.LoadDll do
begin
WriteLn(Format(' hFile : 0x%.08x', [hFile]));
DllName := GetFileNameFromHandle(hFile);
WriteLn(Format(' lpBaseOfDll : 0x%p', [lpBaseOfDll]));
WriteLn(Format(' dwDebugInfoFileOffset : 0x%.08x', [dwDebugInfoFileOffset]));
WriteLn(Format(' nDebugInfoSize : 0x%.08x', [nDebugInfoSize]));
WriteLn(Format(' lpImageName : 0x%p', [lpImageName]));
WriteLn(Format(' ImageName : %s', [DllName]));
WriteLn(Format(' fUnicode : 0x%.08x', [fUnicode]));
//////////////////////////////////////////////////////////////////////////
if Pos('Project1.dll', DllName) > 0 then
begin
EntryP := GetDllEntryPoint(hFile, lpBaseOfDll);
if EntryP <> nil then
WriteBytes(hProcess, EntryP, Values)
else
Writeln('GetDllEntryPoint() failed.');
end;
/////////////////////////////////////////////////////////////////////////
end;
end;
function UnloadDllHandler(const de: TDebugEvent): DWORD;
begin
Result := DefaultDebugEventHandler(de);
with de.UnloadDll do
WriteLn(Format(' lpBaseOfDll : 0x%p', [lpBaseOfDll]));
end;
function DebugStringHandler(const de: TDebugEvent): DWORD;
var
Buf: array [1 .. 1024] of Byte;
dwRead: DWORD;
begin
Result := DefaultDebugEventHandler(de);
with de.DebugString do
begin
WriteLn(Format(' lpDebugStringData : 0x%.08x', [DWORD(lpDebugStringData)]));
WriteLn(Format(' nDebugStringLength : 0x%.08x', [nDebugStringLength]));
WriteLn(Format(' fUnicode : 0x%.08x', [fUnicode]));
if nDebugStringLength < SizeOf(Buf) then
begin
FillChar(Buf, SizeOf(Buf), 0);
ReadProcessMemory(hProcess, lpDebugStringData, @Buf, SIZE_T(nDebugStringLength), SIZE_T(dwRead));
Write(' DebugString : ');
if fUnicode <> 0 then
WriteLn(WideString(PWideChar(@Buf)))
else
WriteLn(string(PChar(@Buf)));
end;
end;
end;
function RipHandler(const de: TDebugEvent): DWORD;
begin
Result := DefaultDebugEventHandler(de);
with de.RipInfo do
begin
WriteLn(Format(' dwError : 0x%.08x', [dwError]));
WriteLn(Format(' dwType : 0x%.08x', [dwType]));
end;
end;
const
DebugEventHandlers: array [EXCEPTION_DEBUG_EVENT .. RIP_EVENT]
of TDebugEventHandler = (ExceptionHandler, CreateThreadHandler,
CreateProcessHandler, ExitThreadHandler, ExitProcessHandler, LoadDllHandler,
UnloadDllHandler, DebugStringHandler, RipHandler);
procedure Init;
var
si: TStartupInfo;
pi: TProcessInformation;
begin
bSeenInitialBP := False;
hProcess := INVALID_HANDLE_VALUE;
FillChar(si, SizeOf(TStartupInfo), 0);
FillChar(pi, SizeOf(TProcessInformation), 0);
si.cb := SizeOf(TStartupInfo);
Win32Check(CreateProcess({nil}'c:\windows\syswow64\notepad.exe', {PChar(ParamStr(1)}nil{)}, nil, nil, False,
CREATE_NEW_CONSOLE or DEBUG_ONLY_THIS_PROCESS, nil, nil, si, pi));
end;
procedure Run;
var
de: TDebugEvent;
bContinue: Boolean;
dwContinueStatus: DWORD;
begin
bContinue := True;
while bContinue do
begin
bContinue := WaitForDebugEvent(de, INFINITE);
dwContinueStatus := DebugEventHandlers[de.dwDebugEventCode](de);
if EXIT_PROCESS_DEBUG_EVENT = de.dwDebugEventCode then
bContinue := False;
ContinueDebugEvent(de.dwProcessId, de.dwThreadId, dwContinueStatus);
end;
end;
procedure Done;
begin
end;
begin
{ if ParamCount = 0 then
begin
Help;
Exit;
end; }
Init;
Run;
Done;
end.