From what I understand windows Thumbnail providers are DLLs that implement the IThumbnailProvider interface. Yet, when viewing the exported functions of an existing Thumbnail provider I see:
DLLCanUnloadNow
DLLGetClassObject
DLLRegisterServer
DllUnregisterServer
Using these exported functions, how is is possible to get at the GetThumbnail function.
Delphi sample but it easy to convert it to any language you use:
function LoadBitmapWithShellExtension(const ADllFileName: UnicodeString; const ACLSID: TCLSID;
const AFileName: UnicodeString; ASize: Integer; out AAlpha: WTS_ALPHATYPE): HBITMAP;
type
TDllGetClassObject = function(const CLSID, IID: TGUID; out Obj): HRESULT; stdcall;
var
DllModule: HMODULE;
DllGetClassObject: TDllGetClassObject;
ClassFactory: IClassFactory;
ThumbnailProvider: IThumbnailProvider;
InitializeWithFile: IInitializeWithFile;
PersistFile: IPersistFile;
begin
DllModule := LoadLibraryW(PWideChar(ADllFileName));
if DllModule = 0 then RaiseLastOSError;
try
#DllGetClassObject := GetProcAddress(DllModule, 'DllGetClassObject');
if not Assigned(DllGetClassObject) then
RaiseLastOSError;
OleCheck(DllGetClassObject(ACLSID, IClassFactory, ClassFactory));
try
OleCheck(ClassFactory.CreateInstance(nil, IThumbnailProvider, ThumbnailProvider));
try
if Succeeded(ThumbnailProvider.QueryInterface(IInitializeWithFile, InitializeWithFile)) then
try
OleCheck(InitializeWithFile.Initialize(PWideChar(AFileName), STGM_READ));
finally
InitializeWithFile := nil;
end
else
if Succeeded(ThumbnailProvider.QueryInterface(IPersistFile, PersistFile)) then
try
OleCheck(PersistFile.Load(PWideChar(AFileName), STGM_READ));
finally
PersistFile := nil;
end
else
raise Exception.Create('Cannot initialize handler');
OleCheck(ThumbnailProvider.GetThumbnail(ASize, Result, AAlpha));
finally
ThumbnailProvider := nil;
end;
finally
ClassFactory := nil;
end;
finally
FreeLibrary(DllModule);
end;
end;
Related
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.
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;
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;
Guys I got a source from a friend that is suppose to help me learn RE a lot but I got error
Error:identifier not found "TResourceStream"
"Bool"
"TMemoryStream"
"TResourceInfo"
"try"
And
Fatal: Syntax error, ";" expected but " identifier MS" found
Please help I need to compile this.
Excuse me please I know nothing yet, about programming.
Here is the source
function EnumResourceNames(hModule: HMODULE; // EXE handle returned from LoadLibrary/Ex
lpType: PChar; // resource type (eg: RT_RCDATA)
lpEnumFunc: ENUMRESNAMEPROC; // callback function address
lParam: Integer // long integer (eg: pointer to an object)
): BOOL; stdcall;
function CB_EnumDfmNameProc(hModule: THandle; lpszType, lpszName: PChar;
lParam: Integer): Boolean; stdcall;
var
ms: TMemoryStream;
rs: TResourceStream;
Buffer: array of Byte;
begin
with TResourceInfo(lParam) do
begin
rs := TResourceStream.Create(TResourceInfo(lParam).Module,
lpszname, lpszType); // load resource in memory
try
ms := TMemoryStream.Create;
try
try
SetLength(Buffer, 4);
rs.Read(Buffer[0], SizeOf(Buffer)); // read the first 4 bytes
if string(Buffer) = 'TPF0' then // is it a DFM resource?
begin
rs.Seek(0, 0);
ObjectBinaryToText(rs, ms); // decode DFM
ms.Seek(0, 0);
AddDfm(StrPas(lpszName), ms); // add it to our own list
end;
except
raise;
end;
finally
ms.Free;
end;
finally
rs.free;
end;
end;
Result := True;
end;
procedure TResourceInfo.EnumDfmNames;
begin
if FModule > 0 then // if an EXE file has been loaded
EnumResourceNames(FModule, RT_RCDATA, // go and search RCDATA resources
#CB_EnumDfmNameProc, Integer(Self));
end;
I want to get the index in the system imagelist of an object in the shell namespace.
If this object was a file i could use SHGetFileInfo:
function GetFileImageIndex(const Filename: string): Integer;
var
sfi: TSHFileInfo;
begin
SHGetFileInfo(PChar(Filename), FILE_ATTRIBUTE_NORMAL, sfi, SizeOf(sfi),
SHGFI_USEFILEATTRIBUTES or SHGFI_SYSICONINDEX);
Result := sfi.iIcon;
end;
Except i don't have a file
The thing i have doesn't exist on the hard-drive as a folder or file, e.g.:
Control Panel
Homegroup
Network
But i still need to get the index in the system imagelist of the icon that corresponds to this thing. I started with SHGetFileInfo (as it supports pidls). But that fell apart. Then i tried using IExtractIcon, but that fell apart:
function GetObjectImageIndex(ParentFolder: IShellFolder; const ChildPidl: PItemIDList): Integer;
//var
// sfi: TSHFileInfo;
// extractIcon: IExtractIcon;
// iconFile: WideString;
// iconIndexInFile: Integer;
// flags: Cardinal;
begin
{
This function is the shell namespace equivalent of GetFileImageIndex helper function.
}
(*
Won't work (MSDN: "The PIDL must be a fully qualified PIDL. Relative PIDLs are not allowed.")
SHGetFileInfo(PWideChar(ChildPidl), FILE_ATTRIBUTE_NORMAL,
sfi, SizeOf(sfi),
SHGFI_PIDL or SHGFI_SYSICONINDEX);
*)
(*
Won't work. Doesn't return an index into the system imagelist
ParentFolder.GetUIObjectOf(0, 1, ChildPidl, IExtractIcon, nil, {out}extractIcon);
SetLength(iconFile, MAX_PATH);
extractIcon.GetIconLocation(0, PWideChar(iconFile), Length(iconFile), iconIndexInFile, {out}flags);
*)
Result := -1; //TODO: Figure out how to do it.
end;
Given an IShellFolder and a pidl in that folder, how do i get the icon in the system imagelist of that thing?
The simple answer is that you pass an absolute PIDL that identifies the object to SHGetFileInfo. You say you tried that without success, but this is the way to solve your problem.
You should go back to SHGetFileInfo and make it work. It looks like you got as far as having a relative PIDL and stopped. Make an absolute PIDL with ILCombine and you should be home.
If you don't have a PIDL for the containing IShellFolder then you'll want to read this topic: How to obtain the PIDL of an IShellFolder
function CreateGlobalChildIDList(AParentFolder: IShellFolder; const AChildIDList: PItemIDList): PItemIDList; forward;
function GetObjectImageIndex(AParentFolder: IShellFolder; const AChildIDList: PItemIDList): Integer;
var
ShellIcon: IShellIcon;
ChildIDList: PItemIDList;
FileInfo: TSHFileInfo;
begin
try
Result := -1;
try
OleCheck(AParentFolder.QueryInterface(IShellIcon, ShellIcon));
try
OleCheck(ShellIcon.GetIconOf(AChildIDList, GIL_FORSHELL, Result));
finally
ShellIcon := nil;
end;
except
Result := -1;
end;
if Result = -1 then
begin
ChildIDList := CreateGlobalChildIDList(AParentFolder, AChildIDList);
try
ZeroMemory(#FileInfo, SizeOf(FileInfo));
SHGetFileInfo(PWideChar(ChildIDList), FILE_ATTRIBUTE_NORMAL, FileInfo, SizeOf(FileInfo), SHGFI_PIDL or SHGFI_SYSICONINDEX);
Result := FileInfo.iIcon;
finally
CoTaskMemFree(ChildIDList);
end;
end;
except
Result := -1;
end;
end;
function CretaeGlobalChildIDList(AParentFolder: IShellFolder; const AChildIDList: PItemIDList): PItemIDList;
var
PersistFolder2: IPersistFolder2;
PersistIDList: IPersistIDList;
ParentIDList: PItemIDList;
begin
if Succeeded(AParentFolder.QueryInterface(IPersistFolder2, PersistFolder2)) then
try
OleCheck(PersistFolder2.GetCurFolder(ParentIDList));
try
Result := ILCombine(ParentIDList, AChildIDList);
finally
CoTaskMemFree(ParentIDList);
end;
finally
PersistFolder2 := nil;
end
else
if Succeeded(AParentFolder.QueryInterface(IPersistIDList, PersistIDList)) then
try
OleCheck(PersistIDList.GetIDList(ParentIDList));
try
Result := ILCombine(ParentIDList, AChildIDList);
finally
CoTaskMemFree(ParentIDList);
end;
finally
PersistIDList := nil;
end
else
raise Exception.Create('Cannot create PIDL');
end;