Private Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As _
  Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, _
  lpNumberOfBytesWritten As Long) As Long
Private Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As _
Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, _
lpNumberOfBytesWritten As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As _
Any, lpSource As Any, ByVal cBytes As Long)
Private Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long
 
Private Declare Function SendMessage& Lib "user32" Alias "SendMessageA" (ByVal _
  hWnd&, ByVal wMsg&, ByVal wParam&, lParam As Any)
Private Const LVM_FIRST = &H1000
Private Const LVM_GETTITEMCOUNT& = (LVM_FIRST + 4)
Private Const LVM_SETITEMPOSITION& = (LVM_FIRST + 15)
Private Const LVM_GETITEMPOSITION& = (LVM_FIRST + 16)
Private Const WM_COMMAND = &H111
Private Const IDM_TOGGLEAUTOARRANGE = &H7041
 
'=============================================================
Dim ptOriginal() As POINTAPI
Dim ptCurrent() As POINTAPI
Dim xScreen As Long, yScreen As Long
Dim bAutoArrange As Boolean
 
Public Sub RestoreDesktopIcons()
   Dim h As Long, nCount As Long, i As Long
   h = GetSysLVHwnd
   nCount = SendMessage(h, LVM_GETTITEMCOUNT, 0, 0&)
   For i = 0 To nCount - 1
       Call SendMessage(h, LVM_SETITEMPOSITION, i, ByVal CLng(ptOriginal(i).x + _
         ptOriginal(i).y * &H10000))
   Next
   If bAutoArrange Then
      Call SendMessage(GetParent(h), WM_COMMAND, IDM_TOGGLEAUTOARRANGE, ByVal _
        0&)
   End If
End Sub
 
Public Function StoreDeskTopInfo() As Boolean
   Dim pid As Long, tid As Long, lStyle As Long
   Dim hProcess As Long, lpSysShared As Long, dwSize As Long
   Dim nCount As Long, lWritten As Long, hFileMapping As Long
   Dim h As Long, i As Long
   h = GetSysLVHwnd
   If h = 0 Then Exit Function
   If (GetWindowLong(h, GWL_STYLE) And LVS_AUTOARRANGE) = LVS_AUTOARRANGE Then
      bAutoArrange = True
      Call SendMessage(GetParent(h), WM_COMMAND, IDM_TOGGLEAUTOARRANGE, ByVal _
        0&)
   End If
   tid = GetWindowThreadProcessId(h, pid)
   nCount = SendMessage(h, LVM_GETTITEMCOUNT, 0, 0&)
   If nCount = 0 Then Exit Function
   xScreen = Screen.Width \ Screen.TwipsPerPixelX
   yScreen = Screen.Height \ Screen.TwipsPerPixelY
   ReDim ptOriginal(nCount - 1)
   ReDim ptCurrent(nCount - 1)
   dwSize = Len(ptOriginal(0))
   If IsWindowsNT Then
      lpSysShared = GetMemSharedNT(pid, dwSize, hProcess)
      WriteProcessMemory hProcess, ByVal lpSysShared, ptOriginal(0), dwSize, _
        lWritten
      For i = 0 To nCount - 1
          SendMessage h, LVM_GETITEMPOSITION, i, ByVal lpSysShared
          ReadProcessMemory hProcess, ByVal lpSysShared, ptOriginal(i), dwSize, _
            lWritten
      Next i
      FreeMemSharedNT hProcess, lpSysShared, dwSize
   Else
      lpSysShared = GetMemShared95(dwSize, hFileMapping)
      CopyMemory ByVal lpSysShared, ptOriginal(0), dwSize
      For i = 0 To nCount - 1
          SendMessage h, LVM_GETITEMPOSITION, i, ByVal lpSysShared
          CopyMemory ptOriginal(i), ByVal lpSysShared, dwSize
          ptCurrent(i).x = xScreen / 2
          ptCurrent(i).y = yScreen / 2
      Next i
      FreeMemShared95 hFileMapping, lpSysShared
   End If
   StoreDeskTopInfo = True
End Function
 
Private Function GetSysLVHwnd() As Long
   Dim h As Long
   h = FindWindow("Progman", vbNullString)
   h = FindWindowEx(h, 0, "SHELLDLL_defVIEW", vbNullString)
   GetSysLVHwnd = FindWindowEx(h, 0, "SysListView32", vbNullString)
End Function
 
Public Function GetMemShared95(ByVal memSize As Long, hFile As Long) As Long
    hFile = CreateFileMapping(&HFFFFFFFF, 0, PAGE_READWRITE, 0, memSize, _
      vbNullString)
    GetMemShared95 = MapViewOfFile(hFile, FILE_MAP_ALL_ACCESS, 0, 0, 0)
End Function
 
Public Sub FreeMemShared95(ByVal hFile As Long, ByVal lpMem As Long)
    UnmapViewOfFile lpMem
    CloseHandle hFile
End Sub
 
Public Function GetMemSharedNT(ByVal pid As Long, ByVal memSize As Long, _
  hProcess As Long) As Long
    hProcess = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ Or _
    PROCESS_VM_WRITE, False, pid)
    GetMemSharedNT = VirtualAllocEx(ByVal hProcess, ByVal 0&, ByVal memSize, _
    MEM_RESERVE Or MEM_COMMIT, PAGE_READWRITE)
End Function
 
Public Sub FreeMemSharedNT(ByVal hProcess As Long, ByVal MemAddress As Long, _
  ByVal memSize As Long)
   Call VirtualFreeEx(hProcess, ByVal MemAddress, memSize, MEM_RELEASE)
   CloseHandle hProcess
End Sub
 
Public Function IsWindowsNT() As Boolean
   Dim verinfo As OSVERSIONINFO
   verinfo.dwOSVersionInfoSize = Len(verinfo)
   If (GetVersionEx(verinfo)) = 0 Then Exit Function
   If verinfo.dwPlatformId = 2 Then IsWindowsNT = True
End Function