How can I see if windows explorer is already opened with certain path ? I don't want my application opens many duplicated windows. I was unable to do it with this way :
var
H: hwnd;
begin
if FileExists(edt8.Text) then
begin
H := FindWindow(0, PChar(ExtractFilePath(edt8.Text)));
if H <> 0 then
ShowMessage('explorer already opened')//explorer bring to front
else
ShellExecute(Application.Handle, nil, 'explorer.exe',
PChar(ExtractFilePath(edt8.Text)), nil, SW_NORMAL);
end;
end;
IShellWindows::FindWindowSW method
There is a nice method FindWindowSW that should find an existing Shell window, which includes Windows Explorer windows as well, I'd say. So, in a hope I'll find an existing window easily I wrote this code:
uses
ActiveX, ShlObj, SHDocVw, ComObj;
function IDListFromPath(const Path: WideString): PItemIDList;
var
Count: ULONG;
Attributes: ULONG;
ShellFolder: IShellFolder;
begin
OleCheck(SHGetDesktopFolder(ShellFolder));
OleCheck(ShellFolder.ParseDisplayName(0, nil, PWideChar(Path), Count, Result, Attributes));
end;
function GetExplorerHandle(const Path: WideString): HWND;
var
IDList: PItemIDList;
Unused: OleVariant;
Location: OleVariant;
ShellWindows: IShellWindows;
begin
OleCheck(CoCreateInstance(CLASS_ShellWindows, nil, CLSCTX_LOCAL_SERVER, IID_IShellWindows, ShellWindows));
Unused := Unassigned;
IDList := IDListFromPath(Path);
PVariantArg(#Location).vt := VT_VARIANT or VT_BYREF;
PVariantArg(#Location).pvarVal := PVariant(IDList);
ShellWindows.FindWindowSW(Location, Unused, SWC_EXPLORER, Integer(Result), SWFO_INCLUDEPENDING);
end;
But it never finds the Windows Explorer window with the given folder path (it always returns 0). I've used SWC_EXPLORER class to search only for Windows Explorer windows, build the absolute ID list, used a proper VT_VARIANT | VT_BYREF variant for location (at least I hope so, if not, please let me know). And I also tried to return IDispatch by including the SWFO_NEEDDISPATCH option (method always returned nil reference). So I gave up on this method (haven't found any example).
IShellWindows enumeration
The following code was inspired by this article and this example. Here is a scheme:
1. IShellWindows.Item(n)
2. ⤷ IDispatch.QueryInterface(IWebBrowserApp)
3. ⤷ IWebBrowserApp.QueryInterface(IServiceProvider)
4. ⤷ IServiceProvider.QueryService(STopLevelBrowser, IShellBrowser)
5. ⤷ IShellBrowser.QueryActiveShellView
6. ⤷ IShellView.QueryInterface(IFolderView)
7. ⤷ IFolderView.GetFolder(IPersistFolder2)
8. ⤷ IPersistFolder2.GetCurFolder
9. ⤷ ITEMIDLIST
And some description:
As first you obtain the IShellWindows interface reference and iterate its items.
For each item, the IShellWindows interface returns window's IDispatch interface which you then query for an IWebBrowserApp interface reference.
The obtained IWebBrowserApp interface (for documentation refer to IWebBrowser2, as it's their implementation) provides except others also the information about the host window, like handle which can be later used for bringing the window to foreground. We need to go deeper though. So let's query this interface reference for the IServiceProvider interface (which is an accessor for getting interfaces for the given service).
Now from the top-most browser implementation service query its IShellBrowser interface. A reference of this interface is still not interesting for our aim.
The obtained IShellBrowser query for the displayed Shell view object.
Now we can finally say, if the iterated Shell window is not an Internet Explorer window. So far they were having common interfaces implemented. Now if we query the obtained IShellView for the IFolderView interface and it succeeds, it is not Internet Explorer and we can continue.
Query the obtained IFolderView reference for the IPersistFolder2 interface for the currently displayed folder object.
If we succeeded even there and we got IPersistFolder2 reference, let's get the ITEMIDLIST for the current folder object.
And if we succeeded even with this last step, we have ITEMIDLIST of the currently displayed folder of a Windows Explorer instance (or the same interface implementor) and we can finally check if the obtained ITEMIDLIST equals to the one we parsed for the input path. If so, bring that window to foreground, if not, continue to the next iteration.
And here is a Delphi code. I don't know how much do you need for your Delphi version; this was a bare minimum I've needed for D2009 (manually translated from Windows SDK 10.0.15063.0). It's not a best example; in real code you may prefer wrapping this into a class and have more flexible interface, but that's upon your design preference. And finally, if you have Delphi newer than 2009, you may not need the imported prototypes, if older, you might be missing some:
uses
ActiveX, ShlObj, SHDocVw, ComObj;
{ because of Win32Check }
{$WARN SYMBOL_PLATFORM OFF}
const
IID_IFolderView: TGUID = '{CDE725B0-CCC9-4519-917E-325D72FAB4CE}';
IID_IPersistFolder2: TGUID = '{1AC3D9F0-175C-11D1-95BE-00609797EA4F}';
IID_IServiceProvider: TGUID = '{6D5140C1-7436-11CE-8034-00AA006009FA}';
SID_STopLevelBrowser: TGUID = '{4C96BE40-915C-11CF-99D3-00AA004AE837}';
type
IFolderView = interface(IUnknown)
['{CDE725B0-CCC9-4519-917E-325D72FAB4CE}']
function GetCurrentViewMode(out pViewMode: UINT): HRESULT; stdcall;
function SetCurrentViewMode(ViewMode: UINT): HRESULT; stdcall;
function GetFolder(const riid: TIID; out ppv): HRESULT; stdcall;
function Item(iItemIndex: Integer; out ppidl: PItemIDList): HRESULT; stdcall;
function ItemCount(uFlags: UINT; out pcItems: Integer): HRESULT; stdcall;
function Items(uFlags: UINT; const riid: TIID; out ppv): HRESULT; stdcall;
function GetSelectionMarkedItem(out piItem: Integer): HRESULT; stdcall;
function GetFocusedItem(out piItem: Integer): HRESULT; stdcall;
function GetItemPosition(pidl: PItemIDList; out ppt: TPoint): HRESULT; stdcall;
function GetSpacing(var ppt: TPoint): HRESULT; stdcall;
function GetDefaultSpacing(out ppt: TPoint): HRESULT; stdcall;
function GetAutoArrange: HRESULT; stdcall;
function SelectItem(iItem: Integer; dwFlags: DWORD): HRESULT; stdcall;
function SelectAndPositionItems(cidl: UINT; var apidl: PItemIDList; var apt: TPoint; dwFlags: DWORD): HRESULT; stdcall;
end;
EShObjectNotFolder = class(Exception);
function ILGetSize(pidl: PItemIDList): UINT; stdcall;
external 'shell32.dll' name 'ILGetSize';
function ILIsEqual(pidl1: PItemIDList; pidl2: PItemIDList): BOOL; stdcall;
external 'shell32.dll' name 'ILIsEqual';
function InitVariantFromBuffer(pv: Pointer; cb: UINT; out pvar: OleVariant): HRESULT; stdcall;
external 'propsys.dll' name 'InitVariantFromBuffer';
function CoAllowSetForegroundWindow(pUnk: IUnknown; lpvReserved: Pointer): HRESULT; stdcall;
external 'ole32.dll' name 'CoAllowSetForegroundWindow';
resourcestring
rsObjectNotFolder = 'Object "%s" is not a folder.';
{ this parses the input folder path and creates ITEMIDLIST structure if the given
folder path is a valid absolute path to an existing folder }
function GetFolderIDList(const Folder: string): PItemIDList;
const
SFGAO_STREAM = $00400000;
var
Count: ULONG;
Attributes: ULONG;
ShellFolder: IShellFolder;
begin
OleCheck(SHGetDesktopFolder(ShellFolder));
Attributes := SFGAO_FOLDER or SFGAO_STREAM;
OleCheck(ShellFolder.ParseDisplayName(0, nil, PWideChar(WideString(Folder)), Count, Result, Attributes));
if not ((Attributes and SFGAO_FOLDER = SFGAO_FOLDER) and (Attributes and SFGAO_STREAM <> SFGAO_STREAM)) then
begin
CoTaskMemFree(Result);
raise EShObjectNotFolder.CreateFmt(rsObjectNotFolder, [Folder]);
end;
end;
{ translated from the link mentioned in this comment; D2009 does not allow me to
create an OleVariant of type VT_ARRAY|VT_UI1 which is needed for the Navigate2
method so I've imported and used the InitVariantFromBuffer function here
https://msdn.microsoft.com/en-us/library/windows/desktop/gg314982(v=vs.85).aspx }
procedure OpenNewExplorer(IDList: PItemIDList);
var
Location: OleVariant;
WebBrowser: IWebBrowser2;
begin
OleCheck(CoCreateInstance(CLASS_ShellBrowserWindow, nil, CLSCTX_LOCAL_SERVER, IID_IWebBrowser2, WebBrowser));
OleCheck(CoAllowSetForegroundWindow(WebBrowser, nil));
OleCheck(InitVariantFromBuffer(IDList, ILGetSize(IDList), Location));
try
WebBrowser.Navigate2(Location, Unassigned, Unassigned, Unassigned, Unassigned);
finally
VariantClear(Location);
end;
WebBrowser.Visible := True;
end;
{ translated from the link mentioned in this comment
https://blogs.msdn.microsoft.com/oldnewthing/20040720-00/?p=38393 }
procedure BrowseInExplorer(const Folder: string);
var
I: Integer;
WndIface: IDispatch;
ShellView: IShellView;
FolderView: IFolderView;
SrcFolderID: PItemIDList;
CurFolderID: PItemIDList;
ShellBrowser: IShellBrowser;
ShellWindows: IShellWindows;
WebBrowserApp: IWebBrowserApp;
PersistFolder: IPersistFolder2;
ServiceProvider: IServiceProvider;
begin
SrcFolderID := GetFolderIDList(Folder);
try
OleCheck(CoCreateInstance(CLASS_ShellWindows, nil, CLSCTX_LOCAL_SERVER, IID_IShellWindows, ShellWindows));
{ iterate all Shell windows }
for I := 0 to ShellWindows.Count - 1 do
begin
WndIface := ShellWindows.Item(VarAsType(I, VT_I4));
{ do not use OleCheck here; windows like Internet Explorer do not implement
all the interfaces; it is the way to distinguish Windows Explorer windows
actually; so let's get all the references and if we succeed, check if the
obtained folder equals to the passed one; if so, bring that window to top
and exit this procedure }
if Assigned(WndIface) and
Succeeded(WndIface.QueryInterface(IID_IWebBrowserApp, WebBrowserApp)) and
Succeeded(WebBrowserApp.QueryInterface(IID_IServiceProvider, ServiceProvider)) and
Succeeded(ServiceProvider.QueryService(SID_STopLevelBrowser, IID_IShellBrowser, ShellBrowser)) and
Succeeded(ShellBrowser.QueryActiveShellView(ShellView)) and
Succeeded(ShellView.QueryInterface(IID_IFolderView, FolderView)) and
Succeeded(FolderView.GetFolder(IID_IPersistFolder2, PersistFolder)) and
Succeeded(PersistFolder.GetCurFolder(CurFolderID)) and
ILIsEqual(SrcFolderID, CurFolderID) then
begin
{ restore the window if minimized, try to bring it to front and exit this
procedure }
if IsIconic(WebBrowserApp.HWnd) then
Win32Check(ShowWindow(WebBrowserApp.HWnd, SW_RESTORE));
{$IFNDEF IBelieveThatIWebBrowserAppVisiblePropertyBringsWindowToFront}
Win32Check(SetForegroundWindow(WebBrowserApp.HWnd));
{$ELSE}
OleCheck(CoAllowSetForegroundWindow(WebBrowserApp, nil));
WebBrowserApp.Visible := True;
{$ENDIF}
Exit;
end;
end;
{ the procedure was not exited, hence an existing window was not found, so go
and open the new one }
OpenNewExplorer(SrcFolderID);
finally
CoTaskMemFree(SrcFolderID);
end;
end;
{$WARN SYMBOL_PLATFORM ON}
Possible usage:
BrowseInExplorer('C:\MyFolder');
Related
I have an application that spawns multiple CreateProcess threads and I'm successfully redirecting the stdout and stderr output to text files for each one.
However, I've discovered the feature whereby the stdout/strderr handles are inherited by all such threads and not just the ones I want them to be inherited by. So I've embarked on a journey to use the InitializeProcThreadAttributeList, UpdateProcThreadAttribute functions and EXTENDED_STARTUPINFO_PRESENT and a STARTUPINFOEX structure in the CreateProcess function to get around this but I'm stuck.
If I use PROC_THREAD_ATTRIBUTE_HANDLE_LIST as the Attribute argument in UpdateProcThreadAttribute procedure it expects the lpValue parameter to be a pointer to a list of handles to be inherited by the child process.
For the List I've tried using a
TList<Cardinal>
and also creating an array of Cardinals but couldn't get either approaches to compile!
Question: How do I create and populate such a list?
Secondly, in this example it is using the functions and procedures from kernel32.dll but they also exist in the Windows unit too (I'm using Delphi 10.3) although the definitions differ:
For example, InitializeProcThreadAttributeList( nil, 1, 0, vAListSize ); won't compile using the Windows unit due to the nil argument because Types of actual and formal var parameters must be identical but I have no such issue using the one in kernel32
Question: Which version of these functions/procedures should I be using?
Thanks.
In case it is useful, here's my code to implement all of this:
type
TStartupInfoEx = record
StartupInfo: TStartupInfo;
lpAttributeList: Pointer;
end;
const
PROC_THREAD_ATTRIBUTE_HANDLE_LIST = $00020002;
function InitializeProcThreadAttributeList(
lpAttributeList: Pointer;
dwAttributeCount: DWORD;
dwFlags: DWORD;
var lpSize: SIZE_T
): BOOL; stdcall; external kernel32;
function UpdateProcThreadAttribute(
lpAttributeList: Pointer;
dwFlags: DWORD;
Attribute: DWORD_PTR;
lpValue: Pointer;
cbSize: SIZE_T;
lpPreviousValue: PPointer;
lpReturnSize: PSIZE_T
): BOOL; stdcall; external kernel32;
function DeleteProcThreadAttributeList(
lpAttributeList: Pointer
): BOOL; stdcall; external kernel32;
function CreateProcessWithInheritedHandles(
lpApplicationName: LPCWSTR;
lpCommandLine: LPWSTR;
lpProcessAttributes,
lpThreadAttributes: PSecurityAttributes;
const Handles: array of THandle;
dwCreationFlags: DWORD;
lpEnvironment: Pointer;
lpCurrentDirectory: LPCWSTR;
const lpStartupInfo: TStartupInfo;
var lpProcessInformation: TProcessInformation
): Boolean;
var
i: Integer;
StartupInfoEx: TStartupInfoEx;
size: SIZE_T;
begin
Assert(Length(Handles)>0);
StartupInfoEx.StartupInfo := lpStartupInfo;
StartupInfoEx.StartupInfo.cb := SizeOf(StartupInfoEx);
StartupInfoEx.lpAttributeList := nil;
Win32Check(not InitializeProcThreadAttributeList(nil, 1, 0, size) and (GetLastError=ERROR_INSUFFICIENT_BUFFER));
GetMem(StartupInfoEx.lpAttributeList, size);
try
Win32Check(InitializeProcThreadAttributeList(StartupInfoEx.lpAttributeList, 1, 0, size));
try
Win32Check(UpdateProcThreadAttribute(
StartupInfoEx.lpAttributeList,
0,
PROC_THREAD_ATTRIBUTE_HANDLE_LIST,
#Handles[0],
Length(Handles) * SizeOf(Handles[0]),
nil,
nil
));
for i := 0 to High(Handles) do begin
Win32Check(SetHandleInformation(Handles[i], HANDLE_FLAG_INHERIT, HANDLE_FLAG_INHERIT));
end;
Result := CreateProcess(
lpApplicationName,
lpCommandLine,
lpProcessAttributes,
lpThreadAttributes,
True,
dwCreationFlags,
lpEnvironment,
lpCurrentDirectory,
StartupInfoEx.StartupInfo,
lpProcessInformation
);
finally
DeleteProcThreadAttributeList(StartupInfoEx.lpAttributeList);
end;
finally
FreeMem(StartupInfoEx.lpAttributeList);
end;
end;
From your post it would seem that there are some declarations of InitializeProcThreadAttributeList, UpdateProcThreadAttribute and DeleteProcThreadAttributeList in the Windows unit in the latest versions of Delphi, but your post implies that they are incorrectly declared. The above code is known to work correctly.
I'm trying to have some effective code to get vendor, serial number, and model of a USB drive, using its drive letter. I've searched a lot and found several solutions. But I can not determine which one is the best one.
First one is here. Uses hid.pas from JEDI, but I don't know how to use it with a single drive. Specially, function GetHidDeviceInfo is very interesting but requires symbolic link rather that a drive letter. I tried to invite a symbolic link for the drive letter at no avail.
Second one is here. Uses WMI which doesn't seem very clean. My experience tells me that WMI doesn't work on all PCs. The code doesn't work on my own laptop, saying 'The RPC server is unavailable'.
Please advice me on the best way to achieve my goal. Are other ways around?
Update: I'm posting some sample code, combining the results of comments below.
{$APPTYPE CONSOLE}
uses
Windows, Messages, SysUtils, Variants;
type
PHIDDAttributes = ^THIDDAttributes;
HIDD_ATTRIBUTES = record
Size: ULONG; // size of structure (set before call)
VendorID: Word;
ProductID: Word;
VersionNumber: Word;
//
// Additional fields will be added to the end of this structure.
//
end;
THIDDAttributes = HIDD_ATTRIBUTES;
THIDUSBDeviceInfo = Record { contains interface level information of each device}
SymLink : String;
BufferSize : Word;
Handle : THandle;
VID : DWord;
PID : DWord;
VersionNumber : Word;
ManufacturerString : String;
ProductString : String;
SerialNumberString : String;
end;
function GetVolumeNameForVolumeMountPointW(const lpszVolumeMountPoint: LPCWSTR;
lpszVolumeName: LPWSTR; cchBufferLength: DWORD): BOOL; stdcall;
external kernel32;
function HidD_GetAttributes(HidDeviceObject: THandle;
var HidAttrs: THIDDAttributes): LongBool; stdcall;external 'hid.dll' name 'HidD_GetAttributes';
function HidD_GetManufacturerString(HidDeviceObject: THandle;
Buffer: PWideChar; BufferLength: Integer): LongBool; stdcall;external 'hid.dll' name 'HidD_GetManufacturerString';
function HidD_GetProductString(HidDeviceObject: THandle;
Buffer: PWideChar; BufferLength: Integer): LongBool; stdcall;external 'hid.dll' name 'HidD_GetProductString';
function HidD_GetSerialNumberString(HidDeviceObject: THandle;
Buffer: PWideChar; BufferLength: Integer): LongBool; stdcall;external 'hid.dll' name 'HidD_GetSerialNumberString';
function GetVolumeName(Name: string): string;
var
Volume: array [0..MAX_PATH] of Char;
begin
FillChar(Volume[0], SizeOf(Volume), 0);
GetVolumeNameForVolumeMountPointW(PChar(Name), #Volume[0], SizeOf(Volume));
Result := Volume;
end;
Function GetHidDeviceInfo( Symlink : PChar) : THIDUSBDeviceInfo;
Var
pstr : pWideChar;
DevHandle : THandle;
HidAttrs : THIDDAttributes;
Begin
FillChar(Result, SizeOf( Result), 0);
Result.SymLink := SymLink+ #0;
GetMem( pstr, 512);
DevHandle := CreateFile( Symlink,
GENERIC_READ or GENERIC_WRITE,
FILE_SHARE_READ or FILE_SHARE_WRITE,
nil,
OPEN_EXISTING,
0,
0);
If DevHandle <> INVALID_HANDLE_VALUE then
begin
If HidD_GetAttributes( DevHandle,HidAttrs) then
begin
result.VID := HidAttrs.VendorID;
result.PID := HidAttrs.ProductID;
result.VersionNumber := HidAttrs.VersionNumber;
end;
If HidD_GetManufacturerString( DevHandle, pstr, 512) then
Result.ManufacturerString := pStr;
If HidD_GetProductString( DevHandle, pstr, 512) then
Result.ProductString := pStr;
If HidD_GetSerialNumberString( DevHandle, pstr, 512) then
Result.SerialNumberString := pStr;
closeHandle( DevHandle);
end;
FreeMem( pStr);
End;
procedure Main;
var
VolumeName: string;
info: THIDUSBDeviceInfo;
begin
VolumeName:=GetVolumeName('i:\'); //assuming that I: is a USB drive
info:=GetHidDeviceInfo(pchar(VolumeName));
Writeln(info.SerialNumberString);
end;
begin
Main;
Readln;
end.
You can try to obtain SerialNumber of disk (and more information) using WMI.
Usin WMI and the Win32_DiskDrive class, you can get the Serial Number. The documentation say: "Windows Server 2003 and Windows XP: This property is not available."
In Windows Vista,7/8 works fine.
To try if this method is good for you, try this simple demo on clubdelphi ftp(source included and binary included). In Windows 7 you get information like this:
If you can obtain a correct serial, you can use WMI.
Good library for work with WMI is GLibWMI on Sourceforge. Include a specific component (DiskDriveInfo) that you can use with 0 code lines.
See demo.
Regards
I'm a Delphi developer and have never programmed for netware. But I need to find the owner of a file on a netware share. After some research, I got this code snippet from a newsgroup (original author: Chris Morgan). It's basically a way to dynamically load netware dll and get the "owner" information of a file. Please look at the function GetNetwareFileOwner.
The problem is, I don't have direct access to a netware share for testing. I'm sending a small test program every time to a user who tests it by selecting a file on the netware share and then reports the results. I'm getting the error code by a small code insert after the call NWIntScanExtenedInfo where it fails with the error codes given below. Any ideas what can be wrong?
Error codes:
1) At first, the following code gave error 899E (INVALID_FILENAME) on the above call. The file name was in English--no special characters there. And the file was selected on the share with a regular File Open dialog.
2) After that, suspecting a case problem, I commented the two AnsiUpperCase lines to keep the name in original case exactly as the File Open Dialog received it. This gives the error 89FF now (NO_FILES_FOUND_ERROR).
P.S. I compiled the test with Delphi 2007. May be there is a structure problem of the top structure. I haven't checked the byte length and alignment. Will do so.
// netware records and function definitions
type
// sizeof(NW_EXT_FILE_INFO) should be 140 bytes - check byte alignment
NW_EXT_FILE_INFO = record
sequence: integer;
parent: integer;
attributes: integer;
uniqueID: shortint;
flags: shortint;
nameSpace: shortint;
nameLength: shortint;
name: array[0..11] of shortint;
creationDateAndTime: integer;
ownerID: integer;
lastArchiveDateAndTime: integer;
lastArchiverID: integer;
updateDateAndTime: integer;
lastUpdatorID: integer;
dataForkSize: integer;
dataForkFirstFAT: integer;
nextTrusteeEntry: integer;
reserved: array[0..35] of shortint;
inheritedRightsMask: word;
lastAccessDate: word;
deletedFileTime: integer;
deletedDateAndTime: integer;
deletorID: integer;
reserved2: array[0..15] of shortint;
otherForkSize: array[0..1] of integer;
end;
// functions defined in CALWIN32.DLL
TNWCallsInit = function(reserved1: pointer;
reserved2: pointer): integer; stdcall;
TNWCallsTerm = function(reserved: pointer): integer; stdcall;
TNWParseNetWarePath = function(const path: pchar; var conn: cardinal;
var dirhandle: cardinal; newpath: pchar): integer; stdcall;
TNWAllocTemporaryDirectoryHandle = function(conn: cardinal;
dirhandle: cardinal; const path: pchar; var newdirhandle: cardinal;
rightsmask: pshortint): integer; stdcall;
TNWDeallocateDirectoryHandle = function(conn: cardinal;
dirhandle: cardinal): integer; stdcall;
TNWIntScanExtendedInfo = function(conn: cardinal; dirhandle: cardinal;
attrs: shortint; iterhandle: Pinteger; const searchPattern: pchar;
var entryinfo: NW_EXT_FILE_INFO; augmentflag: shortint): integer;
stdcall;
TNWGetObjectName = function(conn: cardinal; objID: integer;
objname: pchar; objtype: pword): integer; stdcall;
const
FA_NORMAL = $00;
FA_HIDDEN = $02;
FA_SYSTEM = $04;
// return codes
SUCCESSFUL = $00;
NOT_MY_RESOURCE = $883C;
// get file owner for Netware server file
function GetNetwareFileOwner(const FilePath: string): string;
var
hcalwin: HINST;
NWCallsInit: TNWCallsInit;
NWParseNetWarePath: TNWParseNetWarePath;
NWAllocTemporaryDirectoryHandle: TNWAllocTemporaryDirectoryHandle;
NWIntScanExtendedInfo: TNWIntScanExtendedInfo;
NWGetObjectName: TNWGetObjectName;
NWDeallocateDirectoryHandle: TNWDeallocateDirectoryHandle;
NWCallsTerm: TNWCallsTerm;
hconn,
hdir,
retcode: cardinal;
filedir: string; { DOS path of parent folder
(upper case) }
nwfilename: string; { DOS filename (upper case) }
nwfiledir: array[0..255] of char; { Netware path of
parent folder }
rights: shortint;
i: integer;
entryinfo: NW_EXT_FILE_INFO;
objtype: word;
begin
Result := '';
// load netware client library and required functions
hcalwin := LoadLibrary('calwin32.dll');
if hcalwin<=0 then exit; // netware client not present on PC
#NWCallsInit := GetProcAddress(hcalwin,'NWCallsInit');
#NWParseNetWarePath := GetProcAddress(hcalwin,'NWParseNetWarePath');
#NWAllocTemporaryDirectoryHandle := GetProcAddress(hcalwin,
'NWAllocTemporaryDirectoryHandle');
#NWIntScanExtendedInfo :=
GetProcAddress(hcalwin,'NWIntScanExtendedInfo');
#NWGetObjectName := GetProcAddress(hcalwin,'NWGetObjectName');
#NWDeallocateDirectoryHandle := GetProcAddress(hcalwin,
'NWDeallocateDirectoryHandle');
#NWCallsTerm := GetProcAddress(hcalwin,'NWCallsTerm');
// initialise netware libs
if NWCallsInit(nil,nil)<>SUCCESSFUL then exit;
try
filedir := AnsiUpperCase(ExtractFileDir(FilePath));
retcode := NWParseNetWarePath(pchar(filedir),hconn,hdir,nwfiledir);
if retcode=NOT_MY_RESOURCE then exit; // local or non-netware disk
// get a dir handle
NWAllocTemporaryDirectoryHandle(hconn,0,nwfiledir,hdir,#rights);
// get the file info
i := -1;
nwfilename := AnsiUpperCase(ExtractFileName(FilePath));
retcode := NWIntScanExtendedInfo(hconn,hdir,
FA_NORMAL+FA_SYSTEM+FA_HIDDEN,
#i,pchar(nwfilename),entryinfo,0);
if retcode=SUCCESSFUL then begin
// get file owner name from ID
SetLength(Result,MAX_PATH);
retcode := NWGetObjectName(hconn,entryinfo.ownerID,
pchar(Result),#objtype);
if retcode=SUCCESSFUL then
SetLength(Result,Length(Result)) // got owner
else SetLength(Result,0); // failed to get owner
end;
// deallocate dir handle
NWDeallocateDirectoryHandle(hconn,hdir);
finally
// clean up
NWCallsTerm(nil);
FreeLibrary(hcalwin);
end;
end;
Are you sure about stdcall? Tru cdecl and so on.
Also, You done give information about delphi's version.
If you use a version BEFORE delphi2009 pchar is a one-byte char.
But if you use delphi2009 or next, pchar is 2 byte char.
So, if you need one byte char you must use PAnsiChar insthead.
I don't know if netware dll parameters are unicode or ansi...
Cher.
A.
I am building a TFileSaveDialog descendent component. The descendent has a PushButton who's event is handled by:
function TFileDialogEvent.OnButtonClicked(const pfdc: IFileDialogCustomize;
dwIDCtl: DWORD): HResult; stdcall;
var
iImageEnIO: TImageEnIO;
iFilename: string;
iName: PChar;
pfd: IFileDialog;
begin
if dwIDCtl = dwVisualGroup8ID then
begin
iImageEnIO := TImageEnIO.Create(nil);
try
FileDialog.QueryInterface(
StringToGUID('{8016B7B3-3D49-4504-A0AA-2A37494E606F}'),
pfd);
// How to get correct valid handle to IFileDialog?
pfd.GetFileName(iName);
iFilename := string(iName);
if FileExists(iFilename) then
begin
The component also displays image information in various control labels correctly. The component sucessfully returns the selected filename and allows changing folders, but the getting the filename from pfd.GetFileName(iName) in the OnButtonClicked event is returning an invalid filename. I think the problem is caused by not getting the correct handle for pfd: IFileDialog.
UPDATE:
I solved this by defining
FileDialog: IFileDialog as a var at the component level then I called
function TFileDialogEvent.OnButtonClicked(const pfdc: IFileDialogCustomize;
dwIDCtl: DWORD): HResult; stdcall;
var
iImageEnIO: TImageEnIO;
iFilename: string;
pFolder: PWideChar;
iFolder: string;
iName: PChar;
pfd: IFileDialog;
hr: HRESULT;
aShellItem: IShellItem;
begin
if dwIDCtl = dwVisualGroup8ID then
begin
iImageEnIO := TImageEnIO.Create(nil);
try
FileDialog.QueryInterface(IFileDialog, pfd);
pfd.GetFileName(iName);
// Get the ShellItem
hr := SHCreateItemFromParsingName(iName, nil,
StringToGUID(SID_IShellItem), aShellItem);
// Get the folder
pfd.GetFolder(aShellItem);
// Get the folder displayname
aShellItem.GetDisplayName(SIGDN_FILESYSPATH, pFolder);
iFolder := string(pFolder);
if DirectoryExists( iFolder) then
iFilename := IncludeTrailingPathDelimiter( iFolder) + string(iName);
if FileExists(iFilename) then
begin
Thank-you all... Thank-you Rob... your post was helpful.
You're querying the object for an interface matching the GUID {8016B7B3-3D49-4504-A0AA-2A37494E606F}, and storing the result in an IFileDialog reference. The problem is that {8016B7B3-3D49-4504-A0AA-2A37494E606F} is the GUID for the IFileDialogCustomize interface, not IFileDialog. You attempt to call GetFileName, which is the sixth method of the IFileDialog interface, but since the variable actually holds an IFileDialogCustomize interface, control ends up being transferred to the sixth function of that interface instead. The compiler cannot catch the type mismatch for you, partly because you're constructing the GUID dynamically at run time (so it doesn't know the value at compile time), and partly because the second parameter to QueryInterface is untyped (so it can't know that the type of the variable is supposed to match the first parameter).
There's an easier way than computing the GUID at run time. Interface types are automatically useable as their associated GUIDs (when they have GUIDs). To request the IFileDialog interface, just pass that identifier directly to QueryInterface:
FileDialog.QueryInterface(IFileDialog, pfd);
You don't even have to call QueryInterface if you use the as operator:
pfd := FileDialog as IFileDialog;
When you call QueryInterface directly, you need to make sure you check the result for error codes. If you use the as operator, an unsupported interface will raise an exception. If you just want pass-fail without too much error checking, use the Supports function instead:
if Supports(FileDialog, IFileDialog, pfd) then ...
TSaveFileDialog has a public Dialog property of type IFileDialog, so you don't need to hunt for it manually, you already have direct access to it, eg:
function TFileDialogEvent.OnButtonClicked(const pfdc: IFileDialogCustomize; dwIDCtl: DWORD): HResult; stdcall;
var
iImageEnIO: TImageEnIO;
iFilename: string;
iName: PWideChar;
begin
if dwIDCtl <> dwVisualGroup8ID then
Result := E_NOTIMPL
else
begin
Result := S_OK;
if FAILED(Self.Dialog.GetFileName(iName)) then Exit;
try
iFilename := string(iName);
finally
CoTaskMemFree(iName);
end;
iImageEnIO := TImageEnIO.Create(nil);
try
if FileExists(iFilename) then
begin
...
end;
finally
iImageEnIO.Free;
end;
end;
end;
I have the service name for a windows service in delphi, and I know how to get the handle from that as well. What I need to do is stop a service, and if the stop fails for some reason I need to kill the process associated with the service. The problem is that I have multiple services running from the same executable, so I can't use the executable name to kill the process. This means I need the process id to kill the proper associated process. How can I get this id or some way to kill the proper process from the service name or handle?
QueryServiceStatusEx?
Please note I have only accepted this solution so that a full delphi code solution is accepted, all due thanks to Jk though for pointing me on the correct path.
--
Ok, I've been able to figure out how to use the answer by Jk and have come up with this solution in delphi.
For reference, this is the link provided by Jk:
QueryServiceStatusEx
My Solution:
unit Demo;
interface
uses
Windows, Forms, SysUtils,
StdCtrls, WinSvc, Controls, Classes;
type
//Form for basic demo usage
TForm6 = class(TForm)
Button1: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
end;
//Record defined for use as return buffer
_SERVICE_STATUS_PROCESS = record
dwServiceType: DWORD;
dwCurrentState: DWORD;
dwControlsAccepted: DWORD;
dwWin32ExitCode: DWORD;
dwServiceSpecificExitCode: DWORD;
dwCheckPoint: DWORD;
dwWaitHint: DWORD;
dwProcessId: DWORD;
dwServiceFlags: DWORD;
end;
//Function Prototype
function QueryServiceStatusEx(
SC_HANDLE: SC_Handle;
SC_STATUS_TYPE: Cardinal;
out lpBuffer: _SERVICE_STATUS_PROCESS;
cbBufSize: DWORD;
out pcbBytesNeeded: LPDWORD
): BOOL; stdcall;
//internal setup function
function GetPid(sService: String; sMachine: String = '') : Cardinal;
var
Form6: TForm6;
implementation
{$R *.dfm}
const
// windows api library
advapi32 = 'advapi32.dll';
//define the api call
function QueryServiceStatusEx; external advapi32 name 'QueryServiceStatusEx';
//for demo usage
procedure TForm6.Button1Click(Sender: TObject);
begin
Memo1.Lines.Add(IntToStr(Integer(GetPid('Service'))))
end;
function GetPid(sService: String; sMachine: String = '') : Cardinal;
var
schm,
schs: SC_Handle;
SC_STATUS_TYPE: Cardinal;
lpBuffer: _SERVICE_STATUS_PROCESS;
cbBufSize: DWORD;
pcbBytesNeeded: LPDWORD;
begin
//open the service manager (defined in WinSvc)
schm := OpenSCManager(PChar(sMachine), nil, SC_MANAGER_CONNECT);
//set the status type to SC_STATUS_PROCESS_INFO
//this is currently the only value supported
SC_STATUS_TYPE := $00000000;
//set the buffer size to the size of the record
cbBufSize := sizeof(_SERVICE_STATUS_PROCESS);
if (schm>0) then
begin
//grab the service handle
schs := OpenService(schm, PChar(sService), SERVICE_QUERY_STATUS);
if (schs>0) then
begin
//call the function
QueryServiceStatusEx(
schs,
SC_STATUS_TYPE,
lpBuffer,
cbBufSize,
pcbBytesNeeded);
CloseServiceHandle(schs);
end;
CloseServiceHandle(schm);
end;
Result := lpBuffer.dwProcessId;
end;
end.
Please note that not all external naming and other necessities are included.
Or use DSiWin32 for many useful functions, including DSiGetProcessID. This code was written by StackOverflow user (and programmer) Gabr.
Here's the function, for your own reference. It will give you what you are looking for:
//Retrieves ID of the specified process. Requires Toolhelp API.
// #returns False if ID cannot be retrieved. Check GetLastError - if it is 0, process
// doesn't exist; otherwise it contains the Win32 error code.
// #author gabr
// #since 2004-02-12
//
function DSiGetProcessID(const processName: string; var processID: DWORD): boolean;
var
hSnapshot: THandle;
procEntry: TProcessEntry32;
begin
Result := false;
hSnapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
if hSnapshot = 0 then
Exit;
try
procEntry.dwSize := Sizeof(procEntry);
if not Process32First(hSnapshot, procEntry) then
Exit;
repeat
if AnsiSameText(procEntry.szExeFile, processName) then begin
processID := procEntry.th32ProcessID;
Result := true;
break; // repeat
end;
until not Process32Next(hSnapshot, procEntry);
finally DSiCloseHandleAndNull(hSnapshot); end;
end; { DSiGetProcessID }