Mega Code Archive
Configuration
<![CDATA[
Config (and other specific) code for Windows NT and Windows 2000
**************************************************************************************
[from Dalldorf, Troy [Troy.Dalldorf@state.mn.us]]
[and given to Delphi.elsists.org]
We do something similar in our application (perhaps an overkill for what you
need to do), but here it is:
We have a MODULES table in the database which has MODULE_ID, PARENT_ID,
CLASS_NAME.
CLASS_NAME is the name of a Delphi WinControl (any descendant which
implements our IdoVisualModule interface).
The interface implements several methods such as:
SetConnection
GetModule : TWinControl (to be able to set the parent etc.)
Activate
Initialize
GetCaption
etc.
Then, we load a tree view from the MODULES table, which then creates all
CLASSES using:
Instance := TComponentClass(FindClass(CLASS_NAME)).Create(nil);
If this Instance supports our interface we can perform certain functions
without knowing what it does exactly.
The user can click on any node in the tree view and the module appears on
the right, we can easily change the order of these modules, remove some,
just by changing the database.
If you need more details, let me know.
HTH, Troy
**************************************************************************************
>As an example of a privIege:
>If you want to shutdown windows you call
>ExitWindowsEx(EWX_SHUTDOWN,0); Although this works fine on
>Win9x under NT it would fail, However by getting the
>SeShutdownPrivilege and then calling ExitWindowsEx
>everything works fine. (Unless the computer has be locked up
>by the Admin to prevent this.)
>
>So, somehow I must be able to write to this registry key,
>even if only from an Admin account.
>
ie something like this
procedure TfrmTimeSync.SetDateTime(dDateTime: TDateTime);
var
dSysTime: TSystemTime;
tmp, buffer: DWord;
tkp, tpko: TTokenPrivileges;
hToken: THandle;
begin
if LMDSIWindowsNT then
begin
if not OpenProcessToken(GetCurrentProcess(),
TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,
hToken) then exit;
LookupPrivilegeValue(nil, 'SE_SYSTEMTIME_NAME',
tkp.Privileges[0].Luid);
tkp.PrivilegeCount := 1;
tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
if not AdjustTokenPrivileges(hToken, FALSE, tkp, sizeof(tkp),
tpko, buffer) then exit;
end;
DateTimeToSystemTime(dDateTime, dSysTime);
SetLocalTime(dSysTime);
end;
-- Kerry Neighbour, kneighbour@simcomcity.com on 06/11/2000
ICQ #93143774
***************************************************************************
apparently, both of these sites have good info on this kind of stuff:
> http://www.jgsoftware.com/nt.htm
> http://www.wilsonc.demon.co.uk/delphi.htm
also if you want to know more about registry in general, try
http://www.delphi3000.com/article.asp?ID=1333
***************************************************************************
WINDOWS VERSION/PLATFORM ID/SERVICE PACK NUMBER
with the following code:
var
Info: TOSVersionInfo;
begin
FillChar(Info, SizeOf(Info), 0);
Info.dwOSVersionInfoSize := SizeOf(Info);
if GetVersionEx(Info) then
ShowMessage('Version: ' +
IntToStr(Info.dwMajorVersion) + '.'
+ IntToStr(Info.dwMinorVersion) + '.' +
IntToStr(Info.dwBuildNumber) + ' PlatformId: '
+ IntToStr(Info.dwPlatformId) + ' ' +
Info.szCSDVersion)
else
ShowMessage('Error');
end;
I get the string:
'Version: 2.0.2195 PlatformId: 2 Service Pack 1'
(I have a service Pack 1)
regards
***************************************************************************
re location settings
Metric := GetLocaleStr(LOCALE_SYSTEM_DEFAULT, LOCALE_IMEASURE, '') = '0';
Look up Source\Rtl\Win\Windows.pas for a whole stack of LOCALE_nnn consts.
>How do we find out which country is set in the regional settings, of more
>precisely the setting of the Measure System option (ie is it
>Metric/U.S./etc)
HTH
Ray
***************************************************************************
GET WINDOWS SYSTEM RESOURCES INFO
(* This program must be compiled using 16 bit Delphi 1
to use the equivalent of GetFreeResources in the 16 bit Toolhelp library.
This is the routine SystemHeapInfo. ToolHelp.dll is usually on
the Windows\System directory in Windows 9x/ME systems by default.
The ToolHelp routines are documented in the MSDN Library.
Interfacing this program to a 32 bit application might be simply accomplished
by writing the result to a temporary file and reading it back in the 32
bit program which spawns Getres.exe with a CreateProcess or a
ShellExecute or even a WinExec call.
In a practical application, the WinCrt unit should be omitted along with the
writes and reads to the screen and a file assigned, written to, then closed.
If the program is run under Windows NT or Windows 2000, it always returns 90% for
User and GDI resources. Hence, the 32 bit program which spawns it
should test for the current OS using a global variable for general use and setting it
perhaps as follows:
In a globally accessible unit:
type
OsVersionType = (Unknown, Win32s, WinNT3, WinNT4, WinNT5, Win95, Win98, WinME);
var
OsVersion: OsVersionType;
Anywhere where resources need to be known. e.g. in FormShow:
procedure TMainForm.FormShow(Sender: TObject);
var
Handle: Thandle;
OS: TOsVersionInfo;
DiagText: string;
NotFound :Boolean;
begin
NotFound := False;
OS.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
if GetVersionEx(OS) then
case OS.dwPlatformId of
VER_PLATFORM_WIN32_NT:
case OS.dwMajorVersion of
3: begin
OsVersion := WinNT3;
DiagText := ' WinNT 3';
end;
4: begin
OsVersion := WinNT4;
DiagText := ' WinNT 4';
end;
5: begin
OsVersion := WinNT5;
DiagText := ' WinNT 5';
end;
end;
VER_PLATFORM_WIN32_WINDOWS:
if OS.dwMajorVersion = 4 then
case OS.dwMinorVersion of
0..9: begin
OsVersion := Win95;
DiagText := ' Win95';
end;
10..89: begin
OsVersion := Win98;
DiagText := ' Win98';
end;
90..99: begin
OsVersion := WinME;
DiagText := ' WinME';
end;
end;
VER_PLATFORM_WIN32s: begin
OsVersion := Win32s;
DiagText := ' Win32s;
end;
Else
NotFound := True;
end
else
NotFound := True;
If Not NotFound Then
begin
ShowMessage('dwMajorVersion ' + IntToStr(OS.dwMajorVersion)
+' dwMinorVersion ' + IntToStr(OS.dwMinorVersion)
+ ' dwPlatformId ' + InttoStr(OS.dwPlatformId) + DiagText);
If (OSVersion in [Win32s, Win95, Win98, WinME]) then
WinExec('','getres.exe');
{do something here with the results}
end;
End;
*)
program GetRes;
uses
WinProcs, WinTypes, WinCrt;
type
TSHI = record
dwSize: LongInt;
wUserFreePercent: Integer;
wGDIFreePercent: Integer;
hUserSegment: Integer;
hGDISegment: Integer
end;
TSysHeapInfo =
procedure(var SHI : TSHI);
var
Handle: Thandle;
ISysHeapInfo : TSysHeapInfo;
SHI : TSHI;
begin
SHI.dwSize := SizeOf(TSHI);
Handle := LoadLibrary('TOOLHELP.DLL');
if (Handle <> 0) then
begin
@ISysHeapInfo := GetProcAddress(Handle, 'SYSTEMHEAPINFO');
if (@ISysHeapInfo <> nil) then
begin
ISysHeapInfo(SHI);
With SHI do
Write('User % ', wUserFreePercent,
' GDI % ', wGDIFreePercent,
' UserSegment ', hUserSegment,
' GDISegment ', hGDISegment);
end
else
Write('SystemHeapInfo not found');
FreeLibrary(Handle);
end
else
Write('ToolHelp not found');
ReadLn;
DoneWinCrt;
end.
***************************************************************************
> There are any way to know the name of the server a user Logon?
In your login batch file, you can use the variable %username% which will be
filled with the users login name. You can use that to launch your own
program in the batch file...
Todd Lang
***************************************************************************
CUSTOMISE THE SYTEM MENU:
procedure TForm1.Button1Click(Sender: TObject);
var
hSysMenu : HMENU;
iCount : integer;
begin
hSysMenu := GetSystemMenu(Handle, False);
iCount := GetMenuItemCount(hSysMenu);
ShowMessage(IntToStr(iCount));
{ delete the Size system menu item }
DeleteMenu(hSysMenu, 2, MF_BYPOSITION);
iCount := GetMenuItemCount(hSysMenu);
ShowMessage(IntToStr(iCount));
end;
Regards
Theo
ALSO (RE CUSTOMISE THE SYTEM MENU)
There is a component on DSP called TSysCmd or
TSysCommand (not exactly sure), it works very well and is
freeware I believe.
********************************************************************************
WIN2K STARTUP
On Thu, 23 Nov 2000, Robert Meek wrote:
> HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run
>
> When the OS boots up, this will cause the application to start
> automatically, just as if a shortcut had been added to the "Startup" folder.
I don't think the two are _exactly_ the same. Holding down the Shift key
suppresses the Startup folder's items from running. I'm not sure the
registry's items can be disabled like that. This difference (if there
really is one) shouldn't be an issue for your INI-access problems, though.
> The value used in the Registry entry is exactly the same as in the
> command-line or shortcut method...the full path and exe name with one
> parameter added: "\A".
Before you go any further, try using a different parameter. The usual
parameter indicators are slashes (/) and dashes (-), not backslashes (\).
Backslash is a file name separator. In fact, the registry might be
getting confused since backslash is also an escape character in C.
> But on my laptop, when I browse to the exe file, it places the same
> entry on the command-line, but with the addition of placing it in quotes
> because on my laptop the path to the exe includes being under the "Program
> Files" sub-directory. This shouldn't cause a problem one would think, but
> although it will run from there left untouched, as soon as I add the
> parameter, ( YES, inside the quotes! ), or do so and delete the quotes, I
> get an error that the path is incorrect in the latter case, and that the exe
> cannot be found in the former!
Put quotation marks around a file name. Do not put them around the entire
command. The OS treats everything between quotation marks as a single
element. If you put your command-line argument inside the single set of
quotation marks, then it tries to run the A program in the next
subdirectory, which of course doesn't exist. If you leave off quotation
marks altogether, then the OS stops at the first space and treats
everything thereafter as command-line arguments. Put the command-line
arguments _outside_ the quotation marks.
> it makes it much more complicated because using the Registry, you cannot
> get a default value return if an entry doesn't exist. You instead get
> an exception! This means I must write all the entries up front with
> dummy values, but if there's no other way??
See the KeyExists and ValueExists functions of TRegistry. Also see the
CanCreate parameter of the OpenKey function. They all let you control how
you read registry values. If a key or value does not exist, assign a
default value instead of the one you would have read from the registry.
> Also, how does one go about running a program with parameters from a
> command-line when the line must be in quotes? Is this possible?
Realize what the quotation marks are for: grouping pieces that the OS
would normally separate. When you NEED to have a space (as when
separating parameters), simply don't quote it.
--Rob
*************************************************************************************
Rob Kennedy schrieb:
> On Tue, 28 Nov 2000, Robert Meek wrote:
>
> > Well that leads to a question...How do I tell what account a program
>> is running under?
>
> Try something like this:
> var
> pUserame: PChar;
> n: Cardinal;
> begin
> n := 50;
> pUsername := StrAlloc(n);
> WNetGetUser(nil, pUsername, n);
> MessageBox(0, 'User name', pUsername, 0);
> StrDispose(pUsername);
> end;
>
> --Rob
>
-------------------------------------
Stefan Schwarz
Dipl.-Chem.
Tel. +49 (0) 711 970-1780
eMail: schwarz@ipa.fhg.de
****************************************************************************************
> Finally, as I no longer have a Win98 or WinNT machine to test on, could
> someone please offer some well tested code for causing these two OS's to
> shut-down via code? I don't want them to reboot...just shut-down.
> Thanx kindly!
Robert,
Here is a small app I wrote (to be called by a third party program) that when
executed will shutdown the OS, NO warning! This will work correctly on NT as it
gets the required privilege!
Regards,
Anthony Richardson
anthony.richardson@sageautomation.com
*************** Start of ShutDown.DPR ***************
program ShutDown;
uses
Forms,
Windows,
Dialogs,
Priv in 'Priv.pas';
{$R *.RES}
const
SE_SHUTDOWN_NAME = 'SeShutdownPrivilege';
begin
Application.Initialize;
Application.Run;
if SetPrivilege(SE_SHUTDOWN_NAME, True) then
ExitWindowsEx(EWX_SHUTDOWN,0)
else
MessageDlg('Failed to set privilege', mtError, [mbOK],0);
end.
*************** Start of Priv.pas ***************
unit Priv;
interface
uses Windows;
function SetPrivilege(sPrivilegeName : string; bEnabled : boolean ): Boolean;
implementation
function SetPrivilege(sPrivilegeName : string; bEnabled : boolean ): boolean;
var
TPPrev,
TP : TTokenPrivileges;
Token : THandle;
dwRetLen : DWord;
WinVersion : TOSVersionInfo;
begin
Result := False;
{ These API calls only work on a WIndows NT machine, return true
automatically if running on Windows 95/98 }
WinVersion.dwOSVersionInfoSize := SizeOf(OSVERSIONINFO);
if GetVersionEx(WinVersion) then
begin
if WinVersion.dwPlatformId = VER_PLATFORM_WIN32_NT then
begin
if OpenProcessToken(GetCurrentProcess,TOKEN_ADJUST_PRIVILEGES
or TOKEN_QUERY, Token) then
begin
TP.PrivilegeCount := 1;
if(LookupPrivilegeValue(Nil, PChar(sPrivilegeName),
TP.Privileges[ 0 ].LUID))then
begin
if( bEnabled )then
begin
TP.Privileges[ 0 ].Attributes := SE_PRIVILEGE_ENABLED;
end else
begin
TP.Privileges[ 0 ].Attributes := 0;
end;
dwRetLen := 0;
Result := AdjustTokenPrivileges(Token, False, TP, SizeOf( TPPrev ),
TPPrev, dwRetLen );
end;
CloseHandle(Token);
end;
end
else
result := True;
end;
end;
end.
****************************************************************************************
> Two final glitches since moving to Win2k are still troubling me: First,
> can someone please tell me how to insure a form has focus?
Try following API functions:
- SetForegroundWindow
- BringWindowToTop
****************************************************************************************
>I would like to have a function to find the 'windows'-temp
>directory without
>the directory-exists check. Is this possible ?
See the WinAPI function GetTempPath...
****************************************************************************************
RE: Config, OS shutdown, and making forms active
> Hi Mark,
> I don't remember seeing it here, but then I'm so
> confused most of the time
> that it wouldn't surprise me that I missed it! If you get
> your hands on it,
> I'd definitely appreciate seeing it. Thanx in advance!
hi robert...
no prob..
sorry about the wait on this. we got the comp to work on both a Win95 and
NT 4 Workstation w/SP 5. one of the guys is going to test it on a win98 box
this week-end. i'll let you know what he finds out. read the comments for
the source. please note that we could NOT get the two machines we tested
this on to EWX_POWEROFF. we're not sure if it's a hardware thing or what.
enjoy
mark
the full source code for the comp follows.
============================================
(*
this code is the property of Mark Meyer and LOGS Financial Services
Inc., Northbrook, Illinois
Copyright December 1, 2000.
this code is contributed to the Delphi developer community. it is
submitted for
public use "as is" and is meant to provide a basis on which others can
learn and build.
if this code and component is of any benefit to you - please "keep the
wheel turning" by
helping others when and where you can in the programming community.
if you have any questions please contact me.
thx
mark meyer
wk: markm.hq@logs.com
hm: geeky2@gte.net
TShutDownEX is a small component written and tested in Delphi 5.0
under NT4 w/SP5.
it's purpose in life is to demonstrate
how the Win32 API's InitiateSystemShutDown and ExitWindowsEx can be
encapsulated in
a Delphi component.
i have done "some" testing in win95.
i have yet to test this under win98 or Win2K - i have attempted to make
this
work under win95 and win98 by using the GetVersion API - see DoShutDown
method
TShutDownEX is easy to use. just place it on a form and and fire it like
so:
procedure TForm1.button1click(Sender: TObject);
begin
with shutdownex1 do begin
shutdown;
end;{with}
end;
if you choose to use the InitiateSystemShutdown API (invoked by way of the
UseISS property) then you can do something like this:
procedure TForm1.Button1Click(Sender: TObject);
begin
with shutdownex1 do begin
UseISS := true;
machinename := 'machine name here';
shutdown;
end;{with}
end;
if you want to abort the shutdown (AND you are using the UseISS
property ie you are on Win2K or NT)
you can do something like this:
procedure TForm1.Button2Click(Sender: TObject);
begin
with shutdownex1 do begin
abortshutdown( "machine name here" );
end;{with}
end;
ok - now the big question - ????
why did you bother to use InitiateSystemShutDown when you could have done
everything with ExitWindowsEX ?
good question! - the nice thing about using ISS - is that it allows you
to:
1) display a warning message
2) set a "timeout" value
you can also abort the shutdown process after calling ISS:
for more info see:
http://msdn.microsoft.com/library/psdk/sysmgmt/shutdown_5vou.htm
http://msdn.microsoft.com/library/psdk/sysmgmt/shutdown_04ry.htm
i thought these were nice features so i tried to include both API's (ISS
and EWX) into a single comp.
OTOH - ExitWindowsEX works on everything - according to the MSDN
http://msdn.microsoft.com/library/psdk/sysmgmt/shutdown_3ago.htm
ok - what about version detection - ?????
good question! - the MSDN says that ISS does NOT work in Win98 and
Win95. so if we are going to let the user
pick with api they are going to call - we need to "bullet-proof" the comp
"a little" so that it does not try to
call the wrong API if it's not supported.
you can do this with either:
GetVersion()
GetVersionEX()
or VerifyVersionInfo()
all of the info on these API's is located at
http://search.microsoft.com/us/dev/default.asp
just do a search on the API you want to know about.
notes:
the following features come into play when you have the UseISS property
set to true:
// use a Win32 API or just leave this set to blank for the current machine
MachineName : string read GetMachineName write SetMachineName;
// what you want to show on the monitor while the shutdown process is
commencing
DisplayMessage : string read GetDisplayMessage write SetDisplayMessage;
// how many seconds until the shut down process is invoked
TimeOut : DWORD read GetTimeOut write SetTimeOut default 10;
// do you want to force all open apss closed before shutdown ?
ForceAppsClosed : boolean read FForceAppsClosed write
FForceAppsClosed default true;
// do you want to reboot the machine ?
RebootAfterShutDown : boolean read FRebootAfterShutDown write
FRebootAfterShutDown default true;
// this does the dirty work - see example above
ShutDown;
// used to abort the shut down process - see example above
AbortShutDown(value : string);
if you DO NOT have the UseISS property set to true then you are essetially
telling the comp that you want to call the EWX API.
btw: if you don't have an OS on your box that supports ISS - the comp will
call EWX for you.
the following properties come into play when you have the UseISS property
set to false OR
your OS does not support ISS.
property ShutDownOptions: TShutDownOption read FShutDownOption write
SetShutDownOption default ewxSHUTDOWN;
one last thing:
you can use this comp to get OS version info for yourself. please see the
following properties. they are all set
upon comp creation:
property MajorVersion : DWORD read FMajorVersion;
property MinorVersion : DWORD read FMinorVersion;
property BuildNumber : DWORD read FBuildNumber;
property PlatformID : DWORD read FPlatformID;
property CSDVersion : string read FCSDVersion;
if you want more info on these - see the MSDN:
this is for GetVersionEX
http://msdn.microsoft.com/library/psdk/sysmgmt/sysinfo_49iw.htm
and
this is for OSVERSIONINFO struct
http://msdn.microsoft.com/library/psdk/sysmgmt/sysinfo_3a0i.htm
and
this is for OSVERSIONINFOEX struct
please note that you will have to implement this youself - it is NOT
defined in the Windows.pas file
http://msdn.microsoft.com/library/psdk/sysmgmt/sysinfo_1o1e.htm
*)
unit ShutDownEX;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
winsvc;
type
ENOVersionInfoAvailable = class(exception);
// security options
TShutDownOption =
(ewxLOGOFF,ewxPOWEROFF,ewxREBOOT,ewxSHUTDOWN,ewxFORCE,ewxFORCEIFHUNG);
TShutDownOptions = set of TShutDownOption;
TShutDownEX = class(TComponent)
private
{ Private declarations }
// used specifically when call the InitiateSystemShutDown Win32 API
// see the MSDN for more info
FMachineName : string;
FDisplayMessage : string;
FTimeOut : DWORD;
FForceAppsClosed : boolean;
FRebootAfterShutDown : boolean;
FShutDownOption : TShutDownOption;
// this switch is used to tell the comp whether
// is should "attempt" to call the IntiateSystemShutDown API
// if the OS does not support it - the comp will
// call ExitWindowsEX
FUseISS : boolean;
// used for version determination in GetVersionInformation
FMajorVersion : DWORD;
FMinorVersion : DWORD;
FBuildNumber : DWORD;
FPlatformID : DWORD;
FCSDVersion : string;
// used for version determination in GetVersionInformation
function GetMachineName : string;
function GetDisplayMessage : string;
function GetTimeOut : DWORD;
function GetShutDownPriv : boolean;
function GetVersionInformation : boolean;
procedure SetMachineName (value : string);
procedure SetDisplayMessage(value : string);
procedure SetTimeOut (value : DWORD);
procedure SetShutDownOption(value : TShutDownOption);
procedure DoShutDown;
procedure DoExitWindowsEX;
protected
{ Protected declarations }
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure AbortShutDown(value : string);
procedure ShutDown;
property MajorVersion : DWORD read FMajorVersion;
property MinorVersion : DWORD read FMinorVersion;
property BuildNumber : DWORD read FBuildNumber;
property PlatformID : DWORD read FPlatformID;
property CSDVersion : string read FCSDVersion;
published
{ Published declarations }
property MachineName : string read GetMachineName write SetMachineName;
property DisplayMessage : string read GetDisplayMessage write
SetDisplayMessage;
property TimeOut : DWORD read GetTimeOut write SetTimeOut default 10;
property ForceAppsClosed : boolean read FForceAppsClosed write
FForceAppsClosed default true;
property RebootAfterShutDown : boolean read FRebootAfterShutDown write
FRebootAfterShutDown default true;
property UseISS : boolean read FUseISS write FUseISS default false;
property ShutDownOptions: TShutDownOption read FShutDownOption write
SetShutDownOption default ewxSHUTDOWN;
end;
procedure Register;
implementation
const
SE_SHUTDOWN_NAME = 'SeShutdownPrivilege';
constructor TShutDownEX.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
// we call this twice - once upon comp creation
// for courtesy mostly and just before we attempt to
// shutdown the machine.
// let the user know if we cannot get the info
if not(GetVersionInformation) then
raise ENOVersionInfoAvailable.create('Could not Get OS
Version info');
end;
destructor TShutDownEX.Destroy;
begin
inherited destroy;
end;
// ===================== Start of functions ========================
function TShutDownEX.GetMachineName : string;
begin
result := FMachineName;
end;
function TShutDownEX.GetDisplayMessage : string;
begin
result := FDisplayMessage;
end;
function TShutDownEX.GetTimeOut : DWORD;
begin
result := FTimeOut;
end;
function TShutDownEX.GetShutDownPriv : boolean;
var
htoken : thandle;
tkp : ttokenprivileges;
p : ttokenprivileges;
retlen : dword;
reply : dword;
begin
result := false;
if openprocesstoken(getcurrentprocess, TOKEN_ADJUST_PRIVILEGES OR
TOKEN_QUERY, htoken) then begin
if lookupprivilegevalue(nil,SE_SHUTDOWN_NAME,tkp.privileges[0].luid)
then begin
tkp.privilegecount := 1;
tkp.Privileges[0].attributes := se_privilege_enabled;
adjusttokenprivileges(htoken,false,tkp,sizeof(tkp),p,retlen);
reply := getlasterror;
if reply = error_success then begin
result := true;
end;{if}
end;{if}
end;{if}
end;
function TShutDownEX.GetVersionInformation : boolean;
var
osvi : TOSVersionInfo;
begin
result := false;
osvi.dwOSVersionInfoSize := sizeof(TOSVersionInfo);
if (GetVersionEX(osvi)) then begin
FMajorVersion := osvi.dwMajorVersion;
FMinorVersion := osvi.dwMinorVersion;
FBuildNumber := osvi.dwBuildNumber;
FPlatformID := osvi.dwPlatformId;
FCSDVersion := osvi.szCSDVersion;
result := true;
end;{if}
end;
// ===================== End of functions ========================
// ===================== Start of Procedures ========================
procedure TShutDownEX.SetShutDownOption(value: TShutDownOption);
begin
if (FShutDownOption <> value) then begin
FShutDownOption := value;
end;{if}
end;
procedure TShutDownEX.SetMachineName (value : string);
begin
if (value <> FMachineName) then begin
FMachineName := value;
end;
end;
procedure TShutDownEX.SetDisplayMessage(value : string);
begin
if (value <> FDisplayMessage) then begin
FDisplayMessage := value;
end;
end;
procedure TShutDownEX.SetTimeOut (value : DWORD);
begin
if (value <> FTimeOut) then begin
FTimeOut := value;
end;
end;
procedure TShutDownEX.DoShutDown;
begin
// check for Windows OS
if not (GetVersionInformation) then
raise ENOVersionInfoAvailable.create('Could not Get OS Version
info');
// see if this is a Win95 or 98 box
if (PlatformID = VER_PLATFORM_WIN32_WINDOWS) then begin
// ok this is either a Win95 or 98 - so you CANNOT use
// InitiateSystemShutdown API - we will not even look at the
UseISS property
DoExitWindowsEX;
end{if}
else begin
// ok this is either a WINNT or WIN2K box - so go from there
// user has a choice on whether they want to use the
// InitiateSystemShutdown API or the ExitWindowsEX API
// first things first - see if they have the privs to do this
if (GetShutDownPriv) then begin
// check to see if they want to use ExitWindowsEX or
InitiateSystemShutDown
if (UseISS) then begin
initiatesystemshutdown(pchar(FMachineName),pchar(FDisplayMessage),FTimeOut,F
ForceAppsClosed,FRebootAfterShutDown);
end{if}
else begin
// ok - user must want to use ExitWindowsEX API
DoExitWindowsEX;
end;{else}
end{if}
else begin
// sorry - you cannot get do this
messagedlg('you do not have sufficient right to to
execute InitiateSystemShutDown()',mterror,[mbok],0);
end;
end;{else}
end;
procedure TShutDownEX.DoExitWindowsEX;
var
uFlags :UINT;
begin
uFlags := NULL;
// build the options
if (ewxLOGOFF = FShutDownOption) then
uFlags := EWX_LOGOFF
else if (ewxPOWEROFF = FShutDownOption) then
uFlags := EWX_POWEROFF
else if (ewxREBOOT = FShutDownOption) then
uFlags := EWX_REBOOT
else if (ewxSHUTDOWN = FShutDownOption) then
uFlags := EWX_SHUTDOWN
else if (ewxFORCE = FShutDownOption) then
uFlags := EWX_FORCE
else if (ewxFORCEIFHUNG = FShutDownOption) then
uFlags := EWX_FORCEIFHUNG
else uFlags := EWX_SHUTDOWN;
ExitWindowsEX(uFlags,DWORD(0));
end;
procedure TShutDownEX.AbortShutDown(value : string);
begin
abortsystemshutdown(pchar(FMachineName));
end;
procedure TShutDownEX.ShutDown;
begin
DoShutDown;
end;
procedure Register;
begin
RegisterComponents('Samples', [TShutDownEX]);
end;
end.
_______________________________________________
Delphi mailing list -> Delphi@elists.org
http://elists.org/mailman/listinfo/delphi
****************************************************************************************
WINDOWS DIRECTORY
Try
var
WindowsDir: String;
begin
WindowsDir := GetEnvironmentString('windir');
end;
This is defined in WinUtils and will retrieve all the Windows environment variable
values for you. You can use the direct API call GetEnvironmentVariable instead
which is something like GetEnvironmentVariable('windir', envVar, SizeOf(envVar))
where envVar would be defined as array[0..MAXPATH] of Char.
You can also use this to get the full Path variable, Comspec, which is the
command line processor i.e. cmd.exe and TmpDir the windows temp directory.
****************************************************************************************
W2K reverses the bytes of the disk serial number with
GetVolumeInformation().
****************************************************************************************
source code follows for TNTServiceList
(*
this code is the property of Mark Meyer and LOGS Financial Service
Inc., Northbrook, Illinois
Copyright October 2000.
this code is contributed to the Delphi developer community. it is
submitted for
public use "as is" and is meant to provide a basis on which others can
learn and build.
i originally found this code out on the Borland Win32 newsgroup written
for D3 and rewrote it
as a component using D5.
if this code and component is of any benefit to you - please "keep the
wheel turning" by
helping others when and where you can in the programming community.
if you have any questions please contact me.
thx
mark meyer
wk: markm.hq@logs.com
hm: geeky2@gte.net
*)
unit NTServiceList;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
WinSvc;
type
PMyServices =^TMyServices;
TMyServices = array[0..255] of TEnumServiceStatus;
type
TNTServiceList = class(TComponent)
private
{ Private declarations }
FServiceList : TStringlist;
FServer : string;
FSCManagerHandle : HWND;
function Display_status(status_code:DWORD):string;
function GetEnumPriv : boolean;
function GetServer : string;
function GetServiceList : tstringlist;
procedure SetServer (value : string);
procedure DoServiceList;
protected
{ Protected declarations }
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
{ Published declarations }
property Server : string read GetServer write SetServer;
property ServiceList : tstringlist read GetServiceList;
end;
procedure Register;
const
SERVICE_WIN32_OWN_PROCESS = $00000010;
SERVICE_WIN32_SHARE_PROCESS = $00000020;
SERVICE_WIN32 = (SERVICE_WIN32_OWN_PROCESS or
SERVICE_WIN32_SHARE_PROCESS);
SERVICE_ACTIVE = 1;
SERVICE_INACTIVE = 2;
SERVICE_STATE_ALL = SERVICE_ACTIVE + SERVICE_INACTIVE;
implementation
constructor TNTServiceList.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FServiceList := tstringlist.Create;
// DoServiceList;
end;
destructor TNTServiceList.Destroy;
begin
FServiceList.destroy;
inherited destroy;
end;
function TNTServiceList.GetServiceList : TStringlist;
begin
DoServiceList;
result := FServiceList;
end;
procedure Register;
begin
RegisterComponents('Samples', [TNTServiceList]);
end;
function TNTServiceList.GetServer : string;
begin
result := FServer;
end;
procedure TNTServiceList.SetServer(value : string);
begin
if (value <> FServer) then
FServer := value;
end;
function TNTServiceList.GetEnumPriv : boolean;
var
htoken : thandle;
tkp : ttokenprivileges;
p : ttokenprivileges;
retlen : dword;
reply : dword;
begin
result := false;
if openprocesstoken(getcurrentprocess, TOKEN_ADJUST_PRIVILEGES OR
TOKEN_QUERY, htoken) then begin
if
lookupprivilegevalue(nil,'seshutdownprivilege',tkp.privileges[0].luid) then
begin
tkp.privilegecount := 1;
tkp.Privileges[0].attributes := SE_PRIVILEGE_ENABLED;
adjusttokenprivileges(htoken,false,tkp,sizeof(tkp),p,retlen);
reply := getlasterror;
if reply = error_success then begin
result := true;
end;{if}
end;{if}
end;{if}
end;
procedure TNTServiceList.DoServiceList;
var
ResumeHandle: DWORD;
Buff : Integer;
BytesNeeded : DWORD;
NumberOfServices : DWORD;
x :Integer;
MyPointer: PMyServices;
Re: Boolean;
displayname : string;
currentstate : DWORD;
display_currentstate : string;
servicename : string;
servername : string;
begin
screen.cursor:=crHourglass;
new(MyPointer);
try
FSCManagerHandle :=0;
ResumeHandle:=0;
Buff:=4048;
Bytesneeded:=0;
Numberofservices:=0;
if (getenumpriv) then begin
FSCManagerHandle :=
openscmanager(pchar(FServer),nil,SC_MANAGER_ALL_ACCESS);
end{if}
else begin
exit;
end;
if FSCManagerHandle <> 0 then
re:=EnumServicesStatus(FSCManagerHandle,
SERVICE_WIN32,
SERVICE_STATE_ALL,
MyPointer^[0],
Buff,
Bytesneeded,
NumberOfServices,
ResumeHandle);
FServiceList.clear;
for x := 0 to NumberofServices - 1 do begin
displayname := StrPas(MyPointer^[x].lpDisplayName);
servicename := strpas(mypointer^[x].lpservicename);
currentstate := mypointer^[x].servicestatus.dwcurrentstate;
display_currentstate := display_status(currentstate);
FServiceList.Add(servicename + ' : ' +
display_status(currentstate));
end;{for}
finally{try-finally}
dispose(MyPointer);
end;
screen.cursor:=crDefault;
end;
function TNTServiceList.Display_status(status_code:DWORD):string;
var
temp : string;
begin
case status_code of
SERVICE_STOPPED : temp := 'STOPPED';
SERVICE_START_PENDING : temp :=
'START_PENDING';
SERVICE_STOP_PENDING : temp :=
'STOP_PENDING';
SERVICE_RUNNING : temp := 'RUNNING';
SERVICE_CONTINUE_PENDING : temp :=
'CONTINUE_PENDING';
SERVICE_PAUSE_PENDING : temp :=
'PAUSE_PENDING';
SERVICE_PAUSED : temp := 'PAUSED';
end;{case}
result := temp;
end;
end.
****************************************************************************************
[more DISK SERIAL NUMBER code]
This is what I use:
function GetOSInformation: String;
begin
Result := '';
case Win32Platform of
0: Result := '32s';
1: begin
if Win32MinorVersion > 89 then
Result := 'ME'
else
if Win32MinorVersion > 9 then
begin
Result := '98';
if Win32BuildNumber = 2222 then
Result := Result + ' SE';
end
else
Result := '95';
end;
2: begin
if Win32MajorVersion = 5 then
begin
if Win32BuildNumber >= 2195 then
Result := '2000'
else
Result := '2000 RC/Beta';
end
else
Result := 'NT';
end;
else
Result := UNKNOWNTEXT;
end;
Result := 'Windows ' + Result + ' ' +
IntToStr(Win32MajorVersion) + '.' +
IntToStr(Win32MinorVersion) + '.' +
IntToStr(Win32BuildNumber);
end;
----- Original Message -----
From: "Raymond Kennington" <raymondk@chariot.net.au>
To: <delphi@elists.org>
Sent: Wednesday, December 13, 2000 20:04
Subject: Why does W2k reverses the order of the disk serial number?
> How can I write code with D4 on NT4 to determine if the operating system
that the code is
> running on is W2k?
>
> This is needed because W2K reverses the bytes of the disk serial number
with
> GetVolumeInformation().
>
> Raymond.
****************************************************************************************
function Get_DiskSerialNo(DriveID : string) : string;
var
VolumeSerialNumber : DWORD;
MaximumComponentLength : DWORD;
FileSystemFlags : DWORD;
begin
Get_DiskSerialNo := '';
try
GetVolumeInformation(PChar(DriveID ),
nil, 0, @VolumeSerialNumber,
MaximumComponentLength, FileSystemFlags,
nil, 0);
Get_DiskSerialNo := IntToHex(HiWord(VolumeSerialNumber), 4)+IntToHex(LoWord(VolumeSerialNumber), 4)
except
end;
end;
****************************************************************************************
REGISTRY ACCESS
Preface your calls to HKLM with
rg.Access := KEY_ALL_ACCESS; //for W2K and HKLM
****************************************************************************************
> > Can someone comment on using TRegistry to write to HKEY_LOCAL_MACHINE?
I
> > have been doing experiments with D5 today and it appears that if you do
not
> > have at least Power User permissions under NT or Win2000, you are not
> > allowed to write to that root key.
>
> That is correct, Windows NT/2K is very picky about who can and can't write
to
> any part of the registry except HKEY_CURRENT_USER.
>
> I looked for a way around this earlier, but got nowhere. Good Luck, I
would be
> interested in the solution if you can find one.
That is not correct, there is (of course) a way around it. I was once
working with a programme, which should install itself on such a machine. The
only problem I still have is that I cannot read from the registry, but I can
still delete entries from the registry!
The trick is to create a *.reg file and execute it!
DO NOTE that winNT will ask whether the user wants to add this to the
registry, therefore the user must answer yes.
I do not delete the file in here, but at any time during startup (I save the
name in the inifile, and delete it if present)
The code goes as follows below.
Best rgds
Sonnich
try
{try to install directly}
MyReg.WriteString('PolinfoNewsreader', TempStr);
except
{if failed to write to the registry (due to system rights), then
create
a registry file and run it. In that case the registry can be reached
even when there is not rights!
Deleting from the registry is possible at all times!}
{create filename}
GetTempPath(80, TPath);
TempStr2 := StrPas(TPath);
if TempStr2[Length(TempStr2)] = '\' then
TempStr2 := Copy(TempStr2, 1, Length(TempStr2) - 1);
TempStr2 := TempStr2 + '\instpol.reg';
{create file}
AssignFile(fReg, TempStr2);
Rewrite(fReg);
WriteLn(fReg, 'REGEDIT4');
WriteLn(fReg,
'[HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run]');
{replace all backslashes with doubles (.REG format) }
TempStr2 := '';
for i := 1 to Length(TempStr) do
if TempStr[i] = '\' then
TempStr2 := TempStr2 + '\\'
else
TempStr2 := TempStr2 + TempStr[i];
WriteLn(fReg, '"PolinfoNewsreader"="' + TempStr2 + '"');
CloseFile(fReg);
{execute the REG file}
ShellExecute(Self.Handle, 'open', TPath, nil, nil, SW_NORMAL);
end;
****************************************************************************************
Use SetFileAttributes (Win32API)
SetFileAttributes(PChar('SomeFile.txt'), FILE_ATTRIBUTE_NORMAL);
****************************************************************************************
WIN2K USER NAMES...
------------------------------------------------------------
>Does anyone know how I can get, using Delphi 5,
> the user who is logged on to Windows NT?
function NetGetUser : String;
var
nLength : DWORD;
begin
nLength := 128;
SetLength(Result, nLength);
WNetGetUser(nil, @Result[1], nLength);
SetLength(Result, StrLen(@Result[1]));
end;
--
francois.piette@overbyte.be
http://www.overbyte.be
-----------------------------------------
Hi-
the function you need is GetUserName. An excerpt from MSDN:
GetUserName
The GetUserName function retrieves the user name of the current thread. This
is the name of the user currently logged onto the system.
BOOL GetUserName(
LPTSTR lpBuffer, // address of name buffer
LPDWORD nSize // address of size of name buffer
);
Because this involves the usual API annoyance of allocating buffers, testing
to see if the buffer is large enough, etc etc, I wrote a wrapper fn:
function GetUserNameStr(): String;
// this function gets the NT UserName of the user owning the thread calling,
// unless the thread is impersonating, in which case it returns the user
// name of the impersonated user.
var
lUserLen: Cardinal;
begin
lUserLen := 255;
SetLength(Result,lUserLen);
if not GetUserName(PChar(Result),lUserLen) then
// maybe the buffer wasn't large enough?- in that case lUserLen will
have been reset
begin
SetLength(Result,lUserLen);
if not GetUserName(PCHar(Result),lUserLen) then
RaiseLastWin32Error;
end;
SetLength(Result,StrLen(PChar(Result)));
end;
You don't need to worry about impersonation unless you are writing code
which
will be run in a COM server, or other server code which needs to use the
security context of an outside caller (named pipes comms, etc).
-------------------------------------------------
OR (a simple version of the above):
Try this:
procedure TForm1.Button1Click(Sender: TObject);
function PUB_GetNetUserName : String;
var
Pc: PChar;
Sz: DWORD;
Begin
Result := 'xxxx';
Sz := 50+1;
Pc := StrAlloc(Sz);
try
if GetUserName(Pc, Sz) then
Result := UpperCase(Pc);
finally
StrDispose(Pc);
end;
end;
begin
Showmessage(PUB_GetNetUserName);
end;
****************************************************************************************
The GetSystemDirectory function retrieves the path of the Windows system
directory. The system directory contains such files as Windows libraries,
drivers, and font files.
UINT GetSystemDirectory(
LPTSTR lpBuffer, // address of buffer for system directory
UINT uSize // size of directory buffer
);
****************************************************************************************
ForceDirectories (VERY USEFUL)
I'm not sure if I get what you want, but you might give the OLH
a look for "ForceDirectories()". This function creates all dirs
necessary to create the last one
(you give it "D:\Test\This\New\Dir", and it will create all new
dirs...)
There is a function called forcedirectories. Just call this function for
every leaf node you have in your directory tree
Quoted from Delphi help file :
//BEGIN QUOTE
ForceDirectories function
Creates all the directories along a directory path if they do not already
exist.
Unit
FileCtrl
Category
file management routines
function ForceDirectories(Dir: string): Boolean;
Description
DOS and Windows only allow directories to be created one at a time. For
example, to create the C:\APPS\SALES\LOCAL directory, the APPS and SALES
directories must exist before the LOCAL directory can be created. Use
ForceDirectories to create a directory and all parent directories that do
not already exist.
ForceDirectories returns True if it successfully creates all necessary
directories, False if it could not create a needed directory.
Note: Do not call ForceDirectories with an empty string. Doing so causes
ForceDirectories to raise an exception.
// END QUOTE
]]>