OPTION EXPLICIT

' ms "starting"  ' ms is a message box sub with vbcr cancel
'234567890'234567890'234567890'234567890'234567890'234567890'234567890'234567890  scale helps debugging error messages


' special folders

      ' AllUsersDesktop
      ' AllUsersStartMenu
      ' AllUsersPrograms
      ' AllUsersStartup
      ' Desktop
      ' Favorites
      ' Fonts
      ' MyDocuments
      ' NetHood
      ' PrintHood
      ' Programs
      ' Recent
      ' SendTo
      ' StartMenu
      ' Startup
      ' Templates

dim recurseCount

DIM rc
DIM lnkString
DIM strFolder
DIM  IncludeSubFolders
DIM objFSO
Dim objNetwork
Dim objShell
Dim msg
Dim HotKeyCount
HotKeyCount = 0
' ************************************************************
' Setup
' ************************************************************
SET objShell = CREATEOBJECT("wscript.shell")

SET objFSO = CREATEOBJECT("Scripting.FileSystemObject")
Set objNetwork = CreateObject("WScript.Network")
SET objFSO = CREATEOBJECT("Scripting.FileSystemObject")
lnkString = ""
recurseCount = 0

' finally found the short that had the zombie hot key in
' --> C:UserspkryderAppDataRoamingMicrosoftInternet ExplorerQuick LaunchUser PinnedTaskBar
' it was also in --> C:UserspkryderAppDataRoamingMicrosoftIMJP10
' how why?


' C:ProgramDataMicrosoftWindows
      strFolder = "C:ProgramDataMicrosoftWindows" ' objShell.SpecialFolders.Item ("Templates")
FindHotKeys strFolder


' C:ProgramDataMicrosoftWindows
      strFolder = "C:users" ' objShell.SpecialFolders.Item ("Templates")
FindHotKeys strFolder




strFolder = objShell.SpecialFolders.Item("AllUsersStartup")
FindHotKeys strFolder

strFolder = objShell.SpecialFolders.Item("Programs")
FindHotKeys strFolder

strFolder = objShell.SpecialFolders.Item("Desktop")
FindHotKeys strFolder


'      "AllUsersDesktop"
strFolder = objShell.SpecialFolders.Item("AllUsersDesktop")
FindHotKeys strFolder

      ' AllUsersStartMenu
strFolder = objShell.SpecialFolders.Item ("AllUsersStartMenu")
FindHotKeys strFolder


      ' AllUsersPrograms

strFolder = objShell.SpecialFolders.Item ("AllUsersStartMenu")
FindHotKeys strFolder

      strFolder = objShell.SpecialFolders.Item ("AllUsersStartup")
FindHotKeys strFolder
      strFolder = objShell.SpecialFolders.Item ("Desktop")
FindHotKeys strFolder
      strFolder = objShell.SpecialFolders.Item ("Favorites")
FindHotKeys strFolder
      strFolder = objShell.SpecialFolders.Item ("Fonts")
FindHotKeys strFolder
      strFolder = objShell.SpecialFolders.Item ("MyDocuments")
FindHotKeys strFolder
      strFolder = objShell.SpecialFolders.Item ("NetHood")
FindHotKeys strFolder
      strFolder = objShell.SpecialFolders.Item ("PrintHood")
FindHotKeys strFolder
      strFolder = objShell.SpecialFolders.Item ("Programs")
FindHotKeys strFolder
      strFolder = objShell.SpecialFolders.Item ("Recent")
FindHotKeys strFolder
      strFolder = objShell.SpecialFolders.Item ("SendTo")
FindHotKeys strFolder
      strFolder = objShell.SpecialFolders.Item ("StartMenu")
FindHotKeys strFolder
      strFolder = objShell.SpecialFolders.Item ("Startup")
FindHotKeys strFolder
      strFolder = objShell.SpecialFolders.Item ("Templates")
FindHotKeys strFolder













if lnkString = "" then
    ms "no hotkeys wer found"
else
    if HotKeyCount = 1 then
            ms "done " &vbcr & HotKeyCount & " hotKey was found " & vbcr & lnkString
    else
        ms "done " &vbcr & HotKeyCount & " hotKeys were found " & vbcr & lnkString
    end if
