How to get fully qualified domain name on Windows in Delphi - windows

I need to get a fully qualified domain name for a Windows machine on a domain in Delphi.
I've tried to use LookupAccountSid but it gives me only the netbios domain name,
in my case it is "intranet" but I need the full "intranet.companyname.com"
Any Ideas?

Try the GetUserNameEx Windows API function.
const
NameUnknown = 0;
NameFullyQualifiedDN = 1;
NameSamCompatible = 2;
NameDisplay = 3;
NameUniqueId = 6;
NameCanonical = 7;
NameUserPrincipal = 8;
NameCanonicalEx = 9;
NameServicePrincipal = 10;
NameDnsDomain = 12;
function GetUserNameExString(ANameFormat: DWORD): string;
var
Buf: array[0..256] of Char;
BufSize: DWORD;
GetUserNameEx: function (NameFormat: DWORD; lpNameBuffer: LPSTR;
var nSize: ULONG): BOOL; stdcall;
begin
Result := '';
BufSize := SizeOf(Buf) div SizeOf(Buf[0]);
GetUserNameEx := GetProcAddress(GetModuleHandle('secur32.dll'), 'GetUserNameExA');
if Assigned(GetUserNameEx) then
if GetUserNameEx(ANameFormat, Buf, BufSize) then
Result := Buf;
end;
using the NameDnsDomain format for example, will result www.mydomain.com\user_name if you are logged into "www.mydomain.com" domain.
Since I now implemented this for my own needs in our application, #iPath's comment was quit right. better use GetComputerNameEx, and specify one of the COMPUTER_NAME_FORMAT for your own needs.
A Delphi implementation would look like this (Unicode version):
interface
...
type
COMPUTER_NAME_FORMAT = (
ComputerNameNetBIOS,
ComputerNameDnsHostname,
ComputerNameDnsDomain,
ComputerNameDnsFullyQualified,
ComputerNamePhysicalNetBIOS,
ComputerNamePhysicalDnsHostname,
ComputerNamePhysicalDnsDomain,
ComputerNamePhysicalDnsFullyQualified,
ComputerNameMax);
function GetComputerNameExString(ANameFormat: COMPUTER_NAME_FORMAT): WideString;
implementation
...
function GetComputerNameExW(NameType: COMPUTER_NAME_FORMAT; lpBuffer: LPWSTR;
var nSize: DWORD): BOOL; stdcall; external kernel32 name 'GetComputerNameExW';
function GetComputerNameExString(ANameFormat: COMPUTER_NAME_FORMAT): WideString;
var
nSize: DWORD;
begin
nSize := 1024;
SetLength(Result, nSize);
if GetComputerNameExW(ANameFormat, PWideChar(Result), nSize) then
SetLength(Result, nSize)
else
Result := '';
end;

