IE Lesezeichen auslesen

    • VB6

      IE Lesezeichen auslesen

      Viellt. kann das ja jmd gebrauchen. (Sollte leicht zu .NET umwandelbar sein)

      Quellcode

      1. Option Explicit
      3. Public Enum SpecialFolderIDs
      4. sfidDESKTOP = &H0
      5. sfidPROGRAMS = &H2
      6. sfidPERSONAL = &H5
      7. sfidFAVORITES = &H6
      8. sfidSTARTUP = &H7
      9. sfidRECENT = &H8
      10. sfidSENDTO = &H9
      11. sfidSTARTMENU = &HB
      12. sfidDESKTOPDIRECTORY = &H10
      13. sfidNETHOOD = &H13
      14. sfidFONTS = &H14
      15. sfidTEMPLATES = &H15
      16. sfidCOMMON_STARTMENU = &H16
      17. sfidCOMMON_PROGRAMS = &H17
      18. sfidCOMMON_STARTUP = &H18
      19. sfidCOMMON_DESKTOPDIRECTORY = &H19
      20. sfidAPPDATA = &H1A
      21. sfidPRINTHOOD = &H1B
      22. sfidProgramFiles = &H10000
      23. sfidCommonFiles = &H10001
      24. End Enum
      26. Private Type SHITEMID
      27. cb As Long
      28. abID As Byte
      29. End Type
      31. Private Type ITEMIDLIST
      32. mkid As SHITEMID
      33. End Type
      35. Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
      36. Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
      37. Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationname As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
      43. Private Sub Form_Load()
      44. GetIEFavorites (GetSpecialFolder(sfidFAVORITES))
      45. End Sub
      52. 'http://www.shadoware.de/vb/foreachsubpath.html
      53. Private Sub GetIEFavorites(StartFolder As String)
      54. Dim sName As String
      55. Dim Filename As String
      56. Dim FolderName As String
      57. Dim Dirs() As String
      58. Dim DirsNo As Integer
      59. Dim i As Integer
      61. If Right(StartFolder, 1) <> "\" Then StartFolder = StartFolder & "\"
      63. If DirExists(StartFolder) = False Then Exit Sub
      65. sName = Dir(StartFolder & "*.url")
      67. While Len(sName) > 0
      68. Filename = StartFolder & sName
      69. List1.AddItem GetINISetting(Filename, "InternetShortcut", "URL", "Error")
      70. sName = Dir
      71. Wend
      74. 'subfolder
      75. DirsNo = 0
      76. sName = Dir(StartFolder, vbDirectory)
      77. While Len(sName) > 0
      78. If sName <> "." And sName <> ".." Then
      79. DirsNo = DirsNo + 1
      80. ReDim Preserve Dirs(DirsNo) As String
      81. Dirs(DirsNo - 1) = sName
      82. End If
      83. sName = Dir
      84. Wend
      86. For i = 0 To DirsNo - 1
      87. FolderName = StartFolder & Dirs(i) & "\"
      88. GetIEFavorites (FolderName)
      89. Next
      90. End Sub
      92. 'http://www.vbarchiv.net/tipps/tipp_273-standard-system-ordner-ermitteln.html
      93. Public Function GetSpecialFolder(CSIDL As SpecialFolderIDs) As String
      94. Dim lResult As Long
      95. Dim IDL As ITEMIDLIST
      96. Dim sPath As String
      98. lResult = SHGetSpecialFolderLocation(100, CSIDL, IDL)
      99. If lResult = 0 Then
      100. sPath = Space$(512)
      101. lResult = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal sPath)
      102. GetSpecialFolder = Left$(sPath, InStr(sPath, Chr$(0)) - 1)
      103. End If
      104. End Function
      106. 'http://www.activevb.de/rubriken/kolumne/kol_1/fileexists.html
      107. Private Function DirExists(ByVal DirectoryName As String) As Boolean
      108. On Error Resume Next
      109. DirExists = CBool(GetAttr(DirectoryName) And vbDirectory)
      110. On Error GoTo 0
      111. End Function
      113. 'http://www.shadoware.de/vb/ini.html
      114. Function GetINISetting(ByVal Filename As String, ByVal Key As String, ByVal Setting As String, ByVal Default As Variant) As Variant
      115. Dim Temp As String * 1024
      117. Call GetPrivateProfileString(Key, Setting, Default, Temp, Len(Temp), Filename)
      118. GetINISetting = Mid(Temp, 1, InStr(1, Temp, Chr(0)) - 1)
      119. End Function


      Funktioniert mit momentan neuester Version.
      Für ein Mindestmaß an Rechtschreibung, Interpunktion und Majuskeln!