Или Как заказать сервисный процесс ?

 

Code:

unit Stealth;

 

interface

uses

WinTypes, WinProcs, Classes, Forms, SysUtils, Controls, Messages;

 

type

TStealth = class(TComponent)

private

fHideApp: Boolean;

procedure SetHideApp(Value: Boolean);

protected

{ Protected declarations }

procedure HideApplication;

procedure ShowApplication;

public

{ Public declarations }

constructor Create(AOwner: TComponent); override;

destructor Destroy; override;

// procedure Loaded; override;

published

{ Published declarations }

property HideApp: Boolean read fHideApp write SetHideApp default false;

end;

 

function RegisterServiceProcess(dwProcessID, dwType: Integer): Integer; stdcall; external 'KERNEL32.DLL';

 

procedure Register;

 

implementation

 

destructor TStealth.Destroy;

begin

ShowApplication;

inherited destroy;

end;

 

constructor TStealth.Create(AOwner: TComponent);

begin

inherited Create(AOwner);

// fHideform := true;

end;

 

procedure TStealth.SetHideApp(Value: Boolean);

begin

fHideApp := Value;

if Value then HideApplication else ShowApplication;

end;

 

procedure TStealth.HideApplication;

begin

if not (csDesigning in ComponentState) then

RegisterServiceProcess(GetCurrentProcessID, 1);

end;

 

procedure TStealth.ShowApplication;

begin

if not (csDesigning in ComponentState) then

RegisterServiceProcess(GetCurrentProcessID, 0);

end;

 

procedure Register;

begin

RegisterComponents('My', [TStealth]);

end;

 

end.

Admin автор

Программа не видна по Ctrl+Alt+Del, и сама оттуда же может спрятать любой из процессов(правда, не все с самого начала "светятся" по Ctrl+Alt+Del) или завершить его. Простой пример для знакомства с ToolHelp32.

В исходном коде есть недоработки, например, процедура Delproc получает в качестве параметра строку, затем переводит ее в целочисленный тип(integer), хотя можно передавать сразу число. Заморочка была в проверке числа-индекса на подлинность, а так как я выдрал часть кода из более ранней своей проги, я не стал это менять, а просто подогнал до рабочей версии. Оптимизацией кода вы можете заняться сами по желанию(вы можете, если хотите, а если не хотите, то вы не обязаны, вы посто могли бы... да... :))) Программа не работала в WinNT 4.0, но в Win9x работать должна.

  

Code:

procedure TForm1.Button1Click(Sender: TObject);

VAR

Wnd : hWnd;

buff: ARRAY [0..127] OF Char;

begin

ListBox1.Clear;

Wnd := GetWindow(Handle, gw_HWndFirst);

WHILE Wnd <> 0 DO

BEGIN {Не показываем:}

IF (Wnd <> Application.Handle) AND {-Собственное окно}

IsWindowVisible(Wnd) AND {-Невидимые окна}

(GetWindow(Wnd, gw_Owner) = 0) AND {-Дочернии окна}

(GetWindowText(Wnd, buff, sizeof(buff)) <> 0) {-Окна без заголовков}

THEN BEGIN

GetWindowText(Wnd, buff, sizeof(buff));

ListBox1.Items.Add(StrPas(buff));

END;

Wnd := GetWindow(Wnd, gw_hWndNext);

END;

ListBox1.ItemIndex := 0;

end;

 

Следующий пример изменяет приоритет приложения. Изменение приоритета следует использовать с осторожностью - т.к. присвоение слишком высокого приоритета может привети к медленной работе остальных программ и системы в целом. См. Win32 help for SetThreadPriority() function.

 

Следующий пример изменяет приоритет приложения. Изменение приоритета следует использовать

с осторожностью - т.к. присвоение слишком высокого приоритета может привети к

медленной работе остальных программ и системы в целом. См. Win32 help for SetThreadPriority() function.

Если внутренняя переменная hPrevInst не равна нулю, то она содержит дескриптор предыдущего запущенного экземпляра вашей программы. Вы просто находите открытое окно по его дескриптору и, при необходимости, выводите на передний план. Весь код расположен в файле .DPR file, НЕ в модуле. Строки, которые вам необходимо добавить к вашему .DPR-файлу, в приведенном ниже примере помечены {*}.

Code:

uses

Psapi, tlhelp32;

 

procedure CreateWin9xProcessList(List: TstringList);

var

hSnapShot: THandle;

ProcInfo: TProcessEntry32;

begin

if List = nil then Exit;

hSnapShot := CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS, 0);

if (hSnapShot <> THandle(-1)) then

begin

   ProcInfo.dwSize := SizeOf(ProcInfo);

   if (Process32First(hSnapshot, ProcInfo)) then

   begin

     List.Add(ProcInfo.szExeFile);

     while (Process32Next(hSnapShot, ProcInfo)) do

       List.Add(ProcInfo.szExeFile);

   end;

   CloseHandle(hSnapShot);