NetGetJoinInformation should work fine.
MSDN:
http://msdn.microsoft.com/en-us/library/windows/desktop/aa370423(v=vs.85).aspx
Example:
type
PWKSTA_INFO_100 = ^WKSTA_INFO_100;
WKSTA_INFO_100 = packed record
wki100_platform_id: DWord;
wki100_computername: PWChar;
wki100_langroup: PWChar;
wki100_ver_major: DWord;
wki100_ver_minor: DWord;
end;
TNetSetupJoinStatus =
(
NetSetupUnknownStatus,
NetSetupUnjoined,
NetSetupWorkgroupName,
NetSetupDomainName
);
TNetApiBufferFreeFunction = function(ABuffer: Pointer): DWORD; stdcall;
TNetWkstaGetInfoFunction = function(const AServername: PWChar; const ALevel: DWord; const ABufptr: Pointer): DWORD; stdcall;
TNetGetJoinInformationFunction = function(const AServerName: PWChar; out ANameBuffer: PWChar; out ABufferType: TNetSetupJoinStatus): DWORD; stdcall;
const
NERR_SUCCESS = 0;
function GetLocalComputerDomainName: string;
var
NetApiBuffer: Pointer;
NetApi: THandle;
NetApiBufferFree: TNetApiBufferFreeFunction;
NetWkstaGetInfo: TNetWkstaGetInfoFunction;
NetGetJoinInformation: TNetGetJoinInformationFunction;
NetSetupJoinStatus: TNetSetupJoinStatus;
NameBuffer: PWideChar;
begin
Result := '';
NetApi := LoadLibrary('netapi32.dll');
if NetApi <> 0 then
begin
NetApiBufferFree := TNetApiBufferFreeFunction( GetProcAddress(NetApi, 'NetApiBufferFree'));
NetGetJoinInformation := TNetGetJoinInformationFunction(GetProcAddress(NetApi, 'NetGetJoinInformation'));
NetWkstaGetInfo := TNetWkstaGetInfoFunction( GetProcAddress(NetApi, 'NetWkstaGetInfo'));
if #NetApiBufferFree <> nil then
begin
if #NetSetupJoinStatus <> nil then
begin
if NetGetJoinInformation(nil, NameBuffer, NetSetupJoinStatus) = NERR_SUCCESS then
begin
if NetSetupJoinStatus = NetSetupDomainName then
begin
Result := NameBuffer;
end;
NetApiBufferFree(NameBuffer);
end;
end;
end;
FreeLibrary(NetApi);
end;
end;

I tried all of the above, but without success. In the end, I settled for simply grabbing the environment variable.
uses jclSysInfo;
function GetDomain:string;
begin
result:=GetEnvironmentVariable('USERDNSDOMAIN');
end;
Tested on Server 2008 R2 - works fine. Returns "server.home.lan".
Results in an empty string on a Windows 7 non-domain connected PC.

The only correct api to use is DsGetDcName.
Because NetGetJoinInformation is still from the 'lanmanager age' so, the domain is LM compliant.
The code here is C, but you are smart enough to do the same in Delphi :)
PDOMAIN_CONTROLLER_INFOW pdomInfo ;
auto result1 = ::DsGetDcNameW(nullptr, nullptr, nullptr, nullptr, DS_DIRECTORY_SERVICE_PREFERRED | DS_RETURN_DNS_NAME, &pdomInfo);
if (result1 == ERROR_SUCCESS) {
auto retVal = SysAllocString(pdomInfo->DomainName);
::NetApiBufferFree(pdomInfo);
}

Related

Returning result from Windows callback in 64-bit XE6

