unit DesktopIconPos;
////////////////////////////////////////////////////////////
//デスクトップアイコンの位置保存、復帰
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  CommCtrl;

type
//うちの環境では横１５縦１０くらいのアイコンしか配置できないので
//これくらいの配列を確保しておくだけで十分でしょう。
  TDesktopIcon = record
    Caption: String;
    Position: TPoint;
  end;
  TDesktopIcons = array[0..299] of TDesktopIcon;

  TVirtualAllocExProc = function(hProcess : Cardinal; lpAddress : Pointer;
    dwSize, flAllocationType, flProtect : Cardinal) : Pointer; stdcall;
  TVirtualFreeExProc = function(hProcess : Cardinal; lpAddress : Pointer;
    dwSize, dwFreeType : Cardinal) : Boolean; stdcall;

function GetDesktopIcon(var DeskIcons: TDesktopIcons): Integer;
//↑戻り値はアイコンの数
function SetDesktopIcon(DeskIcons: TDesktopIcons): Boolean;
//↑DeskIconsに値が入っていなかったらfalseを返す

implementation

var
  hLibKernel: THandle;
  VirtualAllocExProc1:  TVirtualAllocExProc;
  VirtualFreeExProc1:   TVirtualFreeExProc;

////////////////////////////////////////////////////////////
//デスクトップListViewhandleを得る
function DesktopListViewHandle: HWND;
var
  hWnd1: HWND;
begin
  hWnd1 := FindWindow('ProgMan', nil);
  hWnd1 := GetWindow(hWnd1, GW_CHILD);
  hWnd1 := GetWindow(hWnd1, GW_CHILD);
  Result := hWnd1;
end;

////////////////////////////////////////////////////////////
// デスクトップアイコンの名前と位置を取得WinNT用
function GetDesktopIconWinNT(var DeskIcons: TDesktopIcons): Integer;
var
  hWnd1: HWND;
  dwProcessId: DWORD;
  hProcess: THandle;
  Pointer1: Pointer;
  PLVItem1: PLVITEM;
  PChar1: PChar;
  i: Integer;
  NumberOfBytesRead: Cardinal;
begin
  Result := 0;
  hWnd1 := DesktopListViewHandle;
  if hWnd1 = 0 then exit;

  GetWindowThreadProcessId(hWnd1, @dwProcessId);
  hProcess := OpenProcess(
    PROCESS_VM_OPERATION or PROCESS_VM_READ or PROCESS_VM_WRITE,
    false, dwProcessId);
  if hProcess = 0 then exit;

  Pointer1 := VirtualAllocExProc1(hProcess, nil, 4096,
                      MEM_RESERVE or MEM_COMMIT, PAGE_READWRITE);
  PLVItem1 := AllocMem(SizeOf(TLVItem));
  PChar1 := StrAlloc(256);

  Result := ListView_GetItemCount(hWnd1);
  for i := 0 to Result - 1 do
  begin
//アイコンの名前を取得
      with PLVItem1^ do
      begin
        cchTextMax := 256;
        pszText := Pointer(Cardinal(Pointer1) + SizeOf(TLVItem));
        mask := LVIF_TEXT;
        iItem := i;
        iSubItem := 0;
      end;
      WriteProcessMemory(hProcess, Pointer1, PLVItem1,
        SizeOf(TLVItem) ,NumberOfBytesRead);

      SendMessage(hWnd1, LVM_GETITEM, i, lparam(Pointer1));

      ReadProcessMemory( hProcess, Pointer(Cardinal(Pointer1) +SizeOf(TLVItem)),
        PChar1,DWORD(256), NumberOfBytesRead);
      DeskIcons[i].Caption := PChar1;

//アイコンの位置を取得
    ListView_GetItemPosition(hWnd1, i, PPoint(Pointer1)^);
    ReadProcessMemory( hProcess, Pointer1, @(DeskIcons[i].Position),
                       DWORD(sizeof(TPoint)), NumberOfBytesRead);
  end;

  StrDispose(PChar1);
  FreeMem(PLVItem1);
  VirtualFreeEx(hProcess, Pointer1, 0, MEM_RELEASE);
  CloseHandle(hProcess);
