Code:

{ **** UBPFD *********** ****

>> Power off (Убивает процессы)

 

Зависимости: Windows

Автор:       DeMoN-777, Этот адрес электронной почты защищён от спам-ботов. У вас должен быть включен JavaScript для просмотра., Санкт-Петербург

Copyright:   @

***************************************************** }

 

procedure Shutdown2;

var

hToken: THandle;

tkp: _TOKEN_PRIVILEGES;

DUMMY: PTokenPrivileges;

DummyRL: Cardinal;

begin

DUMMY := nil;

if not OpenProcessToken(

   GetCurrentProcess(),

   TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,

   hToken

   ) then

   raise TShutdownEx.Create('OpenProcessToken failed');

 

if (not LookupPrivilegeValue(nil, 'SeShutdownPrivilege',

   tkp.Privileges[0].Luid)) then

   raise TShutdownEx.Create('LookupPrivilegeValue failed');

 

tkp.PrivilegeCount := 1;

tkp.Privileges[0].Attributes := $0002; //SE_PRIVILEGE_ENABLED = $00002

 

AdjustTokenPrivileges(hToken, FALSE, tkp, 0, Dummy, DummyRL);

 

if (GetLastError() <> ERROR_SUCCESS) then

   raise TShutdownEx.Create('AdjustTokenPrivileges failed');

 

if (not ExitWindowsEx(EWX_SHUTDOWN or EWX_FORCE, 0)) then

   raise TShutdownEx.Create('ExitWindowsEx failed');

end;

 

Code:

procedure LockPC;

var OldValue: LongBool;

begin

SystemParametersInfo(97, Word(Bool), @OldValue, 0);

WinExec(PChar('rundll32 mouse,disable'), SW_SHOW);

WinExec(PChar('rundll32 keyboard,disable'), SW_SHOW);

end;

  

У компьютеров ATX есть функция Sleep. Эта программа заставляет компьютер "заснуть".

 

Code:

function IsWorkstationLocked: Boolean;

var

hDesktop: HDESK;

begin

Result := False;

hDesktop := OpenDesktop('default',

   0, False,

   DESKTOP_SWITCHDESKTOP);

if hDesktop <> 0 then

begin

   Result := not SwitchDesktop(hDesktop);

   CloseDesktop(hDesktop);

end;

end;

 

 

Code:

function SuspendAllowed: Boolean;

type

TIsPwrSuspendAllowed = function: Boolean;

stdcall;

var

hPowrprof: HMODULE;

IsPwrSuspendAllowed: TIsPwrSuspendAllowed;

begin

Result := False;

hPowrprof := LoadLibrary('powrprof.dll');

if hPowrprof <> 0 then

begin

   try

     @IsPwrSuspendAllowed := GetProcAddress(hPowrprof, 'IsPwrSuspendAllowed');

     if @IsPwrSuspendAllowed <> nil then

     begin

       Result := IsPwrSuspendAllowed;

     end;

   finally

     FreeLibrary(hPowrprof);

   end;

end;

end;

 

Автор: Kecvin S. Gallagher

Если монитор поддерживает режим Stand by, то его можно программно перевести в этот режим. Данная возможность доступна на Windows95 и выше.

 Чтобы перевести монитор в режим Stand by:

 

Code:

{ **** UBPFD *********** by ****

>> Переход в ждущий режим под WinNT

 Зависимости: Windows

Автор:       DeMoN-777, Этот адрес электронной почты защищён от спам-ботов. У вас должен быть включен JavaScript для просмотра., Санкт-Петербург

***************************************************** }

 

procedure NTWait;

var

hToken: THandle;

tkp: TTokenPrivileges;

ReturnLength: Cardinal;

begin

if OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or

   TOKEN_QUERY, hToken) then