end;

end;

 

procedure CreateWinNTProcessList(List: TstringList);

var

PIDArray: array [0..1023] of DWORD;

cb: DWORD;

I: Integer;

ProcCount: Integer;

hMod: HMODULE;

hProcess: THandle;

ModuleName: array [0..300] of Char;

begin

if List = nil then Exit;

EnumProcesses(@PIDArray, SizeOf(PIDArray), cb);

ProcCount := cb div SizeOf(DWORD);

for I := 0 to ProcCount - 1 do

begin

   hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or

     PROCESS_VM_READ,

     False,

     PIDArray[I]);

   if (hProcess <> 0) then

   begin

     EnumProcessModules(hProcess, @hMod, SizeOf(hMod), cb);

     GetModuleFilenameEx(hProcess, hMod, ModuleName, SizeOf(ModuleName));

     List.Add(ModuleName);

     CloseHandle(hProcess);

   end;

end;

end;

 

procedure GetProcessList(var List: TstringList);

var

ovi: TOSVersionInfo;

begin

if List = nil then Exit;

ovi.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);

GetVersionEx(ovi);

case ovi.dwPlatformId of

   VER_PLATFORM_WIN32_WINDOWS: CreateWin9xProcessList(List);

   VER_PLATFORM_WIN32_NT: CreateWinNTProcessList(List);

end

end;

 

function EXE_Running(FileName: string; bFullpath: Boolean): Boolean;

var

i: Integer;

MyProcList: TstringList;

begin

MyProcList := TStringList.Create;

try

   GetProcessList(MyProcList);

   Result := False;

   if MyProcList = nil then Exit;

   for i := 0 to MyProcList.Count - 1 do

   begin

     if not bFullpath then

     begin

       if CompareText(ExtractFileName(MyProcList.Strings[i]), FileName) = 0 then

         Result := True

     end

     else if CompareText(MyProcList.strings[i], FileName) = 0 then Result := True;

     if Result then Break;

   end;

finally

   MyProcList.Free;

end;

end;

 

 

// Example 1: Is a Exe-File running ?

procedure TForm1.Button1Click(Sender: TObject);

begin

if EXE_Running('Notepad.exe', False) then

   ShowMessage('EXE is running')

else

   ShowMessage('EXE is not running');

end;

 

 

// Example 2: List running Exe-Files

procedure TForm1.Button3Click(Sender: TObject);

var

i: Integer;

MyProcList: TstringList;

begin

MyProcList := TStringList.Create;

try

   GetProcessList(MyProcList);

   if MyProcList = nil then Exit;

   for i := 0 to MyProcList.Count - 1 do

     ListBox1.Items.Add(MyProcList.Strings[i]);

finally

   MyProcList.Free;

end;

end;

 

 

Code:

function IsRunning( sName : string ) : boolean;

var

han : THandle;

ProcStruct : PROCESSENTRY32; // from "tlhelp32" in uses clause

sID : string;

begin

Result := false;

// Get a snapshot of the system

han := CreateToolhelp32Snapshot( TH32CS_SNAPALL, 0 );

if han = 0 then

   exit;

// Loop thru the processes until we find it or hit the end

ProcStruct.dwSize := sizeof( PROCESSENTRY32 );

if Process32First( han, ProcStruct ) then

   begin

     repeat

       sID := ExtractFileName( ProcStruct.szExeFile );

       // Check only against the portion of the name supplied, ignoring case

       if uppercase( copy( sId, 1, length( sName ) ) ) = uppercase( sName ) then

         begin

           // Report we found it

           Result := true;

           Break;

         end;

     until not Process32Next( han, ProcStruct );

   end;

// clean-up

CloseHandle( han );

end;

 

Есть handle запущенного PE файла. Как определить откуда он был запущен?

 

Я так предполагаю что getmodulefilename как и GetModuleHandle

работает в рамках только своего процесса.

 

А решить твою задачу .. можно так:

Тут парочка моих любимых функций

 

Code:

function RegisterServiceProcess(dwProcessID, dwType: Integer): Integer; stdcall; external 'KERNEL32.DLL';

 

implementation

 

procedure TForm1.Button1Click(Sender: TObject);

begin //Скрываем

if not (csDesigning in ComponentState) then

RegisterServiceProcess(GetCurrentProcessID, 1);

end;

 

procedure TForm1.Button2Click(Sender: TObject);

begin //Опять показываем

if not (csDesigning in ComponentState) then

RegisterServiceProcess(GetCurrentProcessID, 0);

end;

 

 

только для ALT+TAB и CTRL+ESC)

 Это не совсем профессиональный способ, но он работает! Мы просто эмулируем запуск и остановку скринсейвера.

Code:

Procedure TaskSwitchingStatus( State : Boolean );

Var

   OldSysParam : LongInt;

Begin

   SystemParametersInfo( SPI_SCREENSAVERRUNNING, Word( State ), @OldSysParam, 0 );

End;