Форум: "Система";
Текущий архив: 2003.04.21;
Скачать: [xml.tar.bz2];

Вниз

Помогите проверить функции у кого NT и 2000   Найти похожие ветки 

← →
maxim2   (2002-12-16 06:17) [0]

Привет всем!
Это функции которые перезагружают и выключают комп под 98 и XP работают, а вот под NT и 2000 незнаю кому нетрудно проверте.

// ver windows
//..................................
function GetWinVersion: String;
var
VersionInfo : TOSVersionInfo;
OSName : String;
begin
// устанавливаем размер записи
VersionInfo.dwOSVersionInfoSize := SizeOf( TOSVersionInfo );

if Windows.GetVersionEx( VersionInfo ) then
begin
with VersionInfo do
begin
case dwPlatformId of
VER_PLATFORM_WIN32s : OSName := "Win32s";
VER_PLATFORM_WIN32_WINDOWS : OSName := "Windows 95";
VER_PLATFORM_WIN32_NT : OSName := "Windows NT";
end; // case dwPlatformId
Result := OSName + " Version " + IntToStr( dwMajorVersion ) + "." + IntToStr( dwMinorVersion ) +
#13#10" (Build " + IntToStr( dwBuildNumber ) + ": " + szCSDVersion + ")";
end; // with VersionInfo
end // if GetVersionEx
else
Result := "";
end;
// end ver windows
//....................................