begin

   LookupPrivilegeValue(nil, 'SeShutdownPrivilege', tkp.Privileges[0].Luid);

   tkp.PrivilegeCount := 1;

   tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;

   if AdjustTokenPrivileges(hToken, False, tkp, 0, nil, ReturnLength) then

     SetSystemPowerState(true, true);

end;

end;

 

Функция SetSuspendState приостанавливает работу системы за счет отключения питания.

В зависимости от параметра Hibernate,

система либо переходит в состояние приостановки (сна), либо в спящий режим.

Как правило, приложение не требуется получать уведомления при переключении сеанса происходить. Тем не менее, если приложение должно быть в курсе, когда его рабочий стол

течение, оно может зарегистрировать для уведомлений переключателя сеанса. Приложения, которые доступ к последовательному порту или другому общему ресурсу на компьютере должен

Проверьте на это. Для регистрации уведомления используйте следующую функцию:

 

Code:

function HibernateAllowed: Boolean;

type

TIsPwrHibernateAllowed = function: Boolean;

stdcall;

var

hPowrprof: HMODULE;

IsPwrHibernateAllowed: TIsPwrHibernateAllowed;

begin

Result := False;

if IsNT4Or95 then Exit;

hPowrprof := LoadLibrary('powrprof.dll');

if hPowrprof <> 0 then

begin

   try

     @IsPwrHibernateAllowed := GetProcAddress(hPowrprof, 'IsPwrHibernateAllowed');

     if @IsPwrHibernateAllowed <> nil then

     begin

       Result := IsPwrHibernateAllowed;

     end;

   finally

     FreeLibrary(hPowrprof);

   end;

end;

end;

 

Code:

type

PSHQueryRBInfo = ^TSHQueryRBInfo;

TSHQueryRBInfo = packed record

   cbSize: DWORD;

   // Size of the structure, in bytes.

   // This member must be filled in prior to calling the function.

   i64Size: Int64;

   // Total size of all the objects in the specified Recycle Bin, in bytes.

   i64NumItems: Int64;

   // Total number of items in the specified Recycle Bin.

end;

 

const

shell32 = 'shell32.dll';

 

function SHQueryRecycleBin(szRootPath: PChar; SHQueryRBInfo: PSHQueryRBInfo): HResult;

stdcall; external shell32 Name 'SHQueryRecycleBinA';

 

function GetDllVersion(FileName: string): Integer;

var

InfoSize, Wnd: DWORD;

VerBuf: Pointer;

FI: PVSFixedFileInfo;

VerSize: DWORD;

begin

Result   := 0;

InfoSize := GetFileVersionInfoSize(PChar(FileName), Wnd);

if InfoSize <> 0 then

begin

   GetMem(VerBuf, InfoSize);

   try

     if GetFileVersionInfo(PChar(FileName), Wnd, InfoSize, VerBuf) then

       if VerQueryValue(VerBuf, '\', Pointer(FI), VerSize) then

         Result := FI.dwFileVersionMS;

   finally

     FreeMem(VerBuf);

   end;

end;

end;

 

procedure TForm1.Button1Click(Sender: TObject);

var

DllVersion: integer;

SHQueryRBInfo: TSHQueryRBInfo;

r: HResult;

begin

DllVersion := GetDllVersion(PChar(shell32));

if DllVersion >= $00040048 then

begin

   FillChar(SHQueryRBInfo, SizeOf(TSHQueryRBInfo), #0);

   SHQueryRBInfo.cbSize := SizeOf(TSHQueryRBInfo);

   R := SHQueryRecycleBin(nil, @SHQueryRBInfo);

   if r = s_OK then

   begin

     label1.Caption := Format('Size:%d Items:%d',

       [SHQueryRBInfo.i64Size, SHQueryRBInfo.i64NumItems]);

   end

   else

     label1.Caption := Format('Err:%x', [r]);

end;

end;

 

{

 

The SHQueryRecycleBin API used in this method is

only available on systems with the latest shell32.dll installed with IE4 /

Active Desktop.

 

}