Code:
type
PThreadParams = ^TThreadParams;
TThreadParams = record
ParentHandle: THandle;
ListItem: Integer;
DelayTime: Integer;
DllItem: string;
ProcessName: string;
end;
const
CM_RESULT = WM_USER + 1;
CM_STATUS = WM_USER + 2;
CM_ABORT = WM_USER + 3;
var
Form1: TForm1;
implementation
{$R *.dfm}
{$R VistaAdminRequest.res}
uses
uDllSettings, ShellApi;
var
ExitThread, AutoClose: Boolean;
FullGamePath: string;
ThreadCount: Integer = 0;
function GetProcessID(const sProcessName: string): Integer;
var
ContinueLoop: BOOL;
FSnapshotHandle: THandle;
FProcessEntry32: TProcessEntry32;
begin
FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
Result := 0;
while Integer(ContinueLoop) <> 0 do
begin
if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
UpperCase(sProcessName)) or (UpperCase(FProcessEntry32.szExeFile) =
UpperCase(sProcessName))) then
begin
Result := FProcessEntry32.th32ProcessID;
break;
end;
ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
end;
CloseHandle(FSnapshotHandle);
end;
function InjectDll(PID: DWORD; sDll: string): Boolean;
var
hLib: Pointer;
hThread: THandle;
pMod: Pointer;
hOpen: THandle;
dWritten: Cardinal;
ThreadID: Cardinal;
begin
Result := FALSE;
hOpen := OpenProcess(PROCESS_ALL_ACCESS, FALSE, PID);
if hOpen <> INVALID_HANDLE_VALUE then
begin
hLib := GetProcAddress(GetModuleHandle(PChar('kernel32.dll')),
PChar('LoadLibraryA'));
pMod := VirtualAllocEx(hOpen, nil, Length(sDll) + 1, MEM_COMMIT or
MEM_RESERVE, PAGE_EXECUTE_READWRITE);
if WriteProcessMemory(hOpen, pMod, @sdll[1], Length(sDll), dWritten) then
Result := TRUE;
hThread := CreateRemoteThread(hOpen, nil, 0, hLib, pMod, 0, ThreadID);
WaitForSingleObject(hThread, INFINITE);
CloseHandle(hOpen);
CloseHandle(hThread);
end;
end;
function UnInjectDll(PID: DWORD; sDll: string): Boolean;
var
hSnap: THandle;
MOD32: MODULEENTRY32;
hLib: Pointer;
hOpen: THandle;
hThread: THandle;
ThreadID: Cardinal;
begin
Result := FALSE;
hSnap := CreateToolhelp32Snapshot(TH32CS_SNAPMODULE, PID);
if hSnap <> INVALID_HANDLE_VALUE then
begin
MOD32.dwSize := SizeOf(MOD32);
Module32First(hSnap, MOD32);
repeat
if MOD32.szExePath = sDll then
begin
hOpen := OpenProcess(PROCESS_ALL_ACCESS, FALSE, PID);
if hOpen <> INVALID_HANDLE_VALUE then
begin
Result := TRUE;
hLib := GetProcAddress(GetModuleHandle(PChar('kernel32.dll')),
PChar('FreeLibrary'));
hThread := CreateRemoteThread(hOpen, nil, 0, hLib, MOD32.modBaseAddr,
0, ThreadID);
CloseHandle(hOpen);
CloseHandle(hThread);
end;
end;
until Module32Next(hSnap, MOD32) = FALSE;
CloseHandle(hSnap);
end;
end;
function InjectThread(p: Pointer): Integer;
var
ParentHandle: THandle;
DelayTime, ListItem, ProcID: Integer;
ProcessName, DllItem,
sWaiting, sInjected,
sFailed, sAborted: string;
begin
sWaiting := 'Waiting';
sInjected := 'Injected';
sFailed := 'Failed';
sAborted := 'Aborted';
try
ParentHandle := PThreadParams(p)^.ParentHandle;
ListItem := PThreadParams(p)^.ListItem;
DllItem := PThreadParams(p)^.DllItem;
DelayTime := PThreadParams(p)^.DelayTime;
ProcessName := PThreadParams(p)^.ProcessName;
SendMessage(ParentHandle, CM_STATUS, integer(PChar(sWaiting)), ListItem);
repeat
ProcID := GetProcessID(ProcessName);
Sleep(100);
until
ProcID <> 0;
Sleep(DelayTime);
SendMessage(ParentHandle, CM_STATUS, integer(PChar(sFailed)), ListItem);
if ProcID > 0 then
begin
if InjectDll(ProcID, DllItem) then
SendMessage(ParentHandle, CM_STATUS, integer(PChar(sInjected)),
ListItem);
if not AutoClose then
repeat
ProcID := GetProcessID(ProcessName);
Sleep(2000);
until
ProcID = 0;
end;
SendMessage(ParentHandle, CM_STATUS, integer(PChar(sWaiting)), ListItem);
SendMessage(ParentHandle, CM_RESULT, 0, 0);
finally
Dispose(p);
Result := 0;
end;
end;
procedure TForm1.AddLibrary(const sLib, sProc, sDelay, sStatus, sPath: string);
begin
with lvItems.Items.Add do
begin
Checked := True;
Caption := sLib;
Subitems.Add(sProc);
Subitems.Add(sDelay);
Subitems.Add(sStatus);
Subitems.Add(sPath);
end;
end;
procedure TForm1.AddLibrary1Click(Sender: TObject);
var
sPath: string;
begin
if odAdd.Execute then
begin
sPath := odAdd.FileName;
if form2.ShowModal = mrOK then
AddLibrary(ExtractFileName(sPath), form2.edProcessName.Text,
form2.iDelay.Text, 'Waiting', sPath);
end;
end;
procedure TForm1.EditDll1Click(Sender: TObject);
var
iSelectedItem: Integer;
begin
iSelectedItem := lvItems.Selected.Index;
if iSelectedItem <> -1 then
begin
form2.edProcessName.Text :=
lvItems.Items.Item[iSelectedItem].SubItems.Strings[0];
form2.iDelay.Text := lvItems.Items.Item[iSelectedItem].SubItems.Strings[1];
if Form2.ShowModal = mrOK then
begin
lvItems.Items.Item[iSelectedItem].SubItems.Strings[0] :=
form2.edProcessName.Text;
lvItems.Items.Item[iSelectedItem].SubItems.Strings[1] :=
form2.iDelay.Text;
form2.edProcessName.Text := 'Engine.exe';
form2.iDelay.Text := '1000';
form2.edParameters.Clear;
end;
end;
end;
procedure TForm1.cbStayOnTopClick(Sender: TObject);
begin
if cbStayOnTop.State = cbChecked then
FormStyle := fsStayOnTOp
else
FormStyle := fsNormal;
end;
procedure TForm1.bsBusinessSkinForm1Activate(Sender: TObject);
begin
Form1.DoubleBuffered := True;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
sStringList: TStringList;
i: Integer;
begin
DoubleBuffered := True;
try
sStringList := TStringList.Create;
RegSettings := TRegistry.Create;
RegSettings****otKey := HKEY_LOCAL_MACHINE;
if RegSettings.OpenKey('SOFTWARE\D-Jector\', False) then
begin
cbLogging.Checked := RegSettings.ReadBool('Logging');
cbAutoClose.Checked := RegSettings.ReadBool('AutoClose');
cbStayOnTop.Checked := RegSettings.ReadBool('OnTop');
cbSaveSettings.Checked := RegSettings.ReadBool('SaveSettings');
FullGamePath := RegSettings.ReadString('GamePath');
edGamePath.Text := ExtractFileName(FullGamePath);
RegSettings.GetKeyNames(sStringList);
RegSettings.CloseKey;
if sStringLis*****unt > 0 then
for i := 0 to pred(sStringLis*****unt) do
if RegSettings.OpenKey('SOFTWARE\D-Jector\Hack_' + inttostr(i), TRUE)
then
begin
AddLibrary(ExtractFileName(RegSettings.ReadString('FullPath')),
RegSettings.ReadString('Process'), RegSettings.ReadString('Delay'),
PChar('Waiting'), RegSettings.ReadString('FullPath'));
lvItems.Items.Item[i].Checked := RegSettings.ReadBool('Enabled');
RegSettings.CloseKey;
end;
end;
finally
RegSettings.Free;
sStringList.Free;
end;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
sStringList: TStringList;
i: Integer;
begin
if cbSaveSettings.Checked then
begin
try
sStringList := TStringList.Create;
RegSettings := TRegistry.Create;
RegSettings****otKey := HKEY_LOCAL_MACHINE;
if RegSettings.OpenKey('SOFTWARE\D-Jector\', TRUE) then
begin
RegSettings.WriteBool('Logging', cbLogging.Checked);
RegSettings.WriteBool('AutoClose', cbAutoClose.Checked);
RegSettings.WriteBool('SaveSettings', cbSaveSettings.Checked);
RegSettings.WriteBool('OnTop', cbStayOnTop.Checked);
RegSettings.WriteString('GamePath', FullGamePath);
RegSettings.GetKeyNames(sStringList);
for i := 0 to pred(sStringLis*****unt) do
RegSettings.DeleteKey(sStringList.Strings[i]);
sStringList.Clear;
RegSettings.CloseKey;
for i := 0 to pred(lvITems.Items.Count) do
if RegSettings.OpenKey('SOFTWARE\D-Jector\Hack_' + inttostr(i), TRUE)
then
begin
RegSettings.WriteString('Process',
lvItems.Items.Item[i].SubItems.Strings[0]);
RegSettings.WriteString('Delay',
lvItems.Items.Item[i].SubItems.Strings[1]);
RegSettings.WriteString('FullPath',
lvItems.Items.Item[i].SubItems.Strings[3]);
RegSettings.WriteBool('Enabled', lvItems.Items.Item[i].Checked);
RegSettings.CloseKey;
end;
end;
finally
RegSettings.Free;
sStringList.Free;
end;
end;
end;
procedure TForm1.btnGamePathClick(Sender: TObject);
begin
if odGamePath.Execute then
begin
FullGamePath := odGamePath.FileName;
edGamePath.Text := ExtractFileName(FullGamePath);
end;
end;
procedure TForm1.WndProc(var Message: TMessage);
var
myFile: TextFile;
begin
inherited;
case Message.Msg of
CM_RESULT:
begin
dec(ThreadCount);
if ThreadCount = 0 then
begin
btnLaunch.Enabled := True;
btnGamePath.Enabled := True;
lvITems.Enabled := True;
end;
if ((AutoClose = True) and (ThreadCount <= 0)) then
Close;
end;
CM_STATUS:
begin
lvItems.Items.Item[Message.LParam].SubItems.Strings[2] :=
PChar(Message.WParam);
end;
end;
end;
procedure TForm1.btnLaunchClick(Sender: TObject);
var
ThreadID: Cardinal;
ThreadParams: PThreadParams;
iLoop: Integer;
begin
lvITems.Enabled := False;
btnGamePath.Enabled := False;
btnLaunch.Enabled := False;
ThreadCount := 0;
if FullGamePath <> '' then
begin
if GetProcessID(ExtractFileName(FullGamePath)) = 0 then
ShellExecute(Handle, 'open', Pchar(FullGamePath), nil, nil,
SW_SHOWNORMAL);
if lvItems.Items.Count > 0 then
for iLoop := 0 to pred(lvItems.Items.Count) do
if lvItems.Items.Item[iLoop].Checked then
begin
New(ThreadParams);
ThreadParams.ParentHandle := Self.Handle;
ThreadParams.ListItem := iLoop;
ThreadParams.ProcessName :=
lvItems.Items.Item[iLoop].SubItems.Strings[0];
ThreadParams.DelayTime :=
strtoint(lvItems.Items.Item[iLoop].SubItems.Strings[1]);
ThreadParams.DllItem := lvItems.Items.Item[iLoop].SubItems.Strings[3];
CloseHandle(BeginThread(nil, 0, @InjectThread, ThreadParams, 0, ThreadID));
inc(ThreadCount);
end;
end
else
lvITems.Enabled := True;
btnGamePath.Enabled := True;
btnLaunch.Enabled := True;
end;
procedure TForm1.RemoveLibrary1Click(Sender: TObject);
begin
lvItems.Items.Delete(lvItems.Selected.Index);
end;
procedure TForm1.cbAutoCloseClick(Sender: TObject);
begin
Autoclose := cbAutoClose.Checked;
end;
end.