home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / Desk_Toppe832205142002.psc / Module2.bas < prev    next >
Encoding:
BASIC Source File  |  2002-05-15  |  8.2 KB  |  277 lines
  1. Attribute VB_Name = "Module2"
  2. '==================
  3. 'R E A D    T H I S
  4. '==================
  5. 'ABOUT THE PROGRAM
  6. 'When this program is first run, it will make a copy
  7. 'of your desktop and put it in the app's path in
  8. 'the folder \Original
  9. 'However you desktop looked when you first ran the
  10. 'program is how the program restores your desktop
  11. 'to original from the popupmenu
  12. 'If you want to restart the original copy, then
  13. 'delete the file "Desktopper.ini"
  14. 'and the folder "MyShortcuts" in the app's path
  15. '
  16. '
  17. 'WARNING!!!!!!!!!!
  18. 'YOU REALLY SHOULD BACK UP YOUR DESKTOP ICONS
  19. 'BEFORE RUNNING THIS PROGRAM, AS IT DOES A LOT
  20. 'OF MANIPULATING OF THE DESKTOP ICONS
  21. 'JUST COPY ALL THE FILES FROM C:\Windows\Desktop
  22. 'TO A FOLDER OF YOUR CHOICE
  23. 'YOU'VE BEEN WARNED.
  24. '
  25. 'IF YOU DON'T BACKUP AND YOU LOSE YOUR ICONS, THEN
  26. 'I DON'T WANT TO KNOW ABOUT IT!
  27. '
  28. '
  29. 'IN THE RARE CASE THAT THIS PROGRAM CRASHES AND
  30. 'LEAVES YOUR DESKTOP INCOMPLETE, YOU CAN RESTORE
  31. 'IT BY COPYING THE FILES BACK TO C:\Windows\Desktop
  32. '
  33. 'ONE MORE THING - WHEN USING THE BUMP BUTTONS
  34. 'YOU CAN INCREASE THE BUMP AMOUNT BY HOLDING DOWN
  35. 'THE <Ctrl>, <Shift> and/or <Alt> KEYS
  36. '
  37. '
  38. 'HAVE FUN AND IF YOU HAVE ANY PROBLEMS YOU CAN
  39. 'CONTACT ME AT kleena@optushome.com.au
  40. '
  41.  
  42.  
  43.  
  44.  
  45.  
  46.  
  47.  
  48.  
  49.  
  50.  
  51.  
  52.  
  53.  
  54.  
  55.  
  56. ' THANKS TO THE GUY BELOW FOR THIS AWESOME CODE !!!
  57.  
  58.  
  59. ':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  60. ' Locate Desktop Icons Source Code VB6
  61. ' Created 11 April 1999
  62. ' By Paul Pavlic
  63. ' abuse and advice to    pepp@cyberdude.com
  64. ' Feel free to use anyway you can
  65. ' FreeWare
  66. ' Works on Win95
  67. '
  68. ' Special thanks to Bruce McKinney
  69. ' Author of Hardcore Visual Basic
  70. ' A wonderful book with a great many insights
  71. '
  72. ' Why?
  73. ' I looked all over the Internet, and never once saw any working
  74. ' code to do this, thought I would make a contribution
  75. ' Why call it Paulies Pet?
  76. ' Was the name of my Desktop Pet in VB3 rewriting it now to VB6
  77. '
  78. ' This code resolves Explorer page faults when trying to send
  79. ' LVM_GETITEMPOSITION to the Desktop Listview
  80. '
  81. '*************************************
  82.  
  83.  
  84.  
  85.  
  86.  
  87.  
  88.  
  89. Option Explicit
  90.  
  91. 'constants
  92. Public Const GENERIC_READ = &H80000000
  93. Public Const GENERIC_WRITE = &H40000000
  94. Public Const OPEN_ALWAYS = 4
  95. Public Const FILE_ATTRIBUTE_NORMAL = &H80
  96. Public Const SECTION_MAP_WRITE = &H2
  97. Public Const FILE_MAP_WRITE = SECTION_MAP_WRITE
  98.  
  99. 'NOT documented in Win32api.txt
  100. Public Const PAGE_READWRITE As Long = &H4
  101.  
  102. Public Const LVM_GETTITEMCOUNT& = (&H1000 + 4)
  103. Public Const LVM_SETITEMPOSITION& = (&H1000 + 15)
  104. Public Const LVM_FIRST = &H1000
  105. Public Const LVM_GETITEMPOSITION = (LVM_FIRST + 16)
  106. Public Const LVM_GETITEMTEXT = LVM_FIRST + 45
  107.  
  108. Public Const GW_CHILD = 5
  109.  
  110. 'damn  hell of a lot of declares
  111. 'copymemory *3 avoid byval in code - bug? works this way
  112.  
  113.  
  114.  
  115.  
  116. Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
  117. (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
  118. Private Declare Sub CopyMemoryOne Lib "kernel32" Alias "RtlMoveMemory" _
  119. (ByVal hpvDest&, hpvSource As Any, ByVal cbCopy As Long)
  120. Private Declare Sub CopyMemoryTwo Lib "kernel32" Alias "RtlMoveMemory" _
  121. (hpvDest As Any, ByVal hpvSource&, ByVal cbCopy As Long)
  122.  
  123. Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
  124. (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam _
  125. As Any) As Long
  126. Declare Function SendMessageByLong& Lib "user32" Alias "SendMessageA" _
  127. (ByVal hwnd&, ByVal wMsg&, ByVal wParam&, ByVal lParam&)
  128.  
  129. Private Declare Function FindWindow& Lib "user32" Alias "FindWindowA" _
  130. (ByVal lpClassName As String, ByVal lpWindowName As String)
  131. Private Declare Function FindWindowEx& Lib "user32" Alias _
  132. "FindWindowExA" (ByVal hWndParent As Long, ByVal hWndChildAfter _
  133. As Long, ByVal lpClassName As String, ByVal lpWindowName As String)
  134.  
  135. 'declares for printing to the desktop or other window for debug purposes
  136. Public Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal _
  137. hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal lpString As _
  138. String, ByVal nCount As Long) As Long
  139. Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
  140. Public Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, _
  141. ByVal hDC As Long) As Long
  142. Public Declare Function InvalidateRect Lib "user32" (ByVal hwnd As Long, _
  143. lpRect As Any, ByVal bErase As Long) As Long
  144.  
  145. Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
  146.  
  147. 'declares for memory-mapped files
  148. Public Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" _
  149. (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, _
  150. ByVal dwShareMode As Long, lpSecurityAttributes As Any, _
  151. ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As _
  152. Long, ByVal hTemplateFile As Long) As Long
  153. ' changed lpFileMappigAttributes to Any, makes life much easier
  154. Public Declare Function CreateFileMappingTwo Lib "kernel32" Alias _
  155. "CreateFileMappingA" (ByVal hFile As Long, lpFileMappigAttributes _
  156. As Any, ByVal flProtect As Long, ByVal dwMaximumSizeHigh As Long, _
  157. ByVal dwMaximumSizeLow As Long, ByVal lpName As String) As Long
  158. Public Declare Function MapViewOfFile Lib "kernel32" (ByVal _
  159. hFileMappingObject As Long, ByVal dwDesiredAccess As Long, ByVal _
  160. dwFileOffsetHigh As Long, ByVal dwFileOffsetLow As Long, ByVal _
  161. dwNumberOfBytesToMap As Long) As Long
  162. Public Declare Function UnmapViewOfFile Lib "kernel32" (lpBaseAddress _
  163. As Any) As Long
  164. Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject _
  165. As Long) As Long
  166. Public Declare Function FlushViewOfFile Lib "kernel32" (ByVal lpBaseAddress _
  167. As Long, ByVal dwNumberOfBytesToFlush As Long) As Long
  168.  
  169. 'type declarations
  170. Public Type LV_ITEM ' might need this if we ever figure out
  171.     mask As Long    ' how to retrieve the text
  172.     iItem As Long
  173.     iSubItem As Long
  174.     State As Long
  175.     stateMask As Long
  176.     pszText As Long
  177.     cchTextMax As Long
  178.     iImage As Long
  179.     lParam As Long  ' I think we might need a second
  180.     iIndent As Long ' memory mapped file
  181. End Type
  182.  
  183. Public Type POINTAPI
  184.         X As Long
  185.         Y As Long
  186. End Type
  187.  
  188.  
  189. 'dimension some variables
  190. Dim pNull As Long
  191. Dim MyValue As Long
  192. Dim MyValue2 As Long
  193. Dim sFileName As String
  194. Dim CurrentDirectory As String
  195. Dim hdesk As Long
  196. Dim i As Long
  197. Public ixPOS() As Integer
  198. Public iyPOS() As Integer
  199.  
  200.  
  201.  
  202.  
  203. Function FindIcons() As Integer
  204. Dim hFile As Long
  205. Dim hFileMap As Long
  206. Dim pFileMap As Long
  207. Dim c As POINTAPI
  208. Dim iCount As Long
  209.  
  210. pNull = 0
  211. hdesk = FindWindow("progman", vbNullString)
  212. hdesk = FindWindowEx(hdesk, 0, "shelldll_defview", vbNullString)
  213. hdesk = FindWindowEx(hdesk, 0, "syslistview32", vbNullString)
  214. 'hdesk is the handle of the Desktop's listview
  215. iCount = SendMessageByLong(hdesk, LVM_GETTITEMCOUNT, 0, 0&)
  216.  
  217.  
  218.  
  219. 'create a memory-mapped file /////
  220. CurrentDirectory = App.Path
  221. If Right(CurrentDirectory, 1) <> "\" Then
  222.    CurrentDirectory = CurrentDirectory & "\"
  223. End If
  224. sFileName = CurrentDirectory & "TEMPPPPP.PPP"
  225. ' Open file
  226. hFile = CreateFile(sFileName, GENERIC_READ Or GENERIC_WRITE, 0, ByVal pNull, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, pNull)
  227. ' get handle
  228. hFileMap = CreateFileMappingTwo(hFile, ByVal pNull, PAGE_READWRITE, 0, 16, "MyMapping")
  229. ' Get pointer to memory representing file
  230. pFileMap = MapViewOfFile(hFileMap, FILE_MAP_WRITE, 0, 0, 0)
  231.  
  232. ReDim Preserve ixPOS(iCount)
  233. ReDim Preserve iyPOS(iCount)
  234. ReDim Preserve BumpOrgX(iCount)
  235. ReDim Preserve BumpOrgY(iCount)
  236.  
  237.  
  238. For i = 0 To iCount - 1
  239.    'lparam is mem-map file Pointer
  240.    Call SendMessageByLong(hdesk, LVM_GETITEMPOSITION, i, pFileMap)
  241.    'copy returned to our POINTAPI (c.x,c.y)
  242.    CopyMemoryTwo c, pFileMap, 8
  243.    'show me where the icons are
  244.    ixPOS(i + 1) = c.X
  245.    iyPOS(i + 1) = c.Y
  246.    BumpOrgX(i + 1) = c.X
  247.    BumpOrgY(i + 1) = c.Y
  248.    'put value in our arrays
  249.    'IconPosition(i) = c
  250.    'back up array for swapping later
  251.    'IconPosition2(i) = c
  252. Next i
  253.  
  254. 'Release resources back to windows
  255. FlushViewOfFile pFileMap, 8
  256. UnmapViewOfFile pFileMap
  257. CloseHandle hFileMap
  258. CloseHandle hFile
  259.  
  260.  
  261.  
  262. FindIcons = iCount
  263.  
  264. End Function
  265.  
  266.  
  267.  
  268.  
  269.  
  270. Public Function GetDesktopWindow() As Long
  271. Dim lng As Long
  272. lng = FindWindow("Progman", vbNullString)
  273. lng = GetWindow(lng, GW_CHILD)
  274. GetDesktopWindow = GetWindow(lng, GW_CHILD)
  275.  
  276. End Function
  277.