Получение цели ярлыков URL (какой код быстрее?) - VB

Формулировка задачи:

Приветствую! Воспользовался интерфейсом IUniformResourceLocatorW. Задача - получить цель нескольких ярлыков URL и в идеале, чтобы не уничтожать объект InternetShortcut для возможности повторно использовать этот экземпляр класса, работая со всеми файлами *.URL. Но при попытке дважды вызвать метод Load интерфейса IPersistFile получаю ошибку "Automation error. Unspecified Error 80004005". В примерах MSDN для освобождения ресурсов использовался метод Release, но в интерфейсе IPersistFile я такого не нашел (да и в описании нет) и не факт, что это решит проблему (подключал Edanmo OLE libs). Написал 2 рабочих примера: 1) через создание экземпляра класса InternetShortcut
Option Explicit
 
Private Declare Function CLSIDFromString Lib "ole32" (ByVal lpszGuid As Long, pGuid As UUID) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenW" (ByVal lpString As Long) As Long
Private Declare Function lstrcpyn Lib "kernel32" Alias "lstrcpynW" (ByVal lpString1 As Long, ByVal lpString2 As Long, ByVal iMaxLength As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
 
Dim IID_IURLW As UUID
 
Private Sub Form_Load()
    
    IURL_Init
    
    Debug.Print GetUrlTargetW("c:\1\HDTunePro.url")
    Debug.Print GetUrlTargetW("c:\1\010Editor.url")
    
    Unload Me
End Sub
 
Sub IURL_Init()
    Const IIDSTR_IURLW = "{CABB0DA0-DA57-11CF-9974-0020AFD79762}"
    ' Заполняем структуру UUID
    CLSIDFromString StrPtr(IIDSTR_IURLW), IID_IURLW
End Sub
 
' Получить цель из ярлыка URL
Public Function GetUrlTargetW(URLpathW As String) As String
    Dim IURL      As IUniformResourceLocatorW
    Dim IPF_URL   As IPersistFile
    Dim oIS       As InternetShortcut   'IURL CoClass
    Dim strLen    As Long
    Dim ptr       As Long
    Dim URLtarget As String
    
    Set oIS = New InternetShortcut
    ' Получаем указатель на интерфейс IUniformResourceLocatorW
    oIS.QueryInterface IID_IURLW, IURL
    ' Работаем с объектом URL через интерфейс IPersistFile
    Set IPF_URL = IURL
    ' Загружаем ярлык URL
    IPF_URL.Load URLpathW, STGM_READ
    ' Получаем указатель на строку с URL
    ptr = IURL.GetUrl
    strLen = lstrlen(ptr)
    URLtarget = Space(strLen)
    lstrcpyn StrPtr(URLtarget), ptr, strLen + 1
    ' Освобождаем указатель
    GlobalFree ptr
    Set IPF_URL = Nothing
    IURL.Release
    Set IURL = Nothing
    Set oIS = Nothing
    
    GetUrlTargetW = URLtarget
End Function
2) через CoCreateInstance
Option Explicit
 
Private Declare Function CLSIDFromString Lib "ole32" (ByVal lpszGuid As Long, pGuid As UUID) As Long
Private Declare Function CoCreateInstance Lib "ole32" (rclsid As Any, ByVal pUnkOuter As Long, ByVal dwClsContext As Long, riid As Any, pvarResult As Object) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenW" (ByVal lpString As Long) As Long
Private Declare Function lstrcpyn Lib "kernel32" Alias "lstrcpynW" (ByVal lpString1 As Long, ByVal lpString2 As Long, ByVal iMaxLength As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
 
Dim IID_IURLW               As UUID
Dim CLSID_InternetShortcut  As UUID
 
Private Sub Form_Load()
    
    IURL_Init
    
    Debug.Print GetUrlTargetW("c:\1\HDTunePro.url")
    Debug.Print GetUrlTargetW("c:\1\010Editor.url")
        
    Unload Me
End Sub
 
Sub IURL_Init()
    Const CLSIDSTR_InternetShortcut As String = "{FBF23B40-E3F0-101B-8488-00AA003E56F8}"
    Const IIDSTR_IURLW              As String = "{CABB0DA0-DA57-11CF-9974-0020AFD79762}"
  
    CLSIDFromString StrPtr(IIDSTR_IURLW), IID_IURLW
    CLSIDFromString StrPtr(CLSIDSTR_InternetShortcut), CLSID_InternetShortcut
End Sub
 
' Получить цель из ярлыка URL
Public Function GetUrlTargetW(URLpathW As String) As String
    Dim IURL        As IUniformResourceLocatorW
    Dim IPF_URL     As IPersistFile
    Dim strLen      As Long
    Dim ptr         As Long
    Dim URLtarget   As String
    
    CoCreateInstance CLSID_InternetShortcut, 0&, CLSCTX_INPROC_SERVER, IID_IURLW, IURL
    Set IPF_URL = IURL
    
    ' Загружаем ярлык URL
    IPF_URL.Load URLpathW, STGM_READ
    ' Получаем указатель на строку с URL
    ptr = IURL.GetUrl
    strLen = lstrlen(ptr)
    URLtarget = Space(strLen)
    lstrcpyn StrPtr(URLtarget), ptr, strLen + 1
    ' Освобождаем ресурсы
    GlobalFree ptr
    Set IPF_URL = Nothing
    IURL.Release
    Set IURL = Nothing
    
    GetUrlTargetW = URLtarget
End Function
Наверное, по принципу работы и скорости не будут отличаться. Можете посоветовать, как добиться максимальной скорости пакетной обработки?

Код к задаче: «Получение цели ярлыков URL (какой код быстрее?) - VB»

textual
Set IURL = oIS

7   голосов, оценка 4.857 из 5


СОХРАНИТЬ ССЫЛКУ