visual-studio - 如何在 Visual Basic 6 中获取浏览器 UserAgent 字符串？

Question

我正在尝试使用 Visual Basic 6 中的 ObtainUserAgentString API 获取默认浏览器的 UserAgent。我在 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

Answer 1

除了这是一个破旧的 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