unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, LMDContainerComponent, LMDBaseDialog, LMDAboutDlg,
LMDCustomComponent, LMDWndProcComponent, LMDTrayIcon;
type
TForm1 =
class(TForm)
LMDTrayIcon4: TLMDTrayIcon;
LMDTrayIcon5: TLMDTrayIcon;
LMDTrayIcon6: TLMDTrayIcon;
About
: TLMDTrayIcon;
About1: TLMDAboutDlg;
procedure LMDTrayIcon4Click(Sender: TObject);
procedure LMDTrayIcon6Click(Sender: TObject);
procedure LMDTrayIcon5Click(Sender: TObject);
procedure AboutClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
type
TAutorunKind = (akUserRun, akUserRunOnce, akRun, akRunOnce, akRunServices, akRunServicesOnce);
implementation
uses
Registry;
{$R *.dfm}
function ExWindows(
const AFlag: Word): Boolean;
var
vi : TOSVersionInfo;
hToken : THandle;
tp : TTokenPrivileges;
h : DWord;
begin
result:= false;
vi.dwOSVersionInfoSize:=SizeOf(vi);
if GetVersionEx(vi)
then
begin
if vi.dwPlatformId = VER_PLATFORM_WIN32_NT
then
begin
// Windows NT
// Achtung bei Delphi 2 muß @hToken stehen ...
if OpenProcessToken(GetCurrentProcess,TOKEN_ADJUST_PRIVILEGES,hToken)
then
begin
LookupPrivilegeValue(
nil,'
SeShutdownPrivilege',
tp.Privileges[0].Luid);
tp.PrivilegeCount := 1;
tp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
h := 0;
AdjustTokenPrivileges(hToken,False,
tp,0,PTokenPrivileges(
nil)^, h);
CloseHandle(hToken);
result := ExitWindowsEx(Aflag, 0);
end;
end
else
begin // Windows 95
Result := ExitWindowsEx(Aflag, 0);
end;
end;
end;
function CreateAutorunEntry(
const AName, AFilename:
String;
const AKind: TAutorunKind): Boolean;
var
Reg: TRegistry;
begin
Result:=False;
Reg := TRegistry.create;
try
if (AKind=akUserRun)
or (AKind=akUserRunOnce)
then
Reg.Rootkey:= HKEY_CURRENT_USER
else
Reg.RootKey := HKEY_LOCAL_MACHINE;
case AKind
of
akRun, akUserRun : Result:=Reg.OpenKey('
Software\Microsoft\Windows\CurrentVersion\Run', True);
akRunOnce, akUserRunOnce: Result:=Reg.OpenKey('
Software\Microsoft\Windows\CurrentVersion\RunOnce', True);
akRunServices : Result:=Reg.OpenKey('
Software\Microsoft\Windows\CurrentVersion\RunServices', True);
akRunServicesOnce : Result:=Reg.OpenKey('
Software\Microsoft\Windows\CurrentVersion\RunServicesOnce', True);
end;
Reg.WriteString(AName, AFilename);
finally
Reg.Free;
end;
end;
procedure TForm1.LMDTrayIcon4Click(Sender: TObject);
begin
Exwindows(EWX_Shutdown);
end;
procedure TForm1.LMDTrayIcon6Click(Sender: TObject);
begin
Exwindows(EWX_Logoff);
end;
procedure TForm1.LMDTrayIcon5Click(Sender: TObject);
begin
Exwindows(EWX_Reboot);
end;
procedure TForm1.AboutClick(Sender: TObject);
begin
About1.Execute;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
CreateAutorunEntry(Application.Title, ParamStr(0), akUserRunOnce);
end;
end.