{*******************************************************}
{ }
{ 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
