home *** CD-ROM | disk | FTP | other *** search
/ PC Welt 1999 September / PCW0999.ISO / sharewar / prx / tips / URLkey.exe / URLkey.vbs
Encoding:
Text File  |  1999-06-09  |  2.2 KB  |  72 lines
  1. Option Explicit
  2. dim oFileSys, f, Ausgabedatei, ausgabe, extension, scut
  3. dim Dir
  4. Dim IntDoIt, retstring, sString, Pos,  KeyChar, KeyKey, KeyVal
  5. Dim Startmenu, Desktop, Favoriten, WSHSHell, UrlFile
  6. Const ForReading = 1, ForWriting = 2
  7. set WSHShell = CreateObject("WScript.Shell")
  8. Startmenu = WSHShell.SpecialFolders("Startmenu")
  9. Desktop = WSHShell.SpecialFolders("Desktop")
  10. Favoriten = WSHShell.SpecialFolders("Favorites")
  11. WSHShell.Popup "Suche Tastenkombinationen...Bitte Warten!", 1
  12. Set oFileSys = CreateObject("Scripting.FileSystemObject")
  13. Ausgabedatei = "C:\Hotkeys.TXT"
  14. set ausgabe = oFileSys.CreateTextFile(ausgabedatei, vbTrue)
  15. ausgabe.WriteLine "Liste der Tastenkombinationen" + vbNewLine
  16. ausgabe.WriteLine "Hotkeys Desktop:" + vbNewLine
  17. GetDir Desktop
  18. ausgabe.WriteLine vbNewLine
  19. ausgabe.WriteLine "Hotkeys Startmenāæ:" + vbNewLine
  20. GetDir Startmenu
  21. ausgabe.WriteLine vbNewLine
  22. ausgabe.WriteLine "Hotkeys Favoriten:" + vbNewLine
  23. GetDir Favoriten
  24. ausgabe.WriteLine vbNewLine
  25. ausgabe.close
  26. WSHShell.Run Ausgabedatei
  27. ' -----------------------------
  28. sub GetDir(dir)
  29. dim oFolder,oFolders,oFiles,item,Item2
  30. set oFolder=oFileSys.GetFolder(dir)
  31. set oFolders=oFolder.SubFolders
  32. set oFiles=oFolder.Files
  33. For each item in oFolders
  34.     GetDir(item)
  35. Next
  36.     item2=0
  37.     For each item2 in oFiles
  38.         extension = lcase(oFileSys.GetExtensionName(item2.Name))
  39.     If Extension="url" Then
  40.     UrlFile=Dir &"\"&item2.Name
  41.     Set f = oFileSys.OpenTextFile(UrlFile, ForReading)
  42.     Do While f.AtEndOfStream <> True
  43.         retstring = f.ReadLine
  44.         sString="Hotkey="
  45.         Pos = Instr(retstring, sString)
  46.         If Pos Then
  47.         KeyVal=Mid(retstring,Pos+Len(sString))
  48.          If Cint(KeyVal) >0 Then
  49.          set scut = WSHShell.CreateShortcut(URLFile)
  50.          CalcHotKey KeyVal, item2.name, scut.TargetPath
  51.          End IF
  52.         End IF
  53.     Loop
  54.     End If 
  55. next
  56. end sub
  57.  
  58. Sub CalcHotKey (KeyVal, FileName, Pfad)
  59. KeyChar=Cint(keyVal) And 255
  60. KeyKey= KeyChar Xor Cint(keyVal)
  61. Select Case KeyKey
  62. Case 768
  63.     retstring="Strg+Umschalt.+ " & Chr(KeyChar)
  64. Case 1280
  65.     retstring="Alt+Umschalt.+ " & Chr(KeyChar)
  66. Case 1536
  67.     retstring="Strg+Alt+ " & Chr(KeyChar)
  68. Case 1792
  69.     retstring="Strg+Alt+Umschalt.+ " & Chr(KeyChar)
  70. End Select
  71. ausgabe.WriteLine retstring & " zugewiesen " & FileName &" im Pfad " & Pfad
  72. End Sub