end if




SUB FindHotKeys(BYVAL strDirectory)
    DIM objFolder
    DIM objSubFolder
    DIM objFile
    DIM strExt
    DIM errSav
    Dim n1
    Dim ws1
    Dim errSav2
    dim errSav3
    dim bIsAshortcut
    Dim n2
    Dim n3
    Dim intMsgSave



    n3 = 9999
    n2 = 9999
    n1 = 9999
    ws1 = n1
    dim FileCount
    dim SubFolderCount

on error goto 0

errSav = 0
errSav2 = 0
errSav3 = 0
bIsAshortcut = false



msg = "strDirectory" & vbcr & vbcr & strDirectory
' ms msg & vbcr & "076"

'234567890'234567890'234567890'234567890'234567890'234567890'234567890'234567890  scale helps debugging error messages
on error goto 0
on error resume next

SET objFolder = objFSO.GetFolder(strDirectory)
errSav = err.number

FileCount =  objFolder.files.count
errSav2 = err.number
SubFolderCount = objFolder.SubFolders.count
on error goto 0


msg = msg & vbcr & "errSav2:" & errSav2 & vbcr & "errSav:" & errSav
msg = msg &  vbcr & "FileCount:" & FileCount
msg = msg &  vbcr & "SubFolderCount:" & SubFolderCount

' ms msg & vbcr & "092"


If errSav = 0 then  ' we have subfolders

    on error resume next
    FOR EACH objSubFolder in objFolder.SubFolders
            errSav2 = err.number
            on error goto 0
            If errSav2 = 0 then
            ' ms "102"
                recurseCount = recurseCount + 1
                FindHotKeys objSubFolder.Path ' recurse through this new sub folder
                recurseCount = recurseCount - 1
            ' ms "110"
            end if
            on error resume next
    NEXT
    on error goto 0

'   ms "115" & vbcr & "in files" & vbcr& vbcr & strDirectory

    n2 = 0
    on error resume next '      had some trouble with file not found? so ignore that
    FOR EACH objFile in objFolder.Files
            errSav = err.number
            n2 = n2 + 1
            dim sObjFileName
            dim iLength
            sObjFileName = objFile.name
            errSav3 = err.number
            on error goto 0
            iLength = len(sObjFileName)

            bIsAshortcut = false
            if (right(sObjFileName,4) = ".lnk")  then ' look only at the end of the string
                bIsAshortcut = true
                '  msgbox ">" & objFile.name & "<"
                else                                   ' something had .lnk embedded but not at the end
                if instr(sObjFileName,".lnk") > 0 then
                   msgbox  strDirectory & vbcr & ">" & objFile.name & "<"  & vbcr &  s'? who has lnk not at end of name
                end if
            end if





            if bIsAshortcut  Then
                dim lnk
                dim filePath
                filepath = strDirectory & "" & objFile.name
                ' ms "128  have an lnk file " & vbcr & filePath
                dim hotKey
                set lnk = objShell.CreateShortcut(filepath)
                errSav2 = err.number
                hotKey = lnk.hotkey
                if hotKey <> "" then
                    ';ms "129" & vbcr & "errSav2:" & errSav2    & vbcr & "hotKey:" & hotKey
                    HotKeyCount = HotKeyCount + 1
                    if len(lnkString) > 900 then
                        msgbox len(lnkString) & vbcr & lnkString
                        lnkString = ""
                    end if
                    if instr(lnkString,strDirectory & " | ") = 0 then
                        lnkString = lnkString & vbcr & vbcr &  "-" &  vbcr & strDirectory & " | " ' put blank and bar on the end to differentiate sub directories
                    else
                    end if
                    lnkString = lnkString & vbcr & HotKeyCount & " " & hotKey & "  " & objFile.name
                    'ms "138" & lnkString
                    ' save to text file
                end if
            END IF
        on error resume next

     NEXT

END IF


END SUB


sub ms(BYVAL m)
'   rc = msgbox ( "recurseCount:"&recurseCount & vbcr & vbcr & m , vbcrOKCancel)
    rc = msgbox (  m , vbOKCancel)
    if rc = vbCancel then wscript.quit

end sub