I have some code which uses EnumFontFamiliesEX to determine whether a particular font (using its "facename") is installed. The code was working fine in 32-bit. When I compile and run it as 64-bit, it kept throwing an exception in the callback routine.
I have now gotten it to work under both BUT only if instead of passing the function FindFontbyFaceName's result as the 4th parameter to EnumFontFamiliesEX, I pass a local (or global) variable - MYresult in this case. (And then set result from it). I don't understand what is going on? Can anyone explain or point me to a better way. (I'm not so much interested in the mechanics of the fonts, as the basic callback mechanics).
// single font find callback
function FindFontFace( {$IFDEF CPUX86} lpelf: PLogFont; {$ENDIF}
{$IFDEF CPUX64} lpelf: PEnumLogFontEx; {$ENDIF}
lpntm: PNewTextMetricEx;
AFontType: DWORD; var Aresult: lparam): integer ; stdcall;
begin
result := 0; // 1 shot only please - not interested in any variations in style etc
if (lpelf <> nil) then
Aresult := -1 // TRUE
else
Aresult := 0;
end;
function FindFontbyFaceName(ACanvas: TCanvas; const AFacename: string): boolean;
var
lf: TLogFont;
Myresult: boolean;
begin
MYresult := false;
FillChar(lf, SizeOf(lf), 0);
StrLCopy(lf.lfFaceName, PChar(AFacename), 32);
lf.lfCharSet := DEFAULT_CHARSET;
// this works in both 32 and 64 bit
EnumFontFamiliesEX(ACanvas.Handle, lf, #FindFontFace, lparam(#MYresult), 0);
result := MYresult;
// this works in 32 bit but throws exception in callback in 64 bit
// EnumFontFamiliesEX(ACanvas.Handle, lf, #FindFontFace, lparam(#result), 0);
end;
function FindFont(const AFacename: string): boolean;
var
AImage: TImage;
begin
AImage := Timage.Create(nil);
try
result := FindFontbyFaceName(AImage.Canvas, Afacename);
finally
Aimage.Free;
end;
end;
Your callback function is not declared correctly. You are declaring the last parameter as a var LPARAM, which is wrong. The lParam parameter is passed by value, not by reference. When calling EnumFontFamiliesEx() you are passing a pointer to a Boolean as the lParam value.
Your callback is trying to write sizeof(LPARAM) number of bytes to a memory address that only has SizeOf(Boolean) bytes available (and why are you trying to write a -1 to a Boolean?). So you are overwriting memory. When using a pointer to a local variable as the lParam, you are likely just overwriting memory on the calling function's call stack that does not really matter, so you don't see a crash.
You need to either:
remove the var and typecast the lParam parameter to a PBoolean:
function FindFontFace( lpelf: PLogFont;
lpntm: PTextMetric;
FontType: DWORD;
lParam: LPARAM): Integer ; stdcall;
begin
PBoolean(lParam)^ := True;
Result := 0; // 1 shot only please - not interested in any variations in style etc
end;
Or:
function FindFontFace( lpelf: PLogFont;
lpntm: PTextMetric;
FontType: DWORD;
lParam: PBoolean): Integer ; stdcall;
begin
lParam^ := True;
Result := 0; // 1 shot only please - not interested in any variations in style etc
end;
leave the var but change the parameter type to Boolean instead of LPARAM:
function FindFontFace( var lpelf: TLogFont;
var lpntm: TTextMetric;
FontType: DWORD;
var lParam: Boolean): Integer ; stdcall;
begin
lParam := True;
Result := 0; // 1 shot only please - not interested in any variations in style etc
end;
Either approach will allow you to pass #Result as the lParam to EnumFontFamiliesEx() in both 32bit and 64bit:
function FindFontbyFaceName(ACanvas: TCanvas; const AFacename: string): Boolean;
var
lf: TLogFont;
begin
Result := False;
FillChar(lf, SizeOf(lf), 0);
StrLCopy(lf.lfFaceName, PChar(AFacename), 32);
lf.lfCharSet := DEFAULT_CHARSET;
EnumFontFamiliesEX(ACanvas.Handle, lf, #FindFontFace, LPARAM(#Result), 0);
end;
On a side note, creating a TImage just to have a canvas to enumerate with is wasteful. You don't need it at all:
function FindFontFace( lpelf: PLogFont;
lpntm: PTextMetric;
FontType: DWORD;
lParam: LPARAM): integer ; stdcall;
begin
PBoolean(lParam)^ := True;
Result := 0; // 1 shot only please - not interested in any variations in style etc
end;
function FindFont(const AFacename: string): Boolean;
var
lf: TLogFont;
DC: HDC;
begin
Result := False;
FillChar(lf, SizeOf(lf), 0);
StrLCopy(lf.lfFaceName, PChar(AFacename), 32);
lf.lfCharSet := DEFAULT_CHARSET;
DC := GetDC(0);
EnumFontFamiliesEx(DC, lf, #FindFontFace, LPARAM(#Result), 0);
ReleaseDC(0, DC);
end;
That being said, you can simplify the code if you use the TScreen.Fonts property instead of calling EnumFontFamiliesEx() directly:
function FindFont(const AFacename: string): Boolean;
begin
Result := (Screen.Fonts.IndexOf(AFacename) <> -1);
end;

How to use the EnumWindows call back function?

I would like to have a single neat (close and self contained) function (let's call it GetDesktopHandle) that returns a handle to the Desktop window. I use the code below. But it only works in the DeskHandle is a global var.
How to get rid of this global variable? If I make it local I get an AV in getDesktopWnd when I try to DeskHandle := hChild
VAR DeskHandle : HWND;
function GetDesktopHandle: HWND;
function getDesktopWnd (Handle: HWND; NotUsed: Longint): bool; stdcall; { Callback function }
VAR hChild : HWND;
begin
if handle <> 0 then
begin
hChild := FindWindowEx(handle, 0, 'SHELLDLL_DefView', nil);
if hChild <> 0 then
begin
hChild := FindWindowEx(hChild, 0, 'SysListView32', nil);
if hChild <> 0
then DeskHandle := hChild;
end;
end;
Result:= TRUE;
end;
begin
DeskHandle := 0;
EnumWindows(#getDesktopWnd, 0);
Result:= DeskHandle;
end;
The main question is: can I write this code as a single function or AT LEAST, can I get rid of the external/global var?
Possible solution:
The documentation says that the second parameter is only a IN parameter.
lParam [in]
Type: LPARAM
An application-defined value to be passed to the callback function.
https://msdn.microsoft.com/en-us/library/windows/desktop/ms633497%28v=vs.85%29.aspx
Would it be wrong to use it to pass the result back?
Local functions cannot be used as callbacks. If you hadn't used the # operator to pass your function, the compiler would have told you that. (Using the operator turns the argument into an ordinary untyped pointer, so the compiler can't check anymore.)
You'll have to make your callback be a standalone function.
To pass data between the callback and the caller, use the second parameter, which you've currently named NotUsed. For example, you could pass a pointer to a handle variable, and then the callback could dereference the pointer to return a result.
type
TMyData = record
Handle: HWND;
Pid: DWORD;
Caption: String;
ClassName: String;
end;
PMyData = ^TMyData;
function GetWindowClass(const Handle: HWND): String;
begin
SetLength(Result, MAX_PATH);
SetLength(Result, GetClassName(Handle, PChar(Result), Length(Result)));
end;
function GetWindowCaption(const Handle: HWND): String;
begin
SetLength(Result, MAX_PATH);
SetLength(Result, GetWindowText(Handle, PChar(Result), Length(Result)));
end;
function EnumChildWindowsProc(Handle: THandle; MyData: PMyData): BOOL; stdcall;
var
ClassName: String;
Caption: String;
Pid: DWORD;
begin
ClassName := GetWindowClass(Handle);
Caption := GetWindowCaption(Handle);
Result := (ClassName = 'SysListView32') and (Caption = 'FolderView');
if Result then
begin
MyData.Handle := Handle;
GetWindowThreadProcessId(Handle, MyData.Pid);
MyData.Caption := Caption;
MyData.ClassName := ClassName;
end;
// To continue enumeration, the callback function must return TRUE;
// to stop enumeration, it must return FALSE
Result := not Result;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
MyData: TMyData;
begin
ZeroMemory(#MyData, SizeOf(MyData));
EnumChildWindows(GetDesktopWindow, #EnumChildWindowsProc, NativeInt(#MyData));
if MyData.Handle > 0 then
begin
ShowMessageFmt('Found Window in Pid %d', [MyData.Pid]);
end
else begin
ShowMessage('Window not found!');
end;
end;

Inno Setup - UrlCreateFromPath

I'd like to be able to use the UrlCreateFromPathW function from Shlwapi.dll in my installer script, but I haven't been able to get it to work.
HRESULT UrlCreateFromPath(
_In_ PCTSTR pszPath,
_Out_ PTSTR pszUrl,
_Inout_ DWORD *pcchUrl,
DWORD dwFlags
);
I've cobbled together the following from other "Inno Setup" tagged questions here, and from glancing at the JEDI translation for the DLL. TryUrlCreateFromPath always returns false. Any assistance would be much appreciated.
[Code]
const
INTERNET_MAX_URL_LENGTH = 2048 + 32 + 3;
S_OK = $00000000;
function UrlCreateFromPathW(pszPath, pszUrl: string; var pcchUrl: DWORD; dwFlags: DWORD): HResult; external 'UrlCreateFromPathW#Shlwapi.dll stdcall';
function TryUrlCreateFromPath(const path: string; var url: string): Boolean;
var
charcount: dword;
flags: dword;
begin
SetLength(url, INTERNET_MAX_URL_LENGTH);
flags := 0;
Result := UrlCreateFromPathW(path, url, charcount, flags) = S_OK;
if Result then
SetLength(url, charcount);
end;
function InitializeSetup: Boolean;
var
URL: string;
ErrorCode: Integer;
begin
Result := True;
if TryUrlCreateFromPath('c:\temp', URL) then
MsgBox('URL: ' + URL, mbConfirmation, MB_OK)
else
MsgBox('ERROR', mbError, MB_OK);
end;
The pcchUrl is an in/out argument. On input, it must contain a number of characters allocated in the pszUrl.
You do not initialize it. It most likely defaults to 0, hence the UrlCreateFromPath returns E_INVALIDARG.
Initialize it like:
charcount := INTERNET_MAX_URL_LENGTH;

How to execute "net use" command from Inno Setup installer on Windows 7?

I'm working on an Inno Setup installer, which calls net use to connect to a shared server. The installer can connect to the server, if it's running on Windows XP, but not on Windows 7. I think it's related to UAC as I type the same command, the server is connected on Windows 7, but the setup is running with admin privileges.
I'm using the following net use command through Exec or ShellExec script functions:
/c net use \\servername password /user:username
Actually, here is a part of the script showing the net use command call:
[Code]
var
ErrorCode: Integer;
cmdString: String;
intvalue: Integer;
str: String;
function InitializeSetup(): Boolean;
begin
cmdString := '/c net use \\servername password /USER:username';
ShellExec('', ExpandConstant('{cmd}'), cmdString , '', SW_SHOWNORMAL,
ewWaitUntilTerminated, ErrorCode)
if (ErrorCode = 0) then
begin
MsgBox(ExpandConstant('{cmd}'), mbInformation, MB_OK);
end;
end;
Can anybody suggest how to use net use from Inno Setup on Windows 7? We just want to connect to a server and let user input name and password.
Thank you!
How to connect to a remote resource invoking the credentials dialog?
Using a different view on your question, which is actually as the title of this answer says, I'd suggest you to use the WNetUseConnection function call with CONNECT_INTERACTIVE and CONNECT_PROMPT flags. That will in combination with empty user ID and password parameters invoke the credentials dialog (and that's what you wanted). In Inno Setup script it may look like this:
[Setup]
AppName=My Program
AppVersion=1.5
DefaultDirName={pf}\My Program
[Code]
#ifdef UNICODE
#define AW "W"
#else
#define AW "A"
#endif
const
NO_ERROR = 0;
ERROR_ACCESS_DENIED = 5;
ERROR_BAD_NET_NAME = 67;
ERROR_ALREADY_ASSIGNED = 85;
ERROR_INVALID_PASSWORD = 86;
ERROR_INVALID_PARAMETER = 87;
ERROR_MORE_DATA = 234;
ERROR_NO_MORE_ITEMS = 259;
ERROR_INVALID_ADDRESS = 487;
ERROR_BAD_DEVICE = 1200;
ERROR_NO_NET_OR_BAD_PATH = 1203;
ERROR_BAD_PROVIDER = 1204;
ERROR_EXTENDED_ERROR = 1208;
ERROR_NO_NETWORK = 1222;
ERROR_CANCELLED = 1223;
RESOURCETYPE_ANY = $00000000;
RESOURCETYPE_DISK = $00000001;
RESOURCETYPE_PRINT = $00000002;
CONNECT_UPDATE_PROFILE = $00000001;
CONNECT_INTERACTIVE = $00000008;
CONNECT_PROMPT = $00000010;
CONNECT_REDIRECT = $00000080;
CONNECT_COMMANDLINE = $00000800;
CONNECT_CMD_SAVECRED = $00001000;
type
TNetResource = record
dwScope: DWORD;
dwType: DWORD;
dwDisplayType: DWORD;
dwUsage: DWORD;
lpLocalName: string;
lpRemoteName: string;
lpComment: string;
lpProvider: string;
end;
TResourceType = (
rtAny,
rtDisk,
rtPrinter
);
function WNetUseConnection(hwndOwner: HWND; const lpNetResource: TNetResource;
lpPassword, lpUserID: string; dwFlags: DWORD; lpAccessName: PAnsiChar;
var lpBufferSize, lpResult: DWORD): DWORD;
external 'WNetUseConnection{#AW}#mpr.dll stdcall';
function UseConnection(const ARemoteName: string;
AResourceType: TResourceType): DWORD;
var
BufferSize: DWORD;
ResultFlag: DWORD;
NetResource: TNetResource;
begin
case AResourceType of
rtAny: NetResource.dwType := RESOURCETYPE_ANY;
rtDisk: NetResource.dwType := RESOURCETYPE_DISK;
rtPrinter: NetResource.dwType := RESOURCETYPE_PRINT;
end;
NetResource.lpLocalName := '';
NetResource.lpRemoteName := ARemoteName;
NetResource.lpProvider := '';
BufferSize := 0;
Result := WNetUseConnection(WizardForm.Handle, NetResource,
'', '', CONNECT_INTERACTIVE or CONNECT_PROMPT, '',
BufferSize, ResultFlag);
end;
procedure UseConnectionButtonClick(Sender: TObject);
var
S: string;
ResultCode: DWORD;
begin
ResultCode := UseConnection('\\MySuperSecret\Place', rtDisk);
case ResultCode of
NO_ERROR: S := 'NO_ERROR';
ERROR_ACCESS_DENIED: S := 'ERROR_ACCESS_DENIED';
ERROR_ALREADY_ASSIGNED: S := 'ERROR_ALREADY_ASSIGNED';
ERROR_BAD_DEVICE: S := 'ERROR_BAD_DEVICE';
ERROR_BAD_NET_NAME: S := 'ERROR_BAD_NET_NAME';
ERROR_BAD_PROVIDER: S := 'ERROR_BAD_PROVIDER';
ERROR_CANCELLED: S := 'ERROR_CANCELLED';
ERROR_EXTENDED_ERROR: S := 'ERROR_EXTENDED_ERROR';
ERROR_INVALID_ADDRESS: S := 'ERROR_INVALID_ADDRESS';
ERROR_INVALID_PARAMETER: S := 'ERROR_INVALID_PARAMETER';
ERROR_MORE_DATA: S := 'ERROR_MORE_DATA';
ERROR_INVALID_PASSWORD: S := 'ERROR_INVALID_PASSWORD';
ERROR_NO_MORE_ITEMS: S := 'ERROR_NO_MORE_ITEMS';
ERROR_NO_NET_OR_BAD_PATH: S := 'ERROR_NO_NET_OR_BAD_PATH';
ERROR_NO_NETWORK: S := 'ERROR_NO_NETWORK';
end;
MsgBox(S, mbInformation, MB_OK);
end;
procedure InitializeWizard;
var
UseConnectionButton: TNewButton;
begin
UseConnectionButton := TNewButton.Create(WizardForm);
UseConnectionButton.Parent := WizardForm;
UseConnectionButton.Left := 8;
UseConnectionButton.Top := WizardForm.ClientHeight - UseConnectionButton.Height - 8;
UseConnectionButton.Width := 155;
UseConnectionButton.Caption := 'Use connection...';
UseConnectionButton.OnClick := #UseConnectionButtonClick;
end;

Creating a function to dig for Windows Handle by Classname(s) Only

So I just got an answer to my question about getting the Skype Chatbox handle.
I am now trying to create a simple function, that digs for a handle. Here is how I am hoping to be able to use it:
MyHWND := DigForHandle(['Notepad','Edit'],['Untitled - Notepad','']);
Params:
1) Array of String: Holds the Class Hierachy.
2) Array of String: Holds the Window Caption Hierachy.
As you see, the 2nd entry in the 2nd parameter is empty, since the Edit Class does not have a Window Caption.
Would it be possible to create such function? :)
Try this
uses
Windows, Messages, TlHelp32, SysUtils;
type
PGetWindowParam = ^TGetWindowParam;
TGetWindowParam = record
ProcID: DWORD;
WindowCaption: string;
Result: HWND;
end;
function DigForHandle(const ProcName, Caption: string; const Hierachy: array of string): HWND;
function FindPID(const ExeFileName: string): DWORD;
implementation
function FindPID(const ExeFileName: string): DWORD;
var
ContinueLoop: BOOL;
ProcessEntry32: TProcessEntry32;
SnapshotHandle: THandle;
TempExeFileName: string;
begin
Result := 0;
SnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
if SnapshotHandle <> 0 then
begin
FillChar(ProcessEntry32, SizeOf(ProcessEntry32), 0);
ProcessEntry32.dwSize := Sizeof(ProcessEntry32);
ContinueLoop := Process32First(SnapshotHandle, ProcessEntry32);
while ContinueLoop do
begin
TempExeFileName := ExtractFileName(ProcessEntry32.szExeFile);
if SameText(TempExeFileName, ExeFileName) then
begin
Result := ProcessEntry32.th32ProcessID;
Break;
end;
ContinueLoop := Process32Next(SnapshotHandle, ProcessEntry32);
end;
CloseHandle(SnapshotHandle);
end;
end;
function GetWindow(Wnd: HWND; P: LParam): BOOL; stdcall;
var
Param: PGetWindowParam;
ProcID: DWORD;
WindowTitle: array[0..256] of Char;
begin
Result := True; // assume it doesn't match; keep searching
Param := PGetWindowParam(P);
ProcID := 0;
GetWindowThreadProcessID(Wnd, #ProcID);
if ProcID <> Param^.ProcID then
Exit;
FillChar(WindowTitle, SizeOf(WindowTitle), 0);
if SendMessage(Wnd, WM_GETTEXT, SizeOf(WindowTitle) - SizeOf(Char), LPARAM(#WindowTitle[0])) <= 0 then
Exit;
if AnsiSameStr(WindowTitle, Param^.WindowCaption) then
begin
Param^.Result := Wnd;
Result := False;
end;
end;
function DigForHandle(const ProcName, Caption: string; const Hierachy: array of string): HWND;
var
Param: TGetWindowParam;
I: Integer;
ParentWnd: HWND;
begin
Result := 0;
FillChar(Param, SizeOf(Param), 0);
Param.ProcID := FindPID(ProcName);
if Param.ProcID = 0 then
Exit;
Param.Result := 0;
Param.WindowCaption := Caption;
EnumWindows(#GetWindow, LPARAM(#Param));
if Param.Result = 0 then
Exit;
I := 0;
ParentWnd := Param.Result;
while (ParentWnd <> 0) and (I < Length(Hierachy)) do
begin
Param.Result := 0;
Param.WindowCaption := Hierachy[I];
EnumChildWindows(ParentWnd, #GetWindow, LPARAM(#Param));
if Param.Result = 0 then
Break;
ParentWnd := Param.Result;
Inc(I);
end;
if I >= Length(Hierachy) then
Result := Param.Result;
end;
When I thought about it, I realized that it was actually rather simple - the code I had though, was "confusing" for me, which was why I asked a question here. After trying it out, I found that doing it this way, its a lot easier to read, and not as complicated (IMO).
Function DigForHandle(ClassHierachy, TextHierachy : Array of String):HWND;
Var
Handle : HWND;
I : Integer;
PClass,PText : PChar;
Begin
Result := 0;
I := 0;
while (I <= Length(ClassHierachy)-1) do
begin
PClass := PChar(ClassHierachy[I]);
PText := PChar(TextHierachy[I]);
if PClass = '' then PClass := Nil;
if PText = '' then PText := Nil;
Result := FindWindowEx(Result,0,PClass,PText);
Inc(I);
end;
End;

Resources