ShellObj(sfDesktopObj) / Desktop problem ...

delphi package - easy access to shell apis
Post Reply
lastOne
Posts: 9
Joined: Wed Sep 03, 2008 4:50 am
Contact:

ShellObj(sfDesktopObj) / Desktop problem ...

Post by lastOne »

ShellObj(sfDesktopObj) / Desktop works as expected in Win XP x86 and Vista x86, unfortunately it doesn`t seems to work on WinXP x64 SP2.

On XP x64 the Position property for any icon is -1/-1.


... any ideas how to fix it ?

thank you
Alin
Nico Bendlin
Posts: 46
Joined: Fri Apr 28, 2006 1:17 pm

Re: ShellObj(sfDesktopObj) / Desktop problem ...

Post by Nico Bendlin »

lastOne wrote:... any ideas how to fix it ?
It has to be fixed in the source code.
The 64-bit versions of the structs have to be used for the messages. I added this feature in my local copy - maybe I can share the modifications...
lastOne
Posts: 9
Joined: Wed Sep 03, 2008 4:50 am
Contact:

Post by lastOne »

pls do ... at least privately to me until madshi sees this thread and approve it :D

thank you
madshi
Site Admin
Posts: 10339
Joined: Sun Mar 21, 2004 5:25 pm

Re: ShellObj(sfDesktopObj) / Desktop problem ...

Post by madshi »

Nico Bendlin wrote:
lastOne wrote:... any ideas how to fix it ?
It has to be fixed in the source code.
The 64-bit versions of the structs have to be used for the messages. I added this feature in my local copy - maybe I can share the modifications...
That would be quite welcome!
Nico Bendlin
Posts: 46
Joined: Fri Apr 28, 2006 1:17 pm

Post by Nico Bendlin »

Sorry for the late reply.
I will not have access to this source until next week. So you have to wait for the next Monday for an answer (with source).
lastOne
Posts: 9
Joined: Wed Sep 03, 2008 4:50 am
Contact:

Post by lastOne »

thank you :crazy:
Nico Bendlin
Posts: 46
Joined: Fri Apr 28, 2006 1:17 pm

Post by Nico Bendlin »

Add this utility stuff before TIShellObj.RefreshItems:

Code: Select all

////////////////////////////////////////////////////////////////////////////////
//FIXME: [NicoDE] 2008-09-29 TIShellObj Active Desktop support
(**)
function GetDesktopListView(): HWND;
  function EnumFunc(AParent: HWND; out AWindow: HWND): BOOL; stdcall;
  var
    ClassName: array [Byte] of Char;
  begin
    AWindow := AParent;
    ClassName[0] := #0;
    GetClassName(AParent, ClassName, Length(ClassName));
    Result := lstrcmp(ClassName, 'SHELLDLL_DefView') <> 0;
  end;
const
  NULL = HWND(nil);
begin
  Result := FindWindow('Progman', nil);
  if Result = NULL then
    Exit;
  Result := FindWindowEx(Result, NULL, 'SHELLDLL_DefView', nil);
  if Result = NULL then
    Exit;
  if FindWindowEx(Result, NULL, 'HTML_Internet Explorer', nil) <> NULL then
    EnumChildWindows(Result, TFNWndEnumProc(@EnumFunc), LPARAM(@Result));
  Result := FindWindowEx(Result, 0, 'SysListView32', nil);
end;
(**)

////////////////////////////////////////////////////////////////////////////////
//FIXME: [NicoDE] 2008-09-29 TIShellObj 64-bit support
(**)
type
  PLVItem32 = ^TLVItem32;
  TLVItem32 = packed record
    mask      : LongWord;  // 00
    iItem     : LongInt;   // 04
    iSubItem  : LongInt;   // 08
    state     : LongWord;  // 0C
    stateMask : LongWord;  // 10
    pszText   : LongWord;  // 14
    cchTextMax: LongInt;   // 18
    iImage    : LongInt;   // 1C
    lParam    : LongWord;  // 20
    iIndent   : LongInt;   // 24
    iGroupId  : LongInt;   // 28
    cColumns  : LongWord;  // 2C
    puColumns : LongWord;  // 30
    piColFmt  : LongWord;  // 34
    iGroup    : LongInt;   // 38
  end;                     //(3C)
  PLVItem64 = ^TLVItem64;
  TLVItem64 = packed record
    mask      : LongWord;   // 00
    iItem     : LongInt;    // 04
    iSubItem  : LongInt;    // 08
    state     : LongWord;   // 0C
    stateMask : LongWord;   // 10
    alignment1: LongWord;   // 14
    pszText   : ULONGLONG;  // 18
    cchTextMax: LongInt;    // 20
    iImage    : LongInt;    // 24
    lParam    : ULONGLONG;  // 28
    iIndent   : LongInt;    // 30
    iGroupId  : LongInt;    // 34
    cColumns  : LongWord;   // 38
    alignment2: LongWord;   // 3C
    puColumns : ULONGLONG;  // 40
    piColFmt  : ULONGLONG;  // 48
    iGroup    : LongInt;    // 50
    alignment3: LongWord;   // 54
  end;                      //(58)
  PLVItemBuffer = ^TLVItemBuffer;
  TLVItemBuffer = packed record
    case Integer of
      0: (
        // Shared members
        mask     : LongWord;  // 00
        iItem    : LongInt;   // 04
        iSubItem : LongInt;   // 08
        state    : LongWord;  // 0C
        stateMask: LongWord;  // 10
      );
      32: (LVItem32: TLVItem32);
      64: (LVItem64: TLVItem64);
  end;
  TFNIsWow64Process = function(hProcess: THandle; out Wow64Process: BOOL): BOOL; stdcall;
function WrappedIsWow64Process(hProcess: THandle; out Wow64Process: BOOL): BOOL; stdcall; forward;
var
  IsWow64Process: TFNIsWow64Process = WrappedIsWow64Process;
function EmulateIsWow64Process(hProcess: THandle; out Wow64Process: BOOL): BOOL; stdcall;
begin
  if Assigned(Addr(Wow64Process)) then
    Wow64Process := False;
  SetLastError(ERROR_CALL_NOT_IMPLEMENTED);
  Result := False;
end;
function WrappedIsWow64Process(hProcess: THandle; out Wow64Process: BOOL): BOOL; stdcall;
var
  ProcAddress: TFNIsWow64Process;
begin
  ProcAddress := TFNIsWow64Process(GetProcAddress(GetModuleHandle(kernel32), 'IsWow64Process'));
  if Assigned(ProcAddress) then
    IsWow64Process := ProcAddress
  else
    IsWow64Process := EmulateIsWow64Process;
  Result := IsWow64Process(hProcess, Wow64Process);
end;
function IsProcess64Bit(AProcess: THandle): Boolean;
var
  Wow64Process: BOOL;
begin
  Result := IsWow64Process(AProcess, Wow64Process) and not Wow64Process;
end;
(**)
This are the modifications in TIShellObj.RefreshItems (second block (** )commented out(**) is the original code):

Code: Select all

////////////////////////////////////////////////////////////////////////////////
//FIXME: [NicoDE] 2008-09-29 TIShellObj 64-bit support
(**)
       lvItem  : TLVItemBuffer;
(** )
       lvItem  : TLVItem;
(**)

Code: Select all

////////////////////////////////////////////////////////////////////////////////
//FIXME: [NicoDE] 2008-09-29 TIShellObj 64-bit support
(**)
              ph := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_OPERATION or PROCESS_VM_READ or PROCESS_VM_WRITE, false, pid);
(** )
              ph := OpenProcess(PROCESS_VM_OPERATION or PROCESS_VM_READ or PROCESS_VM_WRITE, false, pid);
(**)

Code: Select all

////////////////////////////////////////////////////////////////////////////////
//FIXME: [NicoDE] 2008-09-29 TIShellObj 64-bit support
(**)
                        with buf.lvItem do
                        begin
                          mask := LVIF_TEXT or LVIF_STATE;
                          iItem := i1;
                        end;
                        if IsProcess64Bit(ph) then
                          with buf.lvItem.LVItem64 do
                          begin
                            pszText := ULONGLONG(@p1^.caption);
                            cchTextMax := Length(p1^.caption);
                          end
                        else
                          with buf.lvItem.LVItem32 do
                          begin
                            pszText := LongWord(@p1^.caption);
                            cchTextMax := Length(p1^.caption);
                          end;
(** )
                        with buf.lvItem do begin
                          mask       := LVIF_TEXT or LVIF_STATE;
                          iItem      := i1;
                          iSubItem   := 0;
                          pszText    := @p1^.caption;
                          cchTextMax := MAX_PATH;
                        end;
(**)
Well, the changes are for demonstration purposes only - the code should be optimized and/or rewritten (e.g. not calling IsProcess64Bit inside the loop...).

TODOs: Search for 'Progman' in the source and use GetDesktopListView() and fix TIShellObj.SetPosition().
madshi
Site Admin
Posts: 10339
Joined: Sun Mar 21, 2004 5:25 pm

Post by madshi »

Thank you!
ThievingSix
Posts: 5
Joined: Tue Sep 11, 2007 2:37 am
Location: Southern California
Contact:

Post by ThievingSix »

This is a little late, but:

I ran into the same issue and used the fix listed here which worked great for solving the problem on 64bit machines, but I lost functionality on 32bit machines.

The problem is you're calling IsWow64Process with the process handle of the desktop. This function will return False for a 64 bit process on a 64 bit machine. (I'm guessing this is why you add "and not"). So it returns True on 32 bit machines as well.

The workaround (at least until Delphi can produce 64 bit programs) is to call IsWow64Process on yourself (GetCurrentProcess).

I hope this fix will be integrated into madShell to fix some of the functionality =P
madshi
Site Admin
Posts: 10339
Joined: Sun Mar 21, 2004 5:25 pm

Re: ShellObj(sfDesktopObj) / Desktop problem ...

Post by madshi »

The latest beta build already has a modified patch in it for this:

http://madshi.net/madCollectionBeta.exe
Post Reply