Remote Inject

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