Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Shortcuts for active desktop

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Shortcuts for active desktop

    Just now I rewrite a "loader" of one program.
    This loader updates a release through Internet and places ordinary shortcuts into Start/Programs.
    In additional I decided to add "clever" icon on deskiop (similar "Internet Explorer", "My computer" and so on).

    Advantages: no arrow in left-down corner; additional menu (right click)

    18.06. Added a "custom view" (right click; "explorer")

    Code:
       ' Creating icons similar "My Computer", "My documents" ... (IE4+, active desktop)
       ' ==============================================================================
       ' Author: Semen Mstusovski     [email protected]
       ' Based on some MSDN articles + own experiments
       '
       ' Some notes.
       '    1. If you start this program from IDE, it will be created a new icon on desktop.
       '    2. If to select "Update from Internet" (right click on desktop icon), a shortcut will be updated.
    
       #Compile Exe
       #Dim All
       #Register None
       #Include "win32Api.Inc"
    
       $MainPrg = "notepad.exe" ' <---- Change
       $Cmd1 = "Execute"
       $Cmd2 = "Update"
       $Cmd3 = "Explorer"
       $Cmd4 = "Remove an icon"
    
       Type CLSID
          Data1 As Long
          Data2 As Integer
          Data3 As Integer
          Data4(7) As Byte
        End Type
    
       %SHCNF_IDLIST        = &H0
       %SHCNE_ASSOCCHANGED  = &H08000000&
       %SHCNF_FLUSHNOWAIT   = &H2000&
    
       Declare Sub SHChangeNotify Lib "shell32.dll" Alias "SHChangeNotify" (ByVal wEventId As Long, ByVal uFlags As Dword, _
          dwItem1 As Any, dwItem2 As Any)
       Declare Function CoCreateGuid Lib "OLE32.DLL" Alias "CoCreateGuid" (CLSID) As Long
       Declare Function CoInitialize Lib "ole32.dll" Alias "CoInitialize" (ByVal pvReserved As Dword) As Dword
       Declare Sub CoUninitialize Lib "ole32.dll" Alias "CoUninitialize"
       Declare Sub CoTaskMemFree Lib "ole32.dll" Alias "CoTaskMemFree" (pv As Dword)
    
       Function GetCLSID() As String
          Dim CLSID As CLSID
          CoCreateGuid CLSID
          If (CoCreateGuid(CLSID) = 0) Then Function = "{" + Hex$(CLSID.Data1, 8) + "-" + _
             Hex$(CLSID.Data2, 4)+ "-" + Hex$(CLSID.Data3, 4) + "-" + _
             Hex$(CLSID.Data4(0), 2) + Hex$(CLSID.Data4(1), 2) + "-" + _
             Hex$(CLSID.Data4(2), 2) + Hex$(CLSID.Data4(3), 2) + _
             Hex$(CLSID.Data4(4), 2) + Hex$(CLSID.Data4(5), 2) + _
             Hex$(CLSID.Data4(6), 2) + Hex$(CLSID.Data4(7), 2) + "}"
       End Function
    
       Function AddRegKey(ByVal mKey As Long, lpSubKey As Asciiz) As Long
          Dim hKey As Long, dwDisposition As Long
          If RegCreateKeyEx(mKey, lpSubKey, ByVal 0&, "", %REG_OPTION_NON_VOLATILE, %KEY_ALL_ACCESS, _
             ByVal 0&, hKey, dwDisposition) = %ERROR_SUCCESS Then RegCloseKey hKey Else Function = 1
       End Function
    
       Function SetRegValueSZ (ByVal mKey As Long, lpSubKey As Asciiz, lpValueName As Asciiz, lpData As Asciiz) As Long
          Dim hKey As Long, dwDisposition As Long
          If RegCreateKeyEx(mKey, lpSubKey, ByVal 0&, "", %REG_OPTION_NON_VOLATILE, %KEY_ALL_ACCESS, _
             ByVal 0&, hKey, dwDisposition) = %ERROR_SUCCESS Then _
             Function = RegSetValueEx (hKey, lpValueName, ByVal 0&, %REG_SZ, lpData, Len(lpData)): _
             RegCloseKey hKey Else Function = 1
       End Function
    
       Function SetRegValueDW (ByVal mKey As Long, lpSubKey As Asciiz, lpValueName As Asciiz, lpData As Dword) As Long
          Dim hKey As Long, dwDisposition As Long
          If RegCreateKeyEx(mKey, lpSubKey, ByVal 0&, "", %REG_OPTION_NON_VOLATILE, %KEY_ALL_ACCESS, _
             ByVal 0&, hKey, dwDisposition) = %ERROR_SUCCESS Then _
             Function = RegSetValueEx (hKey, lpValueName, ByVal 0&, %REG_DWORD, lpData, 4): _
                RegCloseKey hKey Else Function = 1
       End Function
    
       Function PbMain
          Dim TmpAsciiz As Asciiz * %MAX_PATH, cCLSID As String
          Dim i As Long, f As Long, CatalogExe As String, FileNm As String
    
          If GetModuleFileName(GetModuleHandle(ByVal 0&), TmpAsciiz, _
             SizeOf(TmpAsciiz)) = 0 Then Exit Function
    
          i = Instr(-1, TmpAsciiz, "\")
          CatalogExe = Left$(TmpAsciiz, i)
          FileNm = Mid$(TmpAsciiz, i + 1)
    
          CoInitialize 0
    
          If Left$(Command$, 15) = "$#DELETE CLSID=" Then
             cCLSID =  Mid$(Command$, 16)
           
             SetAttr CatalogExe + "folder.htt", %FILE_ATTRIBUTE_NORMAL: Kill CatalogExe + "folder.ini"
             SetAttr CatalogExe + "desktop.ini", %FILE_ATTRIBUTE_NORMAL: Kill CatalogExe + "desktop.ini"
             SetAttr CatalogExe, %FILE_ATTRIBUTE_DIRECTORY
    
             RegDeleteKey %HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Explorer\Desktop\Namespace\" + cCLSID
    
             RegDeleteKey %HKEY_CLASSES_ROOT, "CLSID\" + cCLSID + "\ShellFolder"
          
             RegDeleteKey %HKEY_CLASSES_ROOT, "CLSID\" + cCLSID + "\Shell\" + $Cmd4 + "Command"
             RegDeleteKey %HKEY_CLASSES_ROOT, "CLSID\" + cCLSID + "\Shell\" + $Cmd4
    
             RegDeleteKey %HKEY_CLASSES_ROOT, "CLSID\" + cCLSID + "\Shell\" + $Cmd3 + "Command"
             RegDeleteKey %HKEY_CLASSES_ROOT, "CLSID\" + cCLSID + "\Shell\" + $Cmd3
    
             RegDeleteKey %HKEY_CLASSES_ROOT, "CLSID\" + cCLSID + "\Shell\" + $Cmd2 + "Command"
             RegDeleteKey %HKEY_CLASSES_ROOT, "CLSID\" + cCLSID + "\Shell\" + $Cmd2
    
             RegDeleteKey %HKEY_CLASSES_ROOT, "CLSID\" + cCLSID + "\Shell\" + $Cmd1 + "Command"
             RegDeleteKey %HKEY_CLASSES_ROOT, "CLSID\" + cCLSID + "\Shell\" + $Cmd1
    
             RegDeleteKey %HKEY_CLASSES_ROOT, "CLSID\" + cCLSID + "\Shell"
             RegDeleteKey %HKEY_CLASSES_ROOT, "CLSID\" + cCLSID + "\DefaultIcon"
    
             RegDeleteKey %HKEY_CLASSES_ROOT, "CLSID\" + cCLSID
             
          Else
             If Left$(Command$, 15) = "$#UPDATE CLSID=" Then cCLSID =  Mid$(Command$, 16) Else cCLSID = GetCLSID
    
             f = FreeFile
             Open CatalogExe + "desktop.ini" For Output As #f Len = 32768
             Print #f, "[.ShellClassInfo]"
             Print #f, "Infotip=This is a completely custom folder"
             Print #f, "IconFile=" $MainPrg
             Print #f, "IconIndex=0"
             Print #f, "[ExtShellFolderViews]"
             Print #f, "Default={5984FFE0-28D4-11CF-AE66-08002B2E1262}"
             Print #f, "{5984FFE0-28D4-11CF-AE66-08002B2E1262}={5984FFE0-28D4-11CF-AE66-08002B2E1262}"
             Print #f, "[{5984FFE0-28D4-11CF-AE66-08002B2E1262}]"
             Print #f, "PersistMoniker=file://Folder.htt"
             Close #f
    
             Open CatalogExe + "Folder.htt" For Output As #f Len = 32768
             Print #f, "<html>"
             Print #f, "<script language=VBScript>"
             Print #f, "Function Toggle()"
             Print #f, "   If toggleView.innerText = ""Show Files"" Then"
             Print #f, "      toggleView.innerText = ""Hide Files"""
             Print #f, "      internals.style.display = ""None"""
             Print #f, "      FileList.style.display = """""
             Print #f, "   Else
             Print #f, "      toggleView.innerText = ""Show Files"""
             Print #f, "      FileList.style.display = ""None""
             Print #f, "      internals.style.display = """"
             Print #f, "   End If"
             Print #f, "End Function"
             Print #f, "</script>
    
             Print #f, "<body>
             Print #f, "<b>This is my folder</b> --------- <a id=toggleView href=vbscript:Toggle>Show Files</a>"
             Print #f, "<hr><object id=FileList border=0 width=100% height=50% tabindex=1 style=display:None classid=""clsid:1820FED0-473E-11D0-A96C-00C04FD705A2""></object>"
             Print #f, "<div id=internals>
             Print #f, "Any HTML text (including scripts, gifs, and so on)."
             Print #f, "(BTW, sometimes MSDN is enough useful)"
             Print #f, "</div>
             Print #f, "</body>
             Print #f, "</html>
             Close #f
    
             SetAttr CatalogExe + "folder.htt", %FILE_ATTRIBUTE_HIDDEN
             SetAttr CatalogExe + "desktop.ini", %FILE_ATTRIBUTE_HIDDEN
             SetAttr CatalogExe, %FILE_ATTRIBUTE_READONLY Or %FILE_ATTRIBUTE_DIRECTORY
    
             AddRegKey     %HKEY_CLASSES_ROOT, "CLSID"
             AddRegKey     %HKEY_CLASSES_ROOT, "CLSID\" + cCLSID
             SetRegValueSZ %HKEY_CLASSES_ROOT, "CLSID\" + cCLSID, "", "My PB app " + Time$
             SetRegValueSZ %HKEY_CLASSES_ROOT, "CLSID\" + cCLSID, "InfoTip", "My Pb App ----(InfoTip)"
             AddRegKey     %HKEY_CLASSES_ROOT, "CLSID\" + cCLSID + "\DefaultIcon"
             SetRegValueSZ %HKEY_CLASSES_ROOT, "CLSID\" + cCLSID + "\DefaultIcon", "", $MainPrg + ",0" ' <--- ,0 is no. of icon
    
             AddRegKey     %HKEY_CLASSES_ROOT, "CLSID\" + cCLSID + "\Shell"
    
             AddRegKey     %HKEY_CLASSES_ROOT, "CLSID\" + cCLSID + "\Shell\" + $Cmd1
             AddRegKey     %HKEY_CLASSES_ROOT, "CLSID\" + cCLSID + "\Shell\" + $Cmd1 + "\Command"
             SetRegValueSZ %HKEY_CLASSES_ROOT, "CLSID\" + cCLSID + "\Shell\" + $Cmd1 + "\Command", "", $MainPrg
    
             AddRegKey     %HKEY_CLASSES_ROOT, "CLSID\" + cCLSID + "\Shell\" + $Cmd2
             AddRegKey     %HKEY_CLASSES_ROOT, "CLSID\" + cCLSID + "\Shell\" + $Cmd2 + "\Command"
             SetRegValueSZ %HKEY_CLASSES_ROOT, "CLSID\" + cCLSID + "\Shell\" + $Cmd2 + "\Command", "", _
                                               $DQ + TmpAsciiz + $DQ + " $#UPDATE CLSID=" + cCLSID
    
             AddRegKey     %HKEY_CLASSES_ROOT, "CLSID\" + cCLSID + "\Shell\" + $Cmd3
             AddRegKey     %HKEY_CLASSES_ROOT, "CLSID\" + cCLSID + "\Shell\" + $Cmd3 + "\Command"
             SetRegValueSZ %HKEY_CLASSES_ROOT, "CLSID\" + cCLSID + "\Shell\" + $Cmd3 + "\Command", "", _
                                               "explorer.exe " + $DQ + CatalogExe + $DQ
    
             AddRegKey     %HKEY_CLASSES_ROOT, "CLSID\" + cCLSID + "\Shell\" + $Cmd4
             AddRegKey     %HKEY_CLASSES_ROOT, "CLSID\" + cCLSID + "\Shell\" + $Cmd4 + "\Command"
             SetRegValueSZ %HKEY_CLASSES_ROOT, "CLSID\" + cCLSID + "\Shell\" + $Cmd4 + "\Command", "", _
                                               $DQ + TmpAsciiz + $DQ + " $#DELETE CLSID=" + cCLSID
    
             AddRegKey     %HKEY_CLASSES_ROOT, "CLSID\" + cCLSID + "\ShellFolder"
             SetRegValueDW %HKEY_CLASSES_ROOT, "CLSID\" + cCLSID + "\ShellFolder", "Attributes", 0
    
             AddRegKey     %HKEY_LOCAL_MACHINE, "Software"
             AddRegKey     %HKEY_LOCAL_MACHINE, "Software\Microsoft"
             AddRegKey     %HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows"
             AddRegKey     %HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion"
             AddRegKey     %HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Explorer"
             AddRegKey     %HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Explorer\Desktop"
             AddRegKey     %HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Explorer\Desktop\Namespace"
             AddRegKey     %HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Explorer\Desktop\Namespace\" + cCLSID
             SetRegValueSZ %HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Explorer\Desktop\Namespace\" + cCLSID, "", "My PB app"
          End If
    
          SHChangeNotify %SHCNE_ASSOCCHANGED, %SHCNF_IDLIST Or %SHCNF_FLUSHNOWAIT, ByVal 0, ByVal 0
    
          CoUninitialize
    
       End Function
    [This message has been edited by Semen Matusovski (edited June 18, 2001).]
Working...
X