end;

// デスクトップアイコンの名前と位置を取得Win9x用
function GetDesktopIconWin9x(var DeskIcons: TDesktopIcons): Integer;
var
  hWnd1: HWND;
  hMap: THandle;
  PLVItem1: PLVITEM;
  i: Integer;
begin
  Result := 0;
  hWnd1 := DesktopListViewHandle;
  if hWnd1 = 0 then exit;

  // 共有マップドメモリを取得する
  hMap := CreateFileMapping(THANDLE(-1), nil,
                            PAGE_READWRITE, 0, 4096, '_ShareMem');
  PLVItem1 := PLVITEM( MapViewOfFile(hMap, FILE_MAP_ALL_ACCESS, 0, 0, 0) );

  Result := ListView_GetItemCount(hWnd1);
  // アイコンの位置を取得する
  for i := 0 to Result - 1 do
  begin
    PLVItem1.iItem := i;
    PLVItem1.mask := LVIF_TEXT;
    PLVItem1.cchTextMax := 256;
    PLVItem1.pszText := LPSTR(PChar(PLVItem1) + SizeOf(PLVItem1^));

    ListView_GetItem( hWnd1, PLVItem1^);
    DeskIcons[i].Caption :=String(PLVItem1^.pszText);

    SendMessage( hWnd1, LVM_GETITEMPOSITION, i, lparam(PLVItem1));
    DeskIcons[i].Position := PPoint(PLVItem1)^;
  end;

  //共用マップドメモリを解放する
  UnmapViewOfFile(PLVItem1);
  CloseHandle(hMap);
end;

////////////////////////////////////////////////////////////
// デスクトップアイコンの名前と位置を復元WinNT用

//↓重複アイコンNameが複数ある場合の対応
//　実際に重複アイコンは簡単に３こくらい作れる
//　マイコンピュータとフォルダとショートカットで作れるのだ

//NowIconsとIndexからアイコンの名前を取得して
//適切なアイコン位置をFromIconsから取り出す関数
function GetIconInfo(NowIconIndex: Integer;
 NowIcons, FromIcons: TDesktopIcons): TPoint;
var
  i, IconNumber, DifferenceBuff, DataIconsCount: Integer;
  DeskIconList: TList;
begin
  i := 0;
  DeskIconList := TList.Create;
  try
    while (FromIcons[i].Caption <> '')   //名前無しはIcon無しとみなす
          and (i < High(TDesktopIcons)) do
    begin
      if NowIcons[NowIconIndex].Caption = FromIcons[i].Caption then
      begin
        DeskIconList.Add(Pointer(i));//マッチする名前だったばあいListに番号を代入
      end;
      Inc(i);
    end;
    DataIconsCount := i;

    case DeskIconList.Count of
      0: begin
        Result := Point(0, 0);
      end;
      1: begin //名前にマッチするアイコンが一つだった場合
        Result := FromIcons[Integer( DeskIconList.Items[0] )].Position;
      end;
      else
      begin
        DifferenceBuff := DataIconsCount - 1;
        IconNumber := Integer( DeskIconList.Items[0] );
        for i := 0 to DeskIconList.Count - 1 do
        begin
          if (ABS(NowIconIndex - Integer(DeskIconList.Items[i])) < 
DifferenceBuff) then
          begin
            DifferenceBuff := ABS(NowIconIndex - 
Integer(DeskIconList.Items[i]));
            IconNumber := Integer(DeskIconList.Items[i]);
          end;
        end;
        Result := FromIcons[IconNumber].Position;
      end;
    end;
  finally
    DeskIconList.Free;
  end;

end;

procedure SetDesktopIconWinNT(SetDeskIcons: TDesktopIcons);
var
  i, nItems: Integer;
  NowDeskIcons: TDesktopIcons;
  IconPoint: TPoint;