// shutdown
//.......................................
procedure TForm1.Button16Click(Sender: TObject);
// Windows XP proffesional, Windows 98
const
SE_SHUTDOWN_NAME = "SeShutdownPrivilege"; // Borland forgot this declaration
var
hToken : THandle;
tkp : TTokenPrivileges;
tkpo : TTokenPrivileges;
zero : DWORD;
begin
if Pos( "Windows NT", GetWinVersion) = 1 then // we"ve got to do a whole buch of things
begin
zero := 0;
if not OpenProcessToken( GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then
begin
MessageBox( 0, "Exit Error", "OpenProcessToken() Failed", MB_OK );
Exit;
end; // if not OpenProcessToken( GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken)
if not OpenProcessToken( GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then
begin
MessageBox( 0, "Exit Error", "OpenProcessToken() Failed", MB_OK );
Exit;
end; // if not OpenProcessToken( GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken)


// SE_SHUTDOWN_NAME
if not LookupPrivilegeValue( nil, "SeShutdownPrivilege" , tkp.Privileges[ 0 ].Luid ) then
begin
MessageBox( 0, "Exit Error", "LookupPrivilegeValue() Failed", MB_OK );
Exit;
end; // if not LookupPrivilegeValue( nil, "SeShutdownPrivilege" , tkp.Privileges[0].Luid )
tkp.PrivilegeCount := 1;
tkp.Privileges[ 0 ].Attributes := SE_PRIVILEGE_ENABLED;

AdjustTokenPrivileges( hToken, False, tkp, SizeOf( TTokenPrivileges ), tkpo, zero );
if Boolean( GetLastError() ) then
begin
MessageBox( 0, "Exit Error", "AdjustTokenPrivileges() Failed", MB_OK );
Exit;
end // if Boolean( GetLastError() )
else
ExitWindowsEx( EWX_FORCE or EWX_SHUTDOWN, 0 );
end // if OSVersion = "Windows NT"
else
begin // just shut the machine down
ExitWindowsEx( EWX_FORCE or EWX_SHUTDOWN, 0 );
end; // else
end;
//end shutdown
//................

Перезагрузка не влазит в следующей теме...

---

← →
?!   (2002-12-16 09:42) [1]

чо то с версиями полный изврат с элементами разврата

---

← →
Севостьянов Игорь   (2002-12-16 19:32) [2]

Вот тебе консольное приложение - написал и попробовал под Win2k другие не пробовал, но вроде должно пахать. Проверять твое недосуг

program ExitWindows;

uses
Windows, SysUtils, Forms;

const
EWX_LOGOFF = 0;
EWX_SHUTDOWN = 1;
EWX_REBOOT = 2;
EWX_FORCE = 4;
EWX_POWEROFF = 8;

{$R *.RES}

procedure AdjustToken;
//********************************************************************
//* This procedure sets the proper privileges to allow a log off or a
//* shut down to occur under Windows NT.
//********************************************************************
const
TOKEN_ADJUST_PRIVILEGES = $20;
TOKEN_QUERY = $08;
SE_PRIVILEGE_ENABLED = $02;
var
TokenHandle :THandle;
lpLuid :Int64;
tkp :_TOKEN_PRIVILEGES;
tkpNewButIgnored :_TOKEN_PRIVILEGES;
lBufferNeeded :Cardinal;
begin
//Set the error code of the last thread to zero using the
//SetLast Error function. Do this so that the GetLastError
//function does not return a value other than zero for no
//apparent reason.
SetLastError(0);
try
OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, TokenHandle);
//Get the LUID for shutdown privilege
LookupPrivilegeValue("", "SeShutdownPrivilege", lpLuid);
tkp.PrivilegeCount := 1; // One privilege to set
tkp.Privileges[0].Luid := lpLuid;
tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
//Enable the shutdown privilege in the access token of this process
AdjustTokenPrivileges(TokenHandle, False, tkp, SizeOf(tkpNewButIgnored), tkpNewButIgnored, lBufferNeeded);
except on E: Exception do
if GetLastError <> 0 then
Application.MessageBox(PChar(Format("GetCurrentProcess error = %d", [GetLastError])) ,
"Error", MB_OK+MB_ICONERROR)
else
Application.MessageBox(PChar(E.Message), "Error", MB_OK+MB_ICONERROR)
end;
end;

procedure ExitFromWindows(Mode: Integer);
begin
Case Mode of
0: ExitWindowsEx (EWX_LOGOFF, $FFFF);
1: ExitWindowsEx (EWX_LOGOFF or EWX_FORCE, $FFFF);
2: begin
if (GetVersion and $80000000) = 0 then AdjustToken;
ExitWindowsEx(EWX_SHUTDOWN, $FFFF);
end;

3: begin
if (GetVersion and $80000000) = 0 then AdjustToken;
ExitWindowsEx(EWX_SHUTDOWN or EWX_FORCE, $FFFF);
end;
end;
end;

var
I, Code: Integer;
begin
Application.Initialize;
Val(ParamStr(1), I, Code);
if Code = 0 then ExitFromWindows(I);
end.

---

← →
xfrost   (2003-02-08 16:00) [3]

Не то и не то не работает в 2000 пишет "Теперь питание компа можно отключить"
Господи , ну кто нибуть может сказать как от этого избавиться или хотя бы в чем причина

---

← →
sniknik   (2003-02-09 16:38) [4]

избавится можно прочитав хелп по ExitWindowsEx. (здесь програмка явно тестовая судя по незавершонности процедуры)

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


program ExitWindows;

uses
Windows;

{$R *.RES}

function GetErrosString: string; stdcall;
var
Len : Integer;
Buffer : array[0..255] of Char;
begin
Len:= FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM or FORMAT_MESSAGE_ARGUMENT_ARRAY, nil,
GetLastError, 0, Buffer, SizeOf(Buffer), nil);
while (Len > 0) and (Buffer[Len - 1] in [#0..#32]) do Dec(Len);
SetString(Result, Buffer, Len);
end;

procedure AdjustToken;
//********************************************************************
//* This procedure sets the proper privileges to allow a log off or a
//* shut down to occur under Windows NT.
//********************************************************************
const
TOKEN_ADJUST_PRIVILEGES = $20;
TOKEN_QUERY = $08;
SE_PRIVILEGE_ENABLED = $02;
var
TokenHandle : THandle;
lpLuid : Int64;
tkp : _TOKEN_PRIVILEGES;
tkpNewButIgnored : _TOKEN_PRIVILEGES;
lBufferNeeded : Cardinal;
StId : string;
begin
//Set the error code of the last thread to zero using the
//SetLast Error function. Do this so that the GetLastError
//function does not return a value other than zero for no
//apparent reason.
SetLastError(0);
try
OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, TokenHandle);
//Get the LUID for shutdown privilege
LookupPrivilegeValue("", "SeShutdownPrivilege", lpLuid);
tkp.PrivilegeCount := 1; // One privilege to set
tkp.Privileges[0].Luid := lpLuid;
tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
//Enable the shutdown privilege in the access token of this process
AdjustTokenPrivileges(TokenHandle, False, tkp, SizeOf(tkpNewButIgnored), tkpNewButIgnored, lBufferNeeded);
except
Str(GetLastError, StId);
MessageBox(0, PChar("GetCurrentProcess error = "+StId+" - "+GetErrosString), "Error", MB_OK+MB_ICONERROR);
end;
end;

procedure ExitFromWindows(Mode: Integer);
//EWX_LOGOFF = 0;
//EWX_SHUTDOWN = 1;
//EWX_REBOOT = 2;
//EWX_FORCE = 4;
//EWX_POWEROFF = 8;
//EWX_FORCEIFHUNG = $10;
begin
Case Mode of
0: ExitWindowsEx(EWX_LOGOFF, $FFFF);
1: ExitWindowsEx(EWX_LOGOFF or EWX_FORCE, $FFFF);
2: begin
if (GetVersion and $80000000) = 0 then AdjustToken;
ExitWindowsEx(EWX_SHUTDOWN, $FFFF);
end;
3: begin
if (GetVersion and $80000000) = 0 then AdjustToken;
ExitWindowsEx(EWX_SHUTDOWN or EWX_FORCE, $FFFF);
end;
8: begin
if (GetVersion and $80000000) = 0 then AdjustToken;
ExitWindowsEx(EWX_POWEROFF, $FFFF);
end;
end;
end;

var
I, Code: Integer;
begin
Val(ParamStr(1), I, Code);
if Code = 0 then ExitFromWindows(I);
end.


---

← →
Beglec   (2003-03-03 10:22) [5]

Все это интересно и полезно, но я тоже втретился с такой проблемой.
(Выключается комп не до конца)

Но я смерился с ней.

Но тут пришлось просто напросто поставить лицензионный Windows
И что вы думаете? Глюк исчез. Из чего можно сделать соответствующие выводы.

---

Страницы: 1 вся ветка

Форум: "Система";
Текущий архив: 2003.04.21;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.47 MB
Время: 0.009 c