Как получить строку браузера UserAgent в Visual Basic 6?


Я пытаюсь получить UserAgent браузера по умолчанию, используяObtainUserAgentString API вVisual Basic 6 . Я нашел документацию на MSDN и попытался преобразовать ее в Visual Basic 6, но это не сработало.

C++ (MSDN)

HRESULT ObtainUserAgentString(
  _In_  DWORD  dwOption = 0,
  _Out_ LPCSTR *pcszUAOut,
  _Out_ DWORD  *cbSize
);

Visual Basic 6 API

Private Declare Function ObtainUserAgentString Lib "Urlmon.dll" (ByVal dwOption As Long, ByRef pcszUAOut As String, ByRef cbSize As Long) As Long

Private Function BrowserUserAgent() As String
Dim httpUseragent As String
Dim szhttpUserAgent As Long
httpUseragent = Space(512)
szhttpUserAgent = Len(httpUseragent)
Call ObtainUserAgentString(0, httpUseragent, szhttpUserAgent)
BrowserUserAgent = httpUseragent
End Function

Private Sub Command1_Click()
MsgBox BrowserUserAgent
End Sub
2 3

2 ответа:

HRESULT ObtainUserAgentString(
  _In_  DWORD  dwOption = 0,
  _Out_ LPCSTR *pcszUAOut,
  _Out_ DWORD  *cbSize
);

Param 2-это LongPointerCString. Вы всегда передаете строки C ByVal , которые в действительности передают строку C части строки B ByRef. Если бы это было a в param, вы должны были бы закончить строку с Chr (0), который является тем, что реальные строки C имеют.

Строковые аргументы являются частным случаем. Передача строки по значению означает, что вы передаете адрес первого байта данных в строке; передача строки по ссылке означает, что вы передаете адрес памяти, где находится другой адрес. второй адрес фактически ссылается на первый байт данных строки. Как определить, какой подход следует использовать, описано в разделе "передача строк в процедуру DLL" далее в этой главе.

Из Visual Basic Concepts в справке.

Помимо того, что это грубая старая точка входа ANSI, все, что вам нужно, кажется, задокументировано.

Option Explicit

Private Const NOERROR As Long = 0
Private Const E_OUTOFMEMORY As Long = &H8007000E

Private Enum UAS_OPTIONSENUM
    [_UAS_EXACTLEGACY] = &H1000&
    UAS_DEFAULT = 0
    UAS_7 = 7 'Compatible mode.
    UAS_7_LEGACY = 7 Or [_UAS_EXACTLEGACY]
    UAS_8 = 8
    UAS_9 = 9
    UAS_10 = 10
    UAS_11 = 11
End Enum

Private Declare Function ObtainUserAgentString Lib "urlmon" ( _
    ByVal dwOption As Long, _
    ByVal pcszUAOut As Long, _
    ByRef cbSize As Long) As Long

Private Function BrowserUserAgent( _
    Optional ByVal Options As UAS_OPTIONSENUM = UAS_DEFAULT) As String
    Const MAX_BUFFER As Long = 2048
    Dim Size As Long
    Dim Buffer() As Byte
    Dim HRESULT As Long

    Do
        Size = Size + 128
        ReDim Buffer(Size - 1)
        HRESULT = ObtainUserAgentString(Options, VarPtr(Buffer(0)), Size)
    Loop While HRESULT = E_OUTOFMEMORY And Size < MAX_BUFFER
    If HRESULT = NOERROR Then
        BrowserUserAgent = StrConv(LeftB$(Buffer, Size - 1), vbUnicode)
    Else
        Err.Raise &H8004D000, _
                  , _
                  "ObtainUserAgentString error &H" & Hex$(HRESULT)
    End If
End Function

Private Sub Form_Load()
    AutoRedraw = True
    Print BrowserUserAgent()
    Print BrowserUserAgent(UAS_7)
    Print BrowserUserAgent(UAS_7_LEGACY)
    Print BrowserUserAgent(UAS_8)
    Print BrowserUserAgent(UAS_11)
End Sub

Скриншот