![]() |
![]() |
![]() |
![]() |
![]() |
|
|
Дельфийские полезностиАвтор: D`ART ( Black Cat Virology Network ). Перевод NeKr0! Типа привет! Сегодня я рад представить вам немного кода, который может быть очень полезен для ВирМакеров. 1. Как скрыть вашу прогу от Ctrl+Alt+Del ?
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;
2. Как перехватить выход из Виндов?
...
private
{ Private declarations }
procedure WMQE(var Message: TMessage); message WM_QUERYENDSESSION;
...
procedure TMesForm.WMQE(var Message: TMessage);
begin
inherited;
{ Тут ваш код, который будет исполняться при выходе из Виндов}
end;
3. Как получить список активных програм/задач?
procedure TTaskListForm.FormShow(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;
4. Как скопировать выполняемую прогу (самокопирование)?
CopyFile( paramstr(0) ,'E:\DDD\Proga2.exe',False);
5. Как выполнить дргую прогу и дождаться конца ее выполнения?
procedure Start;
var
si: TStartupInfo;
p: TProcessInformation;
begin
FillChar(Si,SizeOf(Si),0);
with Si do begin
cb := SizeOf( Si);
dwFlags := startf_UseShowWindow;
wShowWindow := 4;
end;
Form1.WindowState:=wsMinimized;
Createprocess(nil,'Your_program.exe',nil,nil,false,
Create_default_error_mode,nil,nil,si);
Waitforsingleobject(p.hProcess,infinite);
Form1.WindowState:=wsNormal;
end;
6. Как выполнить дргую прогу и дождаться конца ее выполнения? (вариант 2)
procedure TForm1.BtnArchClick(Sender: TObject);
var
lpApplicationName : PChar;
lpCommandLine : PChar;
lpThreadAttributes,
lpProcessAttributes : PSECURITYATTRIBUTES;
bInheritHandles : BOOL;
dwCreationFlags : DWORD;
lpEnvironment : Pointer;
lpCurrentDirectory : PChar;
lpStartupInfo : TSTARTUPINFO;
lpProcessInformation: TPROCESSINFORMATION;
lpExitCode : DWORD;
hProcess : THandle;
begin
lpApplicationName := NIL;
lpCommandLine := 'arj.exe a dbf *.dbf';
lpThreadAttributes := NIL;
lpProcessAttributes := NIL;
bInheritHandles := true;
dwCreationFlags := NORMAL_PRIORITY_CLASS;
lpEnvironment := NIL;
lpCurrentDirectory := NIL;
with lpStartupInfo do begin
cb := SizeOf(TStartupInfo);
lpReserved := NIL;
lpDesktop := NIL;
lpTitle := PChar('Archiving');
dwX := 0;
dwY := 0;
dwXSize := 0;
dwYSize := 0;
dwXCountChars := 0;
dwYCountChars := 0;
dwFillAttribute := 0;
dwFlags := 0;
wShowWindow := SW_SHOWDEFAULT;
cbReserved2 := 0;
lpReserved2 := NIL;
hStdInput := 0;
hStdOutput := 0;
hStdError := 0;
end;
if (not CreateProcess(lpApplicationName,lpCommandLine,
lpProcessAttributes,lpThreadAttributes,bInheritHandles,
dwCreationFlags,lpEnvironment,lpCurrentDirectory,
lpStartupInfo,lpProcessInformation)) then begin
Application.MessageBox(' ERROR ',
'WARNING!!!',ID_OK);
end;
hProcess := lpProcessInformation.hProcess;
repeat
GetExitCodeProcess(hProcess,lpExitCode);
Application.ProcessMessages;
until (lpExitCode <> STILL_ACTIVE); //Waiting for enclosure
end;
Типа ВСЕ !!!.....? |