{*******************************************************} { } { Remote Inject } { Creation Date 2010.12.23 } { Created By: ming } { } {*******************************************************} unit unitMain; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, TlHelp32, StdCtrls, ExtCtrls; type TfrmMain = class(TForm) btnInject: TButton; ListBox1: TListBox; btnUnInject: TButton; btnGetProcess: TButton; btnSetPath: TButton; OpenDialog1: TOpenDialog; lbledtDllPath: TLabeledEdit; lbledtPID: TLabeledEdit; btnExit: TButton; procedure btnInjectClick(Sender: TObject); procedure ListBox1Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure btnUnInjectClick(Sender: TObject); procedure btnGetProcessClick(Sender: TObject); procedure btnSetPathClick(Sender: TObject); procedure btnExitClick(Sender: TObject); private { Private declarations } public { Public declarations } end; var frmMain: TfrmMain; implementation {$R *.dfm} function GetProcessID(List:TStrings; ProcessName: string = ''): TProcessEntry32; var ret: Boolean; processID: Cardinal; _processName: string; FSnapshotHandle: HWND; FProcessEntry32: TProcessEntry32; begin FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0); FProcessEntry32.dwSize := SizeOf(FProcessEntry32); ret := Process32First(FSnapshotHandle,FProcessEntry32); while ret do begin _processName := ExtractFileName(FProcessEntry32.szExeFile); if (ProcessName = '') then begin processID := FProcessEntry32.th32ProcessID; List.Add(Format('%-20s%d',[_processName,processID])); end else if (AnsiCompareText(_processName,ProcessName)=0) then begin processID := FProcessEntry32.th32ProcessID; List.Add(Format('%-20s%d',[_processName,processID])); Result := FProcessEntry32; Break; end; ret := Process32Next(FSnapshotHandle,FProcessEntry32); end; end; function EnableDebugPrivilege(const bEnabled: Boolean):Boolean; const SE_DEBUG_NAME = 'SeDebugPrivilege'; var hToken: THandle; tp: TOKEN_PRIVILEGES; len: DWORD; begin Result := False; if OpenProcessToken(GetCurrentProcess,TOKEN_ADJUST_PRIVILEGES,hToken) then begin tp.PrivilegeCount := 1; LookupPrivilegeValue(nil,SE_DEBUG_NAME,tp.Privileges[0].Luid); if bEnabled then tp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED else tp.Privileges[0].Attributes := 0; len := 0; AdjustTokenPrivileges(hToken,False,tp,SizeOf(tp),nil,len); Result := GetLastError = ERROR_SUCCESS; CloseHandle(hToken); end; end; function InjectDll(const DllFullPath:AnsiString; const dwRemoteProcessId: DWORD):Boolean; var hRemoteProcess,hRemoteThread: THandle; pszLibFileRemote: Pointer; pszLibFileName: PWideChar; pfnStartAddr: TFNThreadStartRoutine; memSize,writeSize,lpThreadId: Cardinal; begin Result := False; if EnableDebugPrivilege(True) then begin hRemoteProcess := OpenProcess(PROCESS_ALL_ACCESS,False,dwRemoteProcessId); try GetMem(pszLibFileName,Length(DllFullPath)*2+1); StringToWideChar(DllFullPath,pszLibFileName,Length(DllFullPath)*2+1); memSize := (1+lstrlenw(pszLibFileName)) * SizeOf(WCHAR); pszLibFileRemote := VirtualAllocEx(hRemoteProcess,nil,memSize,MEM_COMMIT,PAGE_READWRITE); if Assigned(pszLibFileRemote) then begin if WriteProcessMemory(hRemoteProcess,pszLibFileRemote,pszLibFileName,memSize,writeSize) and (writeSize=memSize) then begin lpThreadId := 0; pfnStartAddr := GetProcAddress(LoadLibrary('Kernel32.dll'),'LoadLibraryW'); hRemoteThread := CreateRemoteThread(hRemoteProcess,nil,0,pfnStartAddr ,pszLibFileRemote,0,lpThreadId); if hRemoteThread <> 0 then Result := True; CloseHandle(hRemoteThread); end; end; finally CloseHandle(hRemoteProcess); end; end; end; function UnInjectDll(const DllFullPath:AnsiString; const dwRemoteProcessId: DWORD):Boolean; var hRemoteProcess,hRemoteThread: THandle; pszLibFileRemote: Pointer; pszLibFileName: PWideChar; pfnStartAddr: TFNThreadStartRoutine; memSize,writeSize,lpThreadId,dwExitCode: Cardinal; begin Result := False; if EnableDebugPrivilege(True) then begin hRemoteProcess := OpenProcess(PROCESS_ALL_ACCESS,False,dwRemoteProcessId); try GetMem(pszLibFileName,Length(DllFullPath)*2+1); StringToWideChar(DllFullPath,pszLibFileName,Length(DllFullPath)*2+1); memSize := (1+lstrlenw(pszLibFileName)) * SizeOf(WCHAR); pszLibFileRemote := VirtualAllocEx(hRemoteProcess,nil,memSize,MEM_COMMIT,PAGE_READWRITE); if Assigned(pszLibFileRemote) then begin if WriteProcessMemory(hRemoteProcess,pszLibFileRemote,pszLibFileName,memSize,writeSize) and (writeSize=memSize) then begin lpThreadId := 0; pfnStartAddr := GetProcAddress(LoadLibrary('Kernel32.dll'),'GetModuleHandleW'); hRemoteThread := CreateRemoteThread(hRemoteProcess,nil,0,pfnStartAddr ,pszLibFileRemote,0,lpThreadId); WaitForSingleObject(hRemoteThread,INFINITE); GetExitCodeThread(hRemoteThread,dwExitCode); CloseHandle(hRemoteThread); pfnStartAddr := GetProcAddress(LoadLibrary('Kernel32.dll'),'FreeLibrary'); hRemoteThread := CreateRemoteThread(hRemoteProcess,nil,0,pfnStartAddr ,Pointer(dwExitCode),0,lpThreadId); WaitForSingleObject(hRemoteThread,INFINITE); if hRemoteThread <> 0 then Result := True; VirtualFreeEx(hRemoteProcess,pszLibFileRemote,Length(DllFullPath)+1,MEM_DECOMMIT); CloseHandle(hRemoteThread); end; end; finally CloseHandle(hRemoteProcess); end; end; end; procedure TfrmMain.btnExitClick(Sender: TObject); begin if mrYes = MessageDlg('Are you sure exit? :)',mtInformation,[mbYes,mbNo],0) then Close; end; procedure TfrmMain.btnGetProcessClick(Sender: TObject); begin ListBox1.Clear; GetProcessID(TStrings(ListBox1.Items),''); end; procedure TfrmMain.btnInjectClick(Sender: TObject); var PID: Cardinal; _ErrorCount: Byte; begin _ErrorCount := 0; PID := StrToInt(lbledtPid.Text); if PID <=0 then begin ShowMessage('Please Enter PID.'); Inc(_ErrorCount); end; if lbledtDllPath.Text = '' then begin ShowMessage('Please Enter Dll Path.'); Inc(_ErrorCount); end; if _ErrorCount = 0 then begin InjectDll(lbledtDllPath.Text,PID); end; //InjectDll(extractfilepath(paramstr(0))+'Project2.dll',PID); end; procedure TfrmMain.btnSetPathClick(Sender: TObject); begin OpenDialog1.Filter := '*.dll|*.dll'; if OpenDialog1.Execute then begin lbledtDllPath.Text := OpenDialog1.FileName; end; end; procedure TfrmMain.btnUnInjectClick(Sender: TObject); var PID: Cardinal; _ErrorCount: Byte; begin _ErrorCount := 0; PID := StrToInt(lbledtPid.Text); if PID <=0 then begin ShowMessage('Please Enter PID.'); Inc(_ErrorCount); end; if lbledtDllPath.Text = '' then begin ShowMessage('Please Enter Dll Path.'); Inc(_ErrorCount); end; if _ErrorCount = 0 then begin UnInjectDll(lbledtDllPath.Text,PID); end; //UnInjectDll(extractfilepath(paramstr(0))+'Project2.dll',PID); end; procedure TfrmMain.FormCreate(Sender: TObject); begin GetProcessID(TStrings(ListBox1.Items),''); ListBox1.Font.Name := 'Courier New'; end; procedure TfrmMain.ListBox1Click(Sender: TObject); begin if ListBox1.ItemIndex < 0 then Exit; lbledtPid.Text := ListBox1.Items[ListBox1.ItemIndex]; with TStringList.Create do try DelimitedText := lbledtPid.Text; lbledtPid.Text := Strings[1]; finally Free; end; end; end. //.dfm object frmMain: TfrmMain Left = 453 Top = 404 BorderStyle = bsDialog Caption = 'Remote Inject' ClientHeight = 345 ClientWidth = 354 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'Tahoma' Font.Style = [] OldCreateOrder = False Position = poDesigned OnCreate = FormCreate PixelsPerInch = 96 TextHeight = 13 object btnInject: TButton Left = 249 Top = 142 Width = 75 Height = 25 Caption = 'Inject' TabOrder = 0 OnClick = btnInjectClick end object ListBox1: TListBox Left = 0 Top = 39 Width = 225 Height = 289 Font.Charset = ANSI_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'Tahoma' Font.Style = [] ItemHeight = 13 ParentFont = False TabOrder = 1 OnClick = ListBox1Click end object btnUnInject: TButton Left = 249 Top = 189 Width = 75 Height = 25 Caption = 'UnInject' TabOrder = 2 OnClick = btnUnInjectClick end object btnGetProcess: TButton Left = 249 Top = 95 Width = 75 Height = 25 Caption = 'GetProcess' TabOrder = 3 OnClick = btnGetProcessClick end object btnSetPath: TButton Left = 231 Top = 12 Width = 24 Height = 25 Caption = '...' TabOrder = 4 OnClick = btnSetPathClick end object lbledtDllPath: TLabeledEdit Left = 0 Top = 14 Width = 225 Height = 21 EditLabel.Width = 36 EditLabel.Height = 13 EditLabel.Caption = 'Dll Path' TabOrder = 5 end object lbledtPID: TLabeledEdit Left = 249 Top = 58 Width = 82 Height = 21 EditLabel.Width = 82 EditLabel.Height = 13 EditLabel.Caption = 'Inject Process ID' TabOrder = 6 end object btnExit: TButton Left = 249 Top = 240 Width = 75 Height = 25 Caption = 'Exit' TabOrder = 7 OnClick = btnExitClick end object OpenDialog1: TOpenDialog Left = 184 Top = 56 end end