Windows: Calling a WMI function using FreePascal -- Working example? - winapi

I am looking for sample code on how to call a WMI function. Does anyone has a working example in FreePascal, ideally including code on how to pass parameters to the function? Unfortunately, the "Delphi WMI code Creator" does not help me as the FreePascal code for creating a function does not work.
Just to be clear: This is not about querying WMI properties, but calling a function like Win32_Printer.AddPrinterConnection (just to name an example).

I found a piece of Delphi code that set up many of the standard objects in the same way as Drake Wu's C++ example did.
I was interested in that example because I'm interested in edids, so I fully translated said C++ article's solution to Delphi/FPC. It seems to work.
program wmiedidint2;
// based on https://theroadtodelphi.com/2011/04/21/accesing-the-wmi-from-delphi-and-fpc-via-com-without-late-binding-or-wbemscripting_tlb/
// modified to function as https://learn.microsoft.com/en-us/answers/questions/95631/wmi-c-application-problem-wmimonitordescriptormeth.html?childToView=96407#answer-96407
{$IFDEF FPC}
{$MODE DELPHI} {$H+}
{$ENDIF}
{$APPTYPE CONSOLE}
uses
Windows,
Variants,
SysUtils,
ActiveX,
JwaWbemCli;
const
RPC_C_AUTHN_LEVEL_DEFAULT = 0;
RPC_C_IMP_LEVEL_IMPERSONATE = 3;
RPC_C_AUTHN_WINNT = 10;
RPC_C_AUTHZ_NONE = 0;
RPC_C_AUTHN_LEVEL_CALL = 3;
EOAC_NONE = 0;
function GetBytesFromVariant(const V: Variant): TBytes;
// this function is a mess and only works for bytes. From SO
var
Len: Integer;
SafeArray: PVarArray;
begin
Len := 1+VarArrayHighBound(v, 1)-VarArrayLowBound(v, 1);
SetLength(Result, Len);
SafeArray := VarArrayAsPSafeArray(V);
Move(SafeArray.Data^, Pointer(Result)^, Length(result)*SizeOf(result[0]));
end;
procedure Test_IWbemServices_ExecQuery;
const
strLocale = '';
strUser = '';
strPassword = '';
strNetworkResource = 'root\WMI';
strAuthority = '';
WQL = 'SELECT * FROM WmiMonitorDescriptorMethods';
EDIDMethodname = 'WmiGetMonitorRawEEdidV1Block';
EDIDClassName = 'WmiMonitorDescriptorMethods';
var
FWbemLocator : IWbemLocator;
FWbemServices : IWbemServices;
FUnsecuredApartment : IUnsecuredApartment;
ppEnum : IEnumWbemClassObject;
apObjects : IWbemClassObject;
puReturned : ULONG;
pVal : OleVariant;
pType : Integer;
plFlavor : Integer;
Succeed : HRESULT;
varreturnvalue : olevariant;
varotherval : longint;
varcmd2 : tagVariant;
varcommand : olevariant; // tagVARIANT;
pOutParamsDefinition,
pInParamsDefinition,
pClass,
pClassInstance : IWbemClassObject;
callres : IWbemCallResult;
err : IErrorInfo;
aname,w2 : Widestring;
bytes : TBytes;
i : integer;
procedure teststatus(const msg:string);
begin
if Succeeded(succeed) then
writeln('Successs:',msg)
else
writeln('Fail:',msg)
end;
begin
// Set general COM security levels --------------------------
// Note: If you are using Windows 2000, you need to specify -
// the default authentication credentials for a user by using
// a SOLE_AUTHENTICATION_LIST structure in the pAuthList ----
// parameter of CoInitializeSecurity ------------------------
if Failed(CoInitializeSecurity(nil, -1, nil, nil, RPC_C_AUTHN_LEVEL_DEFAULT, RPC_C_IMP_LEVEL_IMPERSONATE, nil, EOAC_NONE, nil)) then Exit;
// Obtain the initial locator to WMI -------------------------
if Succeeded(CoCreateInstance(CLSID_WbemLocator, nil, CLSCTX_INPROC_SERVER, IID_IWbemLocator, FWbemLocator)) then
try
// Connect to WMI through the IWbemLocator::ConnectServer method
if Succeeded(FWbemLocator.ConnectServer(strNetworkResource, strUser, strPassword, strLocale, WBEM_FLAG_CONNECT_USE_MAX_WAIT, strAuthority, nil, FWbemServices)) then
try
// Set security levels on the proxy -------------------------
if Failed(CoSetProxyBlanket(FWbemServices, RPC_C_AUTHN_WINNT, RPC_C_AUTHZ_NONE, nil, RPC_C_AUTHN_LEVEL_CALL, RPC_C_IMP_LEVEL_IMPERSONATE, nil, EOAC_NONE)) then Exit;
if Succeeded(CoCreateInstance(CLSID_UnsecuredApartment, nil, CLSCTX_LOCAL_SERVER, IID_IUnsecuredApartment, FUnsecuredApartment)) then
try
// Use the IWbemServices pointer to make requests of WMI
//Succeed := FWbemServices.ExecQuery('WQL', WQL, WBEM_FLAG_FORWARD_ONLY OR WBEM_FLAG_RETURN_IMMEDIATELY, nil, ppEnum);
Succeed := FWbemServices.ExecQuery('WQL', WQL, WBEM_FLAG_FORWARD_ONLY, nil, ppEnum);
if Succeeded(Succeed) then
begin
Writeln('Running Wmi Query..Press Enter to exit');
// Get the data from the query
while (ppEnum.Next(WBEM_INFINITE, 1, apObjects, puReturned)=0) do
begin
succeed:= apObjects.Get('__PATH', 0, pVal, pType, plFlavor);
teststatus('get __PATH');
aname:=pval;
writeln('__PATH: ',aname);
succeed:=fwbemservices.GetObject(edidclassname,0,nil,pClass,callres);
teststatus('getobject');
succeed:=pClass.GetMethod(EDIDMethodname,0,pInParamsDefinition,pOutParamsDefinition);
teststatus('getmethod');
succeed:=pInParamsDefinition.SpawnInstance(0, pClassInstance);
teststatus('Spawn');
fillchar(varcmd2,sizeof(varcommand),#0);
varcmd2.vt:=VT_UI1;
varcmd2.bval:=0;
move(varcmd2,varcommand,sizeof(varcmd2));
succeed:= pClassInstance.Put('BlockId',0,#VarCommand,0);
teststatus('put blockid');
writeln('The BlockId is: ,',varCommand);
pOutParamsDefinition:=Nil;
callres:=nil;
w2:=EDIDMethodname;
succeed:= fwbemservices.ExecMethod(aname,w2,0,nil,pClassInstance,pOutParamsDefinition,callres);
if succeeded(succeed) then
begin
writeln('execute success!');
end;
succeed:= pOutParamsDefinition.Get('BlockType', 0, varreturnvalue,ptype,plFlavor);
if succeeded(succeed) then
begin
writeln('blocktype:',varreturnvalue);
varotherval:=varreturnvalue;
if varotherval=1 then
begin
succeed:= pOutParamsDefinition.Get('BlockContent', 0, varreturnvalue,ptype,plFlavor);
if succeeded(succeed) then
begin
bytes:=GetBytesFromVariant(varreturnvalue);
write('bytes:');
for i:=0 to length(bytes)-1 do
begin
write('$',inttohex(bytes[i],2),' ');
end;
writeln;
end;
end;
end;
end;
end
else
Writeln(Format('Error executing WQL sentence %x',[Succeed]));
finally
FUnsecuredApartment := nil;
end;
finally
FWbemServices := nil;
end;
finally
FWbemLocator := nil;
end;
end;
begin
// Initialize COM. ------------------------------------------
if Succeeded(CoInitializeEx(nil, COINIT_MULTITHREADED)) then
try
Test_IWbemServices_ExecQuery;
finally
CoUninitialize();
end;
Readln;
end.
Note that the original (roadtodelphi) page also demonstrates event sinks

To call a WMI function, you need to:
Get the WMI class from IWbemServices.GetObject(ClassName)
Call IWbemClassObject.GetMethod(MethodName) to get the parameter information(In and Out Params) of the function
Pass the required value to the corresponding through a VARIANT: IWbemClassObject.Put("Name",VARIANT). Maybe just do this in pascal: objInParams.Properties_.Item('Name').Value := xxx;
Get an instance of the class and get its Object Path, and finally execute IWbemServices.ExecMethod(path,MethodName,objInParams,objOutParams).
There is also a C++ sample with WmiMonitorDescriptorMethods.WmiGetMonitorRawEEdidV1Block here, although I am not familiar with FreePascal, you could also follow the steps and convert it to FreePascal.

Related

How to get the FindData structure from the IShellItem2.GetProperty output in Delphi code?

I'm enumerating the Windows shell with IShellFolder and struggle with getting the FindData structure from the TPropVariant output of IShellItem2.GetProperty so that I can explore its content.
The question is: How do I get FindData from the TPropVariant output in Delphi code? C++ snippets don't help me in this case (that's why I'm posting, because there are several around that I haven't been able translate correctly.)
What I have is:
var
ShellItem2: IShellItem2;
ppropvar: TPropVariant;
HR: HResult;
FindData: TWin32FindData;
FileSize: Int64;
if ShellItem2.GetProperty(PKEY_FindData, ppropvar) = S_OK then
begin
//It's ok, then how do I get FindData?
//Calculate the file size, for instace.
FileSize := FindData.nFileSizeLow or Int64(FindData.nFileSizeHigh) shl 32;
end;
I can't find any formal documentation about how a WIN32_FIND_DATA is stored in a PROPVARIANT. However, based on a code snippet found in this Qt code patch, the last field of the PROPVARIANT holds a pointer to a WIN32_FIND_DATAW, so try something like this:
type
PWin32FindDataW = ^TWin32FindDataW;
PPWin32FindDataW = ^PWin32FindDataW;
var
ShellItem2: IShellItem2;
ppropvar: TPropVariant;
FindData: PWin32FindDataW;
FileSize: UInt64;
begin
...
if ShellItem2.GetProperty(PKEY_FindData, ppropvar) = S_OK then begin
FindData := PPWin32FindDataW(PByte(#ppropvar) + sizeof(ppropvar) - sizeof(Pointer))^;
// alternatively:
// FindData := PWin32FindDataW(ppropvar.caub.pElems);
if FindData <> nil then begin
FileSize := FindData.nFileSizeLow or (UInt64(FindData.nFileSizeHigh) shl 32);
...
end;
PropVariantClear(ppropvar);
end;
...
end;
function GetItemFindData(AItem: IShellItem2; out AFindData: TWin32FindDataW): Boolean;
var
PV: TPropVariant;
begin
Result := False;
PV.vt := VT_EMPTY;
if AItem.GetProperty(PKEY_FindData, PV) = S_OK then
begin
if (PV.vt = VT_UI1 or VT_VECTOR) and (PV.caub.cElems = SizeOf(AFindData)) and Assigned(PV.caub.pElems) then
begin
CopyMemory(#AFindData, PV.caub.pElems, SizeOf(AFindData));
Result := True;
end;
PropVariantClear(PV);
end;
end;

Find HID/PID in DELPHI / ARDUINO Interface

(First, I am not sure whether this question is placed in the correct section of Stack Exchange. If not so, please give me a notice and delete the question.)
I have 8 Arduino's (Ards). Some Uno's and some 2650 Mega's. In an attempt to automatize the connection process (I use Delphi D-7 SE as I/O), I want to differentate between the UNO and the 2650 (mostly because the hardware differences in the appropriate chip). The way to do this (I think), is to get the PID and VID from the board. But I don't know how to do this. The code below gives me the correct driver, but not PID/VID . Is it possible to get PID/VID for this code-snippet ?? IF so, HOW ?
Thanks a lot.
Code here:
unit ArduinoTestU;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics,
Controls, Forms, Dialogs, JVsetupAPI, Registry, StdCtrls,
CPortCtl, CPort, Menus, XPMan;
type
TMainForm = class(TForm)
ListBox1: TListBox;
Label1: TLabel;
Button1: TButton;
procedure FormCreate(Sender: TObject);
function SetupEnumAvailableComPorts : TstringList;
procedure ListBox1Click(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
ArdType : Integer;
end;
var
MainForm : TMainForm;
ComPortStringList : TStringList;
MyComPort : String;
CurDir : String;
implementation
uses Form1Unit, ArdFormU; (* , ArdFormU; *)
{$R *.dfm}
procedure TMainForm.Button1Click(Sender: TObject);
begin
MainForm.FormActivate(NIL);
end;
procedure TMainForm.FormActivate(Sender: TObject);
var
index : integer;
begin
ComPortStringList := SetupEnumAvailableComPorts;
if (ComPortStringList <> nil) and (ComPortStringList.Count > 0) then
for Index := 0 to ComPortStringList.Count - 1 do
Listbox1.Items.Add(ComPortStringList[Index]);
if Listbox1.Items.Count <> 0 then
BEGIN
Listbox1.Enabled := True;
Button1.Enabled := False;
END;
end;
procedure TMainForm.FormCreate(Sender: TObject);
BEGIN
Curdir := ExtractFileDir(Application.Exename);
end;
(*
The function below returns a list of available COM-ports
(not open by this or an other process), with friendly names. The list is formatted as follows:
COM1: = Communications Port (COM1)
COM5: = NI Serial Port (Com5)
COM6: = NI Serial Port (Com6)
COM7: = USB Serial Port (COM7)
COM8: = Bluetooth Communications Port (COM8)
COM9: = Bluetooth Communications Port (COM9)
This code originally posted at http://www.delphi3000.com/articles/article_4001.asp?SK=
errors have been fixed so it will work with Delphi 7 and SetupAPI from JVCL
*)
function TMainForm.SetupEnumAvailableComPorts : TstringList;
//
// Enumerates all serial communications ports that are available and ready to
// be used.
//
var
RequiredSize: Cardinal;
GUIDSize: DWORD;
Guid: TGUID;
DevInfoHandle: HDEVINFO;
DeviceInfoData: TSPDevInfoData;
MemberIndex: Cardinal;
PropertyRegDataType: DWord;
RegProperty: Cardinal;
RegTyp: Cardinal;
Key: Hkey;
Info: TRegKeyInfo;
S1,S2: string;
hc: THandle;
begin
Result := Nil;
//
//If we cannot access the setupapi.dll then we return a nil pointer.
//
if not LoadsetupAPI then
exit;
try
//
// get 'Ports' class guid from name
//
GUIDSize := 1; // missing from original code - need to tell function that the Guid structure contains a single GUID
if SetupDiClassGuidsFromName('Ports',#Guid,GUIDSize,RequiredSize) then
begin
//
//get object handle of 'Ports' class to interate all devices
//
DevInfoHandle := SetupDiGetClassDevs(#Guid,Nil,0,DIGCF_PRESENT);
if Cardinal(DevInfoHandle) <> Invalid_Handle_Value then
begin
try
MemberIndex := 0;
result := TStringList.Create;
//iterate device list
repeat
FillChar(DeviceInfoData,SizeOf(DeviceInfoData),0);
DeviceInfoData.cbSize := SizeOf(DeviceInfoData);
//get device info that corresponds to the next memberindex
if Not SetupDiEnumDeviceInfo(DevInfoHandle,MemberIndex,DeviceInfoData) then
break;
//query friendly device name LIKE 'BlueTooth Communication Port (COM8)' etc
RegProperty := SPDRP_FriendlyName; {SPDRP_Driver, SPDRP_SERVICE, SPDRP_ENUMERATOR_NAME,SPDRP_PHYSICAL_DEVICE_OBJECT_NAME,SPDRP_FRIENDLYNAME,}
SetupDiGetDeviceRegistryProperty(DevInfoHandle, DeviceInfoData,RegProperty, PropertyRegDataType,NIL,0,RequiredSize);
SetLength(S1,RequiredSize);
// ShowMessage('TEST: ' + S1);
if SetupDiGetDeviceRegistryProperty(DevInfoHandle,DeviceInfoData,RegProperty,PropertyRegDataType,#S1[1],RequiredSize,RequiredSize) then
begin
KEY := SetupDiOpenDevRegKey(DevInfoHandle,DeviceInfoData,DICS_FLAG_GLOBAL,0,DIREG_DEV,KEY_READ);
if key <> INValid_Handle_Value then
begin
FillChar(Info, SizeOf(Info), 0);
//query the real port name from the registry value 'PortName'
if RegQueryInfoKey(Key, nil, nil, nil, #Info.NumSubKeys,#Info.MaxSubKeyLen, nil, #Info.NumValues, #Info.MaxValueLen,
#Info.MaxDataLen, nil, #Info.FileTime) = ERROR_SUCCESS then
begin
RequiredSize := Info.MaxValueLen + 1;
SetLength(S2,RequiredSize);
if RegQueryValueEx(KEY,'PortName',Nil,#Regtyp,#s2[1],#RequiredSize) = Error_Success then
begin
If (Pos('COM',S2) = 1) then
begin
//Test if the device can be used
hc := CreateFile(pchar('\\.\' + S2 + #0), GENERIC_READ or GENERIC_WRITE,
0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
if hc <> INVALID_HANDLE_VALUE then
begin
Result.Add(Strpas(PChar(S2)) + ' := ' + StrPas(PChar(S1)));
CloseHandle(hc);
end;
end;
end;
end;
RegCloseKey(key);
end;
end;
Inc(MemberIndex);
until False;
//If we did not found any free com. port we return a NIL pointer.
if Result.Count = 0 then
begin
Result.Free;
Result := NIL;
end
finally
SetupDiDestroyDeviceInfoList(DevInfoHandle);
end;
end;
end;
finally
UnloadSetupApi;
end;
end;
procedure TMainForm.ListBox1Click(Sender: TObject);
begin
Ardtype := Listbox1.ItemIndex;
MainForm.Hide;
ArdForm.ShowModal;
if Ardform.ModalResult <> mrOK then
ShowMessage('Der opstod en fejl ')
ELSE
BEGIN
MainForm.Show;
END;
end;
end.
Kris aka snestrup2016

How to get amin rights during runtime using delphi xe5 [duplicate]

We need to change some settings to the HKEY_LOCAL_MACHINE at runtime.
Is it possible to prompt for uac elevation if needed at runtime, or do I have to launch a second elevated process to do 'the dirty work'?
i would relaunch yourself as elevated, passing command line parameters indicating what elevated thing you want to do. You can then jump right to the appropriate form, or just save your HKLM stuff.
function RunAsAdmin(hWnd: HWND; filename: string; Parameters: string): Boolean;
{
See Step 3: Redesign for UAC Compatibility (UAC)
http://msdn.microsoft.com/en-us/library/bb756922.aspx
This code is released into the public domain. No attribution required.
}
var
sei: TShellExecuteInfo;
begin
ZeroMemory(#sei, SizeOf(sei));
sei.cbSize := SizeOf(TShellExecuteInfo);
sei.Wnd := hwnd;
sei.fMask := SEE_MASK_FLAG_DDEWAIT or SEE_MASK_FLAG_NO_UI;
sei.lpVerb := PChar('runas');
sei.lpFile := PChar(Filename); // PAnsiChar;
if parameters <> '' then
sei.lpParameters := PChar(parameters); // PAnsiChar;
sei.nShow := SW_SHOWNORMAL; //Integer;
Result := ShellExecuteEx(#sei);
end;
The other Microsoft suggested solution is to create an COM object out of process (using the specially created CoCreateInstanceAsAdmin function). i don't like this idea because you have to write and register a COM object.
Note: There is no "CoCreateInstanceAsAdmin" API call. It's just some code floating around. Here's the Dephi version i stumbled around for. It is apparently based on the trick of prefixing a class guid string with the "Elevation:Administrator!new:" prefix when normally hidden code internally calls CoGetObject:
function CoGetObject(pszName: PWideChar; pBindOptions: PBindOpts3;
const iid: TIID; ppv: PPointer): HResult; stdcall; external 'ole32.dll';
procedure CoCreateInstanceAsAdmin(const Handle: HWND;
const ClassID, IID: TGuid; PInterface: PPointer);
var
BindOpts: TBindOpts3;
MonikerName: WideString;
Res: HRESULT;
begin
//This code is released into the public domain. No attribution required.
ZeroMemory(#BindOpts, Sizeof(TBindOpts3));
BindOpts.cbStruct := Sizeof(TBindOpts3);
BindOpts.hwnd := Handle;
BindOpts.dwClassContext := CLSCTX_LOCAL_SERVER;
MonikerName := 'Elevation:Administrator!new:' + GUIDToString(ClassID);
Res := CoGetObject(PWideChar(MonikerName), #BindOpts, IID, PInterface);
if Failed(Res) then
raise Exception.Create(SysErrorMessage(Res));
end;
One other question: How do you handle someone running as standard user in Windows XP?
You can't "elevate" an existing process. Elevated processes under UAC have a different token with a different LUID, different mandatory integrity level, and different group membership. This level of change can't be done within a running process - and it would be a security problem if that could happen.
You need to launch a second process elevated that would do the work or by creating a COM object that runs in an elevated dllhost.
http://msdn.microsoft.com/en-us/library/bb756922.aspx gives an example "RunAsAdmin" function and a "CoCreateInstanceAsAdmin" function.
EDIT: I just saw "Delphi" in your title. Everything I listed is obviously native, but if Delphi provides access to ShellExecute-like functionality you should be able to adapt the code from the link.
A sample of ready-to-use code:
Usage example:
unit Unit1;
interface
uses
Windows{....};
type
TForm1 = class(TForm)
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Button1: TButton;
Button2: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
procedure StartWait;
procedure EndWait;
end;
var
Form1: TForm1;
implementation
uses
RunElevatedSupport;
{$R *.dfm}
const
ArgInstallUpdate = '/install_update';
ArgRegisterExtension = '/register_global_file_associations';
procedure TForm1.FormCreate(Sender: TObject);
begin
Label1.Caption := Format('IsAdministrator: %s', [BoolToStr(IsAdministrator, True)]);
Label2.Caption := Format('IsAdministratorAccount: %s', [BoolToStr(IsAdministratorAccount, True)]);
Label3.Caption := Format('IsUACEnabled: %s', [BoolToStr(IsUACEnabled, True)]);
Label4.Caption := Format('IsElevated: %s', [BoolToStr(IsElevated, True)]);
Button1.Caption := 'Install updates';
SetButtonElevated(Button1.Handle);
Button2.Caption := 'Register file associations for all users';
SetButtonElevated(Button2.Handle);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
StartWait;
try
SetLastError(RunElevated(ArgInstallUpdate, Handle, Application.ProcessMessages));
if GetLastError <> ERROR_SUCCESS then
RaiseLastOSError;
finally
EndWait;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
StartWait;
try
SetLastError(RunElevated(ArgRegisterExtension, Handle, Application.ProcessMessages));
if GetLastError <> ERROR_SUCCESS then
RaiseLastOSError;
finally
EndWait;
end;
end;
function DoElevatedTask(const AParameters: String): Cardinal;
procedure InstallUpdate;
var
Msg: String;
begin
Msg := 'Hello from InstallUpdate!' + sLineBreak +
sLineBreak +
'This function is running elevated under full administrator rights.' + sLineBreak +
'This means that you have write-access to Program Files folder and you''re able to overwrite files (e.g. install updates).' + sLineBreak +
'However, note that your executable is still running.' + sLineBreak +
sLineBreak +
'IsAdministrator: ' + BoolToStr(IsAdministrator, True) + sLineBreak +
'IsAdministratorAccount: ' + BoolToStr(IsAdministratorAccount, True) + sLineBreak +
'IsUACEnabled: ' + BoolToStr(IsUACEnabled, True) + sLineBreak +
'IsElevated: ' + BoolToStr(IsElevated, True);
MessageBox(0, PChar(Msg), 'Hello from InstallUpdate!', MB_OK or MB_ICONINFORMATION);
end;
procedure RegisterExtension;
var
Msg: String;
begin
Msg := 'Hello from RegisterExtension!' + sLineBreak +
sLineBreak +
'This function is running elevated under full administrator rights.' + sLineBreak +
'This means that you have write-access to HKEY_LOCAL_MACHINE key and you''re able to write keys and values (e.g. register file extensions globally/for all users).' + sLineBreak +
'However, note that this is usually not a good idea. It is better to register your file extensions under HKEY_CURRENT_USER\Software\Classes.' + sLineBreak +
sLineBreak +
'IsAdministrator: ' + BoolToStr(IsAdministrator, True) + sLineBreak +
'IsAdministratorAccount: ' + BoolToStr(IsAdministratorAccount, True) + sLineBreak +
'IsUACEnabled: ' + BoolToStr(IsUACEnabled, True) + sLineBreak +
'IsElevated: ' + BoolToStr(IsElevated, True);
MessageBox(0, PChar(Msg), 'Hello from RegisterExtension!', MB_OK or MB_ICONINFORMATION);
end;
begin
Result := ERROR_SUCCESS;
if AParameters = ArgInstallUpdate then
InstallUpdate
else
if AParameters = ArgRegisterExtension then
RegisterExtension
else
Result := ERROR_GEN_FAILURE;
end;
procedure TForm1.StartWait;
begin
Cursor := crHourglass;
Screen.Cursor := crHourglass;
Button1.Enabled := False;
Button2.Enabled := False;
Application.ProcessMessages;
end;
procedure TForm1.EndWait;
begin
Cursor := crDefault;
Screen.Cursor := crDefault;
Button1.Enabled := True;
Button2.Enabled := True;
Application.ProcessMessages;
end;
initialization
OnElevateProc := DoElevatedTask;
CheckForElevatedTask;
end.
And support unit itself:
unit RunElevatedSupport;
{$WARN SYMBOL_PLATFORM OFF}
{$R+}
interface
uses
Windows;
type
TElevatedProc = function(const AParameters: String): Cardinal;
TProcessMessagesMeth = procedure of object;
var
// Warning: this function will be executed in external process.
// Do not use any global variables inside this routine!
// Use only supplied AParameters.
OnElevateProc: TElevatedProc;
// Call this routine after you have assigned OnElevateProc
procedure CheckForElevatedTask;
// Runs OnElevateProc under full administrator rights
function RunElevated(const AParameters: String; const AWnd: HWND = 0; const AProcessMessages: TProcessMessagesMeth = nil): Cardinal; overload;
function IsAdministrator: Boolean;
function IsAdministratorAccount: Boolean;
function IsUACEnabled: Boolean;
function IsElevated: Boolean;
procedure SetButtonElevated(const AButtonHandle: THandle);
implementation
uses
SysUtils, Registry, ShellAPI, ComObj;
const
RunElevatedTaskSwitch = '0CC5C50CB7D643B68CB900BF000FFFD5'; // some unique value, just a GUID with removed '[', ']', and '-'
function CheckTokenMembership(TokenHandle: THANDLE; SidToCheck: Pointer; var IsMember: BOOL): BOOL; stdcall; external advapi32 name 'CheckTokenMembership';
function RunElevated(const AParameters: String; const AWnd: HWND = 0; const AProcessMessages: TProcessMessagesMeth = nil): Cardinal; overload;
var
SEI: TShellExecuteInfo;
Host: String;
Args: String;
begin
Assert(Assigned(OnElevateProc), 'OnElevateProc must be assigned before calling RunElevated');
if IsElevated then
begin
if Assigned(OnElevateProc) then
Result := OnElevateProc(AParameters)
else
Result := ERROR_PROC_NOT_FOUND;
Exit;
end;
Host := ParamStr(0);
Args := Format('/%s %s', [RunElevatedTaskSwitch, AParameters]);
FillChar(SEI, SizeOf(SEI), 0);
SEI.cbSize := SizeOf(SEI);
SEI.fMask := SEE_MASK_NOCLOSEPROCESS;
{$IFDEF UNICODE}
SEI.fMask := SEI.fMask or SEE_MASK_UNICODE;
{$ENDIF}
SEI.Wnd := AWnd;
SEI.lpVerb := 'runas';
SEI.lpFile := PChar(Host);
SEI.lpParameters := PChar(Args);
SEI.nShow := SW_NORMAL;
if not ShellExecuteEx(#SEI) then
RaiseLastOSError;
try
Result := ERROR_GEN_FAILURE;
if Assigned(AProcessMessages) then
begin
repeat
if not GetExitCodeProcess(SEI.hProcess, Result) then
Result := ERROR_GEN_FAILURE;
AProcessMessages;
until Result <> STILL_ACTIVE;
end
else
begin
if WaitForSingleObject(SEI.hProcess, INFINITE) <> WAIT_OBJECT_0 then
if not GetExitCodeProcess(SEI.hProcess, Result) then
Result := ERROR_GEN_FAILURE;
end;
finally
CloseHandle(SEI.hProcess);
end;
end;
function IsAdministrator: Boolean;
var
psidAdmin: Pointer;
B: BOOL;
const
SECURITY_NT_AUTHORITY: TSidIdentifierAuthority = (Value: (0, 0, 0, 0, 0, 5));
SECURITY_BUILTIN_DOMAIN_RID = $00000020;
DOMAIN_ALIAS_RID_ADMINS = $00000220;
SE_GROUP_USE_FOR_DENY_ONLY = $00000010;
begin
psidAdmin := nil;
try
// Создаём SID группы админов для проверки
Win32Check(AllocateAndInitializeSid(SECURITY_NT_AUTHORITY, 2,
SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_ADMINS, 0, 0, 0, 0, 0, 0,
psidAdmin));
// Проверяем, входим ли мы в группу админов (с учётов всех проверок на disabled SID)
if CheckTokenMembership(0, psidAdmin, B) then
Result := B
else
Result := False;
finally
if psidAdmin <> nil then
FreeSid(psidAdmin);
end;
end;
{$R-}
function IsAdministratorAccount: Boolean;
var
psidAdmin: Pointer;
Token: THandle;
Count: DWORD;
TokenInfo: PTokenGroups;
HaveToken: Boolean;
I: Integer;
const
SECURITY_NT_AUTHORITY: TSidIdentifierAuthority = (Value: (0, 0, 0, 0, 0, 5));
SECURITY_BUILTIN_DOMAIN_RID = $00000020;
DOMAIN_ALIAS_RID_ADMINS = $00000220;
SE_GROUP_USE_FOR_DENY_ONLY = $00000010;
begin
Result := Win32Platform <> VER_PLATFORM_WIN32_NT;
if Result then
Exit;
psidAdmin := nil;
TokenInfo := nil;
HaveToken := False;
try
Token := 0;
HaveToken := OpenThreadToken(GetCurrentThread, TOKEN_QUERY, True, Token);
if (not HaveToken) and (GetLastError = ERROR_NO_TOKEN) then
HaveToken := OpenProcessToken(GetCurrentProcess, TOKEN_QUERY, Token);
if HaveToken then
begin
Win32Check(AllocateAndInitializeSid(SECURITY_NT_AUTHORITY, 2,
SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_ADMINS, 0, 0, 0, 0, 0, 0,
psidAdmin));
if GetTokenInformation(Token, TokenGroups, nil, 0, Count) or
(GetLastError <> ERROR_INSUFFICIENT_BUFFER) then
RaiseLastOSError;
TokenInfo := PTokenGroups(AllocMem(Count));
Win32Check(GetTokenInformation(Token, TokenGroups, TokenInfo, Count, Count));
for I := 0 to TokenInfo^.GroupCount - 1 do
begin
Result := EqualSid(psidAdmin, TokenInfo^.Groups[I].Sid);
if Result then
Break;
end;
end;
finally
if TokenInfo <> nil then
FreeMem(TokenInfo);
if HaveToken then
CloseHandle(Token);
if psidAdmin <> nil then
FreeSid(psidAdmin);
end;
end;
{$R+}
function IsUACEnabled: Boolean;
var
Reg: TRegistry;
begin
Result := CheckWin32Version(6, 0);
if Result then
begin
Reg := TRegistry.Create(KEY_READ);
try
Reg.RootKey := HKEY_LOCAL_MACHINE;
if Reg.OpenKey('\Software\Microsoft\Windows\CurrentVersion\Policies\System', False) then
if Reg.ValueExists('EnableLUA') then
Result := (Reg.ReadInteger('EnableLUA') <> 0)
else
Result := False
else
Result := False;
finally
FreeAndNil(Reg);
end;
end;
end;
function IsElevated: Boolean;
const
TokenElevation = TTokenInformationClass(20);
type
TOKEN_ELEVATION = record
TokenIsElevated: DWORD;
end;
var
TokenHandle: THandle;
ResultLength: Cardinal;
ATokenElevation: TOKEN_ELEVATION;
HaveToken: Boolean;
begin
if CheckWin32Version(6, 0) then
begin
TokenHandle := 0;
HaveToken := OpenThreadToken(GetCurrentThread, TOKEN_QUERY, True, TokenHandle);
if (not HaveToken) and (GetLastError = ERROR_NO_TOKEN) then
HaveToken := OpenProcessToken(GetCurrentProcess, TOKEN_QUERY, TokenHandle);
if HaveToken then
begin
try
ResultLength := 0;
if GetTokenInformation(TokenHandle, TokenElevation, #ATokenElevation, SizeOf(ATokenElevation), ResultLength) then
Result := ATokenElevation.TokenIsElevated <> 0
else
Result := False;
finally
CloseHandle(TokenHandle);
end;
end
else
Result := False;
end
else
Result := IsAdministrator;
end;
procedure SetButtonElevated(const AButtonHandle: THandle);
const
BCM_SETSHIELD = $160C;
var
Required: BOOL;
begin
if not CheckWin32Version(6, 0) then
Exit;
if IsElevated then
Exit;
Required := True;
SendMessage(AButtonHandle, BCM_SETSHIELD, 0, LPARAM(Required));
end;
procedure CheckForElevatedTask;
function GetArgsForElevatedTask: String;
function PrepareParam(const ParamNo: Integer): String;
begin
Result := ParamStr(ParamNo);
if Pos(' ', Result) > 0 then
Result := AnsiQuotedStr(Result, '"');
end;
var
X: Integer;
begin
Result := '';
for X := 1 to ParamCount do
begin
if (AnsiUpperCase(ParamStr(X)) = ('/' + RunElevatedTaskSwitch)) or
(AnsiUpperCase(ParamStr(X)) = ('-' + RunElevatedTaskSwitch)) then
Continue;
Result := Result + PrepareParam(X) + ' ';
end;
Result := Trim(Result);
end;
var
ExitCode: Cardinal;
begin
if not FindCmdLineSwitch(RunElevatedTaskSwitch) then
Exit;
ExitCode := ERROR_GEN_FAILURE;
try
if not IsElevated then
ExitCode := ERROR_ACCESS_DENIED
else
if Assigned(OnElevateProc) then
ExitCode := OnElevateProc(GetArgsForElevatedTask)
else
ExitCode := ERROR_PROC_NOT_FOUND;
except
on E: Exception do
begin
if E is EAbort then
ExitCode := ERROR_CANCELLED
else
if E is EOleSysError then
ExitCode := Cardinal(EOleSysError(E).ErrorCode)
else
if E is EOSError then
else
ExitCode := ERROR_GEN_FAILURE;
end;
end;
if ExitCode = STILL_ACTIVE then
ExitCode := ERROR_GEN_FAILURE;
TerminateProcess(GetCurrentProcess, ExitCode);
end;
end.
Usually, putting the text "Setup" or "Install" somewhere in your EXE name is enough to make Windows run with elevated privileges automatically, and is well worth doing if it is a setup utility you are writing, as it's so easy to do.
I am now running into problems though on Windows 7, when not logged in as an Administrator, and am having to use the right-click Run As Administrator when running manually (running the program via Wise installation wizard is still fine)
I see though that Delphi 10.1 Berlin has a very easy to use new option under Project Options | Application. Just tick Enable Administrator Privileges, and the manifest is done for you, so easy!
NB. make sure you only do these kind of changes via a separate setup program, running your application with elevated privileges all the time can cause problems with other things, for example e-mail, where the default mail profile no longer gets picked up.
Edit: Jan 2018: since writing this answer in August 2017, it seems a lot of Windows updates have come out, that now require the user to right-click and Run As Administrator on just about everything, even on installation exe's built with Wise. Even Outlook is no longer installing properly without running as administrator. There is no more automated elevation at all it seems.

Get name Drive Hardware

hello someone could help me how to get
the name of the drive / hardware / / 'C: \' 'D: \' .......
example
NameDrive function (const sDrive: string): string;
begin
  result: = GetDriveName (sDrive);
end;
Showmessage (NameDrive ('C: \')) / / = ST500DM0 ....
Thank you for attention.
It's possible to get vendor info by calling DeviceIoControl with IOCTL_STORAGE_QUERY_PROPERTY code (STORAGE_PROPERTY_QUERY PropertyId set to StorageDeviceProperty), or with SMART_ control codes, or by reading WMI data. in any case you should work with physical drives having names like \.\PhysicalDriveX rather than logical ones. These are 3 alternatives I can see at once.
Example of method 1 (type definitions taken from DDK):
type
STORAGE_PROPERTY_ID = (
StorageDeviceProperty,
StorageAdapterProperty,
StorageDeviceIdProperty,
StorageDeviceUniqueIdProperty, // See storduid.h for details
StorageDeviceWriteCacheProperty,
StorageMiniportProperty,
StorageAccessAlignmentProperty,
StorageDeviceSeekPenaltyProperty,
StorageDeviceTrimProperty,
StorageDeviceWriteAggregationProperty
);
STORAGE_QUERY_TYPE = (
PropertyStandardQuery, // Retrieves the descriptor
PropertyExistsQuery, // Used to test whether the descriptor is supported
PropertyMaskQuery, // Used to retrieve a mask of writeable fields in the descriptor
PropertyQueryMaxDefined // use to validate the value
);
STORAGE_PROPERTY_QUERY = packed record
PropertyId, // ID of the property being retrieved
QueryType : Cardinal; // Flags indicating the type of query being performed
AdditionalParameters : array [0..0] of AnsiChar; // Space for additional parameters if necessary
end;
STORAGE_DEVICE_DESCRIPTOR = packed record
Version,
Size : Cardinal;
DeviceType : Byte;
DeviceTypeModifier : Byte;
RemovableMedia,
CommandQueueing : Byte;
VendorIdOffset,
ProductIdOffset,
ProductRevisionOffset,
SerialNumberOffset : Cardinal;
BusType : Cardinal;
RawPropertiesLength : Cardinal;
RawDeviceProperties : array [0..0] of AnsiChar;
end;
const STORAGE_PROPERTY_QUERY_SIZE = 12;
function GetDriveModel(DrvHandle : THandle; var aModel : AnsiString; out ErrCode : Integer) : Boolean;
var PropQuery : STORAGE_PROPERTY_QUERY;
PropResponse : STORAGE_DEVICE_DESCRIPTOR;
PropResponseSize, i : Cardinal;
Buf : PByte;
begin
FillChar(PropQuery, STORAGE_PROPERTY_QUERY_SIZE, 0);
PropQuery.PropertyId := Cardinal(StorageDeviceProperty);
PropQuery.QueryType := Cardinal(PropertyStandardQuery);
Buf := GetMemory(4096);
Result := DeviceIoControl(DrvHandle, IOCTL_STORAGE_QUERY_PROPERTY, #PropQuery, STORAGE_PROPERTY_QUERY_SIZE, Buf, 4096, PropResponseSize, nil);
ErrCode := GetLastError;
if not Result then
begin
FreeMemory(buf);
Exit;
end;
PropResponse := (PSTORAGE_DEVICE_DESCRIPTOR(Buf))^;
if PropResponse.RawPropertiesLength <> 0 then
begin
aModel := '';
if PropResponse.VendorIdOffset <> 0 then
begin
i := PropResponse.VendorIdOffset;
while Buf[i] <> 0 do
begin
aModel := aModel + AnsiChar(Buf[i]);
Inc(i);
end;
end;
if PropResponse.ProductIdOffset <> 0 then
begin
aModel := aModel + ' ';
i := PropResponse.ProductIdOffset;
while Buf[i] <> 0 do
begin
aModel := aModel + AnsiChar(Buf[i]);
Inc(i);
end;
end;
end;
FreeMemory(buf);
end;
A drive should be opened this way:
Result := CreateFile(PWideChar(DrvName), GENERIC_READ or GENERIC_WRITE,
FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0);
where DrvName is e.g. \\.\PhysicalDrive0 for 1st drive in the system.
Generally speaking, it's not possible to do what you want exactly, because a single volume, say, D:\ may be a dynamic one spanning several physical disks.

How to Start an application and obtain a handle to it with Delphi?

I want to start an application from Delphi, and obtain a handle to it, so I can embed the main window of said application on a frame of type TFrame. So far I have tried:
Function TFrmEmbeddedExe.StartNewApplication : Boolean;
var
SEInfo: TShellExecuteInfo;
ExitCode : DWORD;
begin
FillChar(SEInfo, SizeOf(SEInfo), 0) ;
SEInfo.cbSize := SizeOf(TShellExecuteInfo) ;
with SEInfo do
begin
fMask := SEE_MASK_NOCLOSEPROCESS;
Wnd := self.Handle;
lpFile := PChar(self.fexecuteFileName) ;// Example could be 'C:\Windows\Notepad.exe'
nShow := SW_SHOWNORMAL;//SW_HIDE;
end;
if ShellExecuteEx(#SEInfo) then
begin
sleep(1500);
self.fAppWnd := FindWindow(nil, PChar(self.fWindowCaption)); //Example : 'Untitled - Notepad'
if self.fAppWnd <> 0 then
begin
Windows.SetParent(self.fAppWnd, SEInfo.Wnd);
ShowWindow(self.fAppWnd, SW_SHOWMAXIMIZED);
result := true;
end
else
result := false;
end
else
result := false;
end ;
The above code actually works, but findWindow will find any given instans of the application I started. I want to embed the exact instans that I Shellexecuted.
So if Notepad had been started a couple of times, there is no way I can get the correct one using FindWindow.
I have tried:
Function TfrmEmbeddedExe.CreateProcessNewApplication : Boolean;
var
zAppName: array[0..512] of char;
StartupInfo: TStartupInfo;
ProcessInfo: TProcessInformation;
Res : DWORD;
DoWait : Boolean;
begin
DoWait := False;
StrPCopy(zAppName, self.fexecuteFileName); //'C:\Windows\Notepad.exe'
FillChar(StartupInfo, Sizeof(StartupInfo), #0);
StartupInfo.cb := Sizeof(StartupInfo);
StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
StartupInfo.wShowWindow := SW_SHOWNORMAL;
if CreateProcess (zAppName,
nil, { pointer to command line string }
nil, { pointer to process security attributes }
nil, { pointer to thread security attributes }
false, { handle inheritance flag }
CREATE_NEW_CONSOLE or { creation flags }
NORMAL_PRIORITY_CLASS,
nil, { pointer to new environment block }
nil, { pointer to current directory name }
StartupInfo, { pointer to STARTUPINFO }
ProcessInfo) then { pointer to PROCESS_INF }
begin
if DoWait then //just set it to false... so it will never enter here
begin
WaitforSingleObject(ProcessInfo.hProcess, INFINITE);
GetExitCodeProcess(ProcessInfo.hProcess, Res);
end
else
begin
self.fAppWnd := ProcessInfo.hProcess;
Windows.SetParent(self.fAppWnd, self.Handle);
ShowWindow(self.fAppWnd, SW_SHOWMAXIMIZED);
CloseHandle(ProcessInfo.hProcess);
CloseHandle(ProcessInfo.hThread);
end;
result := true;
end
else begin
Result := false;
end;
end;
PLEASE DO NOT RUN THE ABOVE CODE! It produces weird results involving picking a seemingly random window anywhere in all running applications and embedding that (even menu-items from the Windows start menu..)
So basically what I need is how do I start an application, and grab a handle to the application's main window.
Here's the rough outline of what you need to do. I'll leave the coding up to you:
Start your process with either ShellExecuteEx or CreateProcess. This will yield a process handle.
Call WaitForInputIdle on the process handle. This gives the process a chance to load and start its message loop.
Pass the process handle to GetProcessId to obtain the process ID.
Use EnumWindows to enumerate the top level windows.
Pass each of these windows to GetWindowThreadProcessId to check whether or not you have found the top level window of your target process.
Once you find a window whose process ID matches your target process, you're done!
Don't forget to close your process handles once you are done with them.
This code works for me:
Create a "Utils"- Unit with the following >>
....
interface
.....
function RunProg(PName, CmdLine: String; out ProcessHdl: HWND): HWND;
implementation
type
TEnumData = record // Record Type for Enumeration
WHdl: HWND;
WPid: DWORD;
WTitle: String;
end;
PEnumData = ^TEnumData; // Pointer to Record Type
// Enumeration Function for GetWinHandleFromProcId (below)
function EnumWindowsProcMatchPID(WHdl: HWND; EData: PEnumData): bool; stdcall;
var
Wpid : DWORD;
begin
Result := True; // continue enumeration
GetWindowThreadProcessID(WHdl, #Wpid);
// Filter for only visible windows, because the Pid is not unique to the Main Form
if (EData.WPid = Wpid) AND IsWindowVisible(WHdl) then
begin
EData.WHdl := WHdl;
Result := False; // stop enumeration
end;
end;
// Find Window from Process Id and return the Window Handle
function GetWinHandleFromProcId(ProcId: DWORD): HWND;
var
EnumData: TEnumData;
begin
ZeroMemory(#EnumData, SizeOf(EnumData));
EnumData.WPid := ProcId;
EnumWindows(#EnumWindowsProcMatchPID, LPARAM(#EnumData));
Result := EnumData.WHdl;
end;
// Run Program using CreateProcess >> Return Window Handle and Process Handle
function RunProg(PName, CmdLine: String; out ProcessHdl: HWND): HWND;
var
StartInfo: TStartupInfo;
ProcInfo: TProcessInformation;
ProcessId : DWORD;
WinHdl : HWND;
bOK : boolean;
ix : integer;
begin
FillChar(StartInfo, SizeOf(StartInfo), 0);
StartInfo.cb := SizeOf(StartInfo);
StartInfo.dwFlags := STARTF_USESHOWWINDOW;
StartInfo.wShowWindow := SW_Show;
bOK := CreateProcess(PChar(PName), PChar(CmdLine), nil, nil, False, 0, nil, nil, StartInfo, ProcInfo);
ProcessHdl := ProcInfo.hProcess;
ProcessId := ProcInfo.dwProcessId;
// Note : "WaitForInputIdle" does not always wait long enough, ...
// so we combine it with a repeat - until - loop >>
WinHdl := 0;
if bOK then // Process is running
begin
WaitForInputIdle(ProcessHdl,INFINITE);
ix := 0;
repeat // Will wait (up to 10+ seconds) for a program that takes very long to show it's main window
WinHdl := GetWinHandleFromProcId(ProcessId);
Sleep(25);
inc(ix);
until (WinHdl > 0) OR (ix > 400); // Got Handle OR Timeout
end;
Result := WinHdl;
CloseHandle(ProcInfo.hThread);
end;
Put this in your main program that uses the "Utils"- Unit >>
var
SlaveWinHdl : HWND; // Slave Program Window Handle
SlaveProcHdl : HWND; // Slave Program Process Handle
// Button to run Notepad - Returning Window Handle and Process Handle
procedure TForm1.Button1Click(Sender: TObject);
var
Pname, Pcmnd: string;
begin
Pname := 'C:\WINDOWS\system32\notepad.exe';
Pcmnd := '';
SlaveWinHdl := RunProg(Pname, Pcmnd, SlaveProcHdl);
end;
// Button to Close program using Window Handle
procedure TForm1.Button2Click(Sender: TObject);
begin
PostMessage(SlaveWinHdl, WM_CLOSE, 0, 0);
end;
// Button to Close program using Process Handle
procedure TForm1.Button3Click(Sender: TObject);
begin
TerminateProcess(SlaveProcHdl, STILL_ACTIVE);
CloseHandle(SlaveProcHdl);
end;
So there you have it, a complete solution of how to Run an external program,
and then Close it by using either the Window Handle or Process Handle.
Extra Bonus: Sometimes you have to find the handles for a program that is already running.
You can find it based on the Window- Title with the following code (added to your “Utils” unit) >>
function EnumWindowsProcMatchTitle(WHdl: HWND; EData: PEnumData): bool; stdcall;
var
WinTitle: array[0..255] of char;
Wpid : DWORD;
begin
Result := True; // continue enumeration
GetWindowText(WHdl, WinTitle, 256);
if (Pos(EData.WTitle, StrPas(WinTitle)) <> 0) then // Will also match partial title
begin
EData.WHdl := WHdl;
GetWindowThreadProcessID(WHdl, #Wpid);
EData.WPid := Wpid;
Result := False; // stop enumeration
end;
end;
function GetHandlesFromWinTitle(WinTitle: String; out ProcHdl : HWND): HWND;
var
EnumData: TEnumData;
begin
ZeroMemory(#EnumData, SizeOf(EnumData));
EnumData.WTitle := WinTitle;
EnumWindows(#EnumWindowsProcMatchTitle, LPARAM(#EnumData));
ProcHdl := OpenProcess(PROCESS_ALL_ACCESS,False,EnumData.WPid);
Result := EnumData.WHdl;
end;
And call it (from your main program), like this >>
strWT := ‘MyList.txt – Notepad’; // example of Notepad Title
SlaveWinHdl := GetHandlesFromWinTitle(strWT, SlaveProcHdl);

Resources