Saving desktop Icons

After another annoying rearrangement of my icons, I wrote this small Delphi class (and corresponding program). SaveIcons takes either a parameter save or restore and just either saves or restores the icons. it’s a zip file containing the program and source and is released under the GPL.
I’ll probably get around to writing it in C++ as well – delphi was a pain creating all those messages, and it’s not Unicode aware.


Main program:

program SaveIcons;
(*
* Code by Peter Shanahan, 2005
* Use is subject to License Terms (GPL)
*)
uses
  SysUtils,
  be_SaveIcons in 'be_SaveIcons.pas',
  Windows;
{$R *.res}
var
  save : TSaveIcons;
begin
  if (ParamCount = 0) then begin
    MessageBox(0, 'Usage: SaveIcons save|restore',
      'Usage', MB_OK);
    Exit;
  end;
  save := TSaveIcons.Create;
  if (UpperCase(ParamStr(1)) = 'SAVE') then
    save.FindForSaveRestore(true)
  else if (UpperCase(ParamStr(1)) = 'RESTORE') then
    save.FindForSaveRestore(false)
  else
    MessageBox(0, 'Usage: SaveIcons save|restore',
      'Usage', MB_OK);
end.

Class that does the work:

unit be_SaveIcons;
(*
* Code by Peter Shanahan, 2005
* Use is subject to License Terms (GPL)
*)
interface
uses
  Windows, SysUtils, registry;
type
  TSaveIcons = class
  public
    procedure FindForSaveRestore(save : boolean);
  private
    procedure walkListView(window : HWND; process : THandle; save : boolean);
    function getProcessForWindow(window : HWND) : THandle;
  end;
implementation
type LV_ITEM = packed record
  mask : UINT;
  iItem : Integer;
  iSubItem : Integer;
  state : UINT;
  stateMask : UINT;
  pszText : PChar;
  cchTextMax : Integer;
  iImage : Integer;
  iIndent : Integer;
  iGroupId : Integer;
  cColumns : UINT;
  puColumns : PUINT;
end;
type PLV_ITEM = ^LV_ITEM;
const LVM_FIRST : Integer = $1000;
const LVM_GETITEMCOUNT : Integer = $1000 + 4;
const LVM_GETITEMA : Integer = $1000 + 5;
const LVM_GETITEMW : Integer = $1000 + 75;
const LVM_GETITEM : Integer = $1000 + 5;
const LVM_GETITEMTEXTA : Integer = $1000 + 45;
const LVM_GETITEMTEXTW : Integer = $1000 + 115;
const LVM_GETITEMTEXT : Integer = $1000 + 45;
const LVM_GETITEMPOSITION : Integer = $1000 + 16;
const LVM_SETITEMPOSITION : Integer = $1000 + 15;
const LVIF_TEXT : Integer = $1;
const ITEM_BUFFER : Integer = $4000;
type ESystemError = class(Exception)
  private
    fExceptionString : string;
  public
    constructor Create(ErrNo : Cardinal);
    property ExceptionString : string read fExceptionString;
end;
procedure TSaveIcons.FindForSaveRestore(save : boolean);
var
  hwWindow : HWND;
  hwParent : HWND;
  process : THandle;
begin
   hwParent := FindWindowEx(0, 0, nil, 'Program Manager');
   if (hwParent = 0) then raise ESystemError.Create(GetLastError);
   hwWindow := FindWindowEx(hwParent, 0, nil, nil);
   if (hwWindow = 0) then raise ESystemError.Create(GetLastError);
   hwWindow := FindWindowEx(hwWindow, 0, 'SysListView32', 'FolderView');
   // Get the ListViewItems Locations on screen (and text)
   if (hwWindow <> 0) then begin
     process := getProcessForWindow(hwWindow);
     if (process <> INVALID_HANDLE_VALUE) then try
       walkListView(hwWindow, process, save);
     finally
       CloseHandle(process);
     end;
   end;
end;
function TSaveIcons.getProcessForWindow(window: HWND): THandle;
var
  iProcessID : DWORD;
