VB 读取收藏夹里的URL地址

Public Const MAX_PATH As Long = 260
Public Const ERROR_SUCCESS As Long = 0
Public Const S_OK As Long = 0
Public Const S_FALSE As Long = 1
Public Const SHGFP_TYPE_CURRENT As Long = &H0
Public Const SHGFP_TYPE_DEFAULT As Long = &H1
Public Const CSIDL_FAVORITES As Long = &H6

Public Declare Function SHGetFolderPath Lib "shfolder" Alias "SHGetFolderPathA" (ByVal hwndOwner As Long, ByVal nFolder As Long, ByVal hToken As Long, ByVal dwReserved As Long, ByVal lpszPath As String) As Long

Public Function GetFolderPath(CSIDL As Long) As String
Dim sPath As String
Dim sTmp As String
sPath = Space$(MAX_PATH)
'下面的0为窗口句柄，如果为单窗口程序，最好指定为mainform.hwnd
If SHGetFolderPath(0, CSIDL, 0&, SHGFP_TYPE_CURRENT, sPath) = S_OK Then
    GetFolderPath = Left$(sPath, InStr(sPath, Chr$(0)) - 1)
End If
End Function
'获取收藏夹下url文件的URL地址
Public Function ProfileGetItem(lpSectionName As String, lpKeyName As String, defaultValue As String, inifile As String) As String

'Retrieves a value from an ini file corresponding
'to the section and key name passed.
       
   Dim success As Long
   Dim nSize As Long
   Dim ret As String
 
  'call the API with the parameters passed.
  'The return value is the length of the string
  'in ret, including the terminating null. If a
  'default value was passed, and the section or
  'key name are not in the file, that value is
  'returned. If no default value was passed (""),
  'then success will = 0 if not found.

  'Pad a string large enough to hold the data.
   ret = Space$(2048)
   nSize = Len(ret)
   success = GetPrivateProfileString(lpSectionName, lpKeyName, _
                                     defaultValue, ret, nSize, inifile)
  
   If success Then
      ProfileGetItem = Left$(ret, success)
   End If
  
End Function

使用方法

Dim lpszRootFolder As String
Dim sURL As String
lpszRootFolder = GetFolderPath(CSIDL_FAVORITES)
sURL = ProfileGetItem("InternetShortcut", "URL", "", lpszRootFolder & "" & "filename.url")