[Release] D-Jector Source Code(Using Create Thread Method)

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.