begin
  GetWindowThreadProcessId(window, iProcessID);
  Result := OpenProcess(PROCESS_VM_OPERATION or PROCESS_VM_READ or
                     PROCESS_VM_WRITE or PROCESS_QUERY_INFORMATION,
                     false, iProcessID);
end;
procedure TSaveIcons.walkListView(window: HWND; process : THandle;
  save : boolean);
var
  cItems : LRESULT;
  iItem : WPARAM;
  lvItem : LV_ITEM;
  plvRemoteItem : PLV_ITEM;
  pRemoteItemPoint : PPoint;
  ItemPoint : TPoint;
  pszItemText : PChar;
  pszRemoteItemText : PChar;
  nReadWritten : DWORD;
  ri : TRegIniFile;
begin
  pszItemText := AllocMem(ITEM_BUFFER);
  FillMemory(addr(lvItem), sizeof(LV_ITEM), 0);
  plvRemoteItem := VirtualAllocEx(process, nil,
    sizeof(LV_ITEM), MEM_COMMIT, PAGE_READWRITE);
  pszRemoteItemText := VirtualAllocEx(process, nil,
    ITEM_BUFFER, MEM_COMMIT, PAGE_READWRITE);
  pRemoteItemPoint := VirtualAllocEx(process, nil,
    sizeof(TPoint), MEM_COMMIT, PAGE_READWRITE);
  ri := TRegIniFile.Create('Software\petesh.com\Desktop Icon Location store');
  try
    try
      if (pszRemoteItemText = nil) then raise ESystemError.Create(GetLastError);
      cItems := SendMessage(window, LVM_GETITEMCOUNT, 0, 0);
      dec(cItems);
      lvItem.cchTextMax := ITEM_BUFFER;
      lvItem.iSubItem := 0;
      lvItem.pszText := pszRemoteItemText;
      for iItem := 0 to cItems do begin
        if (not WriteProcessMemory(process, plvRemoteItem, addr(lvItem),
            sizeof(LV_ITEM), nReadWritten)) then
          raise ESystemError.Create(GetLastError);
        SendMessage(window, LVM_GETITEMTEXT, WPARAM(iItem), LPARAM(plvRemoteItem));
        if (not ReadProcessMemory(process, pszRemoteItemText,
            pszItemText, ITEM_BUFFER, nReadWritten)) then
          raise ESystemError.Create(GetLastError);
        if (save) then begin
          SendMessage(window, LVM_GETITEMPOSITION, WPARAM(iItem),
            LPARAM(pRemoteItemPoint));
          if (not ReadProcessMemory(process, pRemoteItemPoint,
              addr(ItemPoint), sizeof(TPoint), nReadWritten)) then
            raise ESystemError.Create(GetLastError);
          ri.WriteBinaryData(pszItemText, ItemPoint, sizeof(TPoint));
        end else begin
          try
            if (ri.ReadBinaryData(pszItemText, ItemPoint, sizeof(TPoint)) =
                sizeof(TPoint)) then begin
              SendMessage(window, LVM_SETITEMPOSITION, WPARAM(iItem),
                (ItemPoint.Y shl 16) or ItemPoint.X);
            end;
          except end;
        end;
      end;
    finally
      ri.Free;
      FreeMem(pszItemText);
      VirtualFreeEx(process, pszRemoteItemText, 0, MEM_RELEASE);
      VirtualFreeEx(process, plvRemoteItem, 0, MEM_RELEASE);
      VirtualFreeEx(process, pRemoteItemPoint, 0, MEM_RELEASE);
    end;
  except on ex : ESystemError do
    Writeln(ex.ExceptionString);
  end;
end;
{ ESystemError }
constructor ESystemError.Create(ErrNo: Cardinal);
var
  pszErrString : PChar;
  sLang : SHORT;
begin
  pszErrString := nil;
  sLang := (SUBLANG_DEFAULT shl 10) or LANG_NEUTRAL;
  FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER or FORMAT_MESSAGE_FROM_SYSTEM,
    nil,
    errno,
    sLang,
    pszErrString,
    0,
    nil);
  fExceptionString := pszErrString;
  FreeMem(pszErrString);
end;
end.