begin
//デスクトップハンドルが得られないと戻り値は0なのでループ無し
  nItems := GetDesktopIcon( NowDeskIcons );
  for i := 0 to nItems -1 do
  begin
    IconPoint := GetIconInfo( i, NowDeskIcons, SetDeskIcons);
    if (IconPoint.x = 0) and (IconPoint.y = 0) then
      //該当データが無いという事なので無視
    else
      ListView_SetItemPosition(DesktopListViewHandle, i, IconPoint.x, 
IconPoint.y);
  end;  // 位置の設定
end;

// デスクトップアイコンの名前と位置を復元Win9x用
procedure SetDesktopIconWin9x(SetDeskIcons: TDesktopIcons);
var
  i, nItems: Integer;
  NowDeskIcons: TDesktopIcons;
  IconPoint: TPoint;
begin
  nItems := GetDesktopIcon( NowDeskIcons );
  for i := 0 to nItems - 1 do
  begin
    IconPoint := GetIconInfo( i, NowDeskIcons, SetDeskIcons);
    if (IconPoint.x = 0) and (IconPoint.y = 0) then
      //該当データが無いという事なので無視
    else
      SendMessage( DesktopListViewHandle, LVM_SETITEMPOSITION, i,
                   MakeLParam(IconPoint.x, IconPoint.y));
  end;
end;

////////////////////////////////////////////////////////////
//WinNTと9xとの区別をするインターフェース
function GetDesktopIcon(var DeskIcons: TDesktopIcons): Integer;
begin
  VirtualAllocExProc1 := nil;
  VirtualFreeExProc1  := nil;
  Result := 0;

  if Win32Platform = VER_PLATFORM_WIN32_NT then    // NTでの処理
  begin
    hLibKernel := LoadLibrary('Kernel32.dll');
    if hLibKernel = 0 then
    begin
      Application.Terminate;      exit;
    end;

    VirtualAllocExProc1 := TVirtualAllocExProc(
      GetProcAddress(hLibKernel, 'VirtualAllocEx'));
    VirtualFreeExProc1 := TVirtualFreeExProc(
      GetProcAddress(hLibKernel, 'VirtualFreeEx'));

    if (@VirtualAllocExProc1 = nil) or
       (@VirtualFreeExProc1 = nil) then
    begin
      Application.Terminate;      exit;
    end;

    Result := GetDesktopIconWinNT( DeskIcons )
  end else                                             // 9xでの処理
  begin
    Result := GetDesktopIconWin9x( DeskIcons );
  end;

  FreeLibrary(hLibKernel);
end;


function SetDesktopIcon(DeskIcons: TDesktopIcons): Boolean;

  {IconPos情報が入っていない時ははじく}
  function IconPosSetting: Boolean;
  var
    i: Integer;
  begin
    Result := false;
    for i := Low(TDesktopIcons) to High(TDesktopIcons) do
    begin
      if (DeskIcons[i].Caption = '')
         and (DeskIcons[i].Position.x = 0)
         and (DeskIcons[i].Position.y = 0) then
      else
        Result := true;
    end;
  end; //一つもアイコンデータが入っていない場合 false を返す

begin
  if not IconPosSetting then
  begin
    Result := false;
    exit;
  end else
    Result := true;

  if Win32Platform = VER_PLATFORM_WIN32_NT then
    SetDesktopIconWinNT( DeskIcons )
  else
    SetDesktopIconWin9x( DeskIcons );
end;

end.


(*-----------------------------------
//テストボタン
procedure TMainForm.Button1Click(Sender: TObject);
var
  TestDeskIcons: TDesktopIcons;
  Loop, i: Integer;
begin
  Loop := GetDesktopIcon( TestDeskIcons ) - 1;
  for i := 0 to Loop do
  begin
    with TestDeskIcons[i] do
    Memo1.Lines.Add(
     Caption+' '+IntToStr(Position.x)+'-'+IntToStr(Position.y));
  end;
end;


procedure TMainForm.Button2Click(Sender: TObject);
begin
  GetDesktopIcon( FDesktopIcons );
end;

procedure TMainForm.Button3Click(Sender: TObject);
begin
  SetDesktopIcon( FDesktopIcons );
end;
//-----------------------------------*)