0

自 2013 年以来（3 年多），我一直在我的主要 VB.Net 项目中使用http://www.useragentstring.com/从用户代理字符串中获取浏览器名称/版本和操作系统名称/版本以添加统计信息我的本地网络应用程序。

但是，最近，在过去的几个月里，这个网站一直不可靠，有很多停机时间。因此，为了避免在我的统计数据中丢失数据，我搜索了本地解决方案而不是在线解决方案。我发现http://browscap.org/是一个旧网站（自 1998 年以来），至今仍在上传更新的用户代理信息（browscap.ini）。它是为 PHP 设计的，但我在那里找到了一个 C# 实现：https ://www.gocher.me/C-Sharp-Browscap 。

但作为 VB.Net 开发人员，我没有找到任何 VB 实现。我用谷歌搜索了很多，但没有成功。有没有人为 VB.NET 买一个？

4

1 回答 1

0

我终于可以将 C# 解决方案转换为 VB.NET，但有点头疼。

Public Class CompareByLength
Implements IComparer(Of String)
    Private Function Compare(ByVal x As String, ByVal y As String) as Integer _
        Implements IComparer(Of String).Compare
            If x Is Nothing Then
                If y Is Nothing Then
                    Return 0
                Else
                    Return 1
                End If
            Else
                If y Is Nothing Then
                    Return -1
                Else
                    Dim retval As Integer = x.Length.CompareTo(y.Length)
                    If retval <> 0 Then
                        Return -retval
                    Else
                        return -x.CompareTo(y)
                    End If

                End If
            End If
        End Function
End Class

Public Class BrowsCap
    Private Declare Function GetPrivateProfileSectionNames Lib "kernel32.dll" Alias "GetPrivateProfileSectionNamesA" (ByVal lpReturnedString As Byte(), ByVal nSize As Integer, ByVal lpFileName As String) As Integer
    Private Declare Function GetPrivateProfileSection Lib "kernel32.dll" Alias "GetPrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpReturnedBuffer As Byte(), ByVal nSize As Integer, ByVal lpFileName As String) As Integer
    Private Declare Function GetPrivateProfileString Lib "kernel32.dll" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedBuffer As String, ByVal nSize As Integer, ByVal lpFileName As String) As Integer

    Private path As String
    Private sections As String()

    Private Function GetSectionNames() As String()
        Dim maxsize As Integer = 500
        Do
            Dim bytes(maxsize) As Byte
            Dim size As Integer = GetPrivateProfileSectionNames(bytes, maxsize, path)
            If size < maxsize - 2 Then
                Dim Selected As String = Encoding.ASCII.GetString(bytes, 0, size - (IIf(size > 0, 1, 0)))
                Return Selected.Split(New Char() {ControlChars.NullChar})
            End If
            maxsize = maxsize * 2
        Loop
    End Function

    Public Sub IniFileName(ByVal INIPath As String)
        path = INIPath
        sections = GetSectionNames()
        Array.Sort(sections, New CompareByLength())
    End Sub

    public Function IniReadValue(ByVal Section As String, ByVal Key As String) As String
      Dim temp As New StringBuilder(255)
      Dim i As Integer = GetPrivateProfileString(Section, Key, "", temp.ToString(), 255, path)
      Return temp.ToString()
    End Function

    Private Function findMatch(ByVal Agent As String) As String
      If sections IsNot Nothing Then
        For Each SecHead As String In sections
          If (SecHead.IndexOf("*", 0) = -1) And (SecHead.IndexOf("?", 0) = -1) And (SecHead = Agent) Then
            If IniReadValue(SecHead, "parent") <> "DefaultProperties" Then
              Return SecHead
            End If
          End If
        Next
        For Each SecHead As String In sections
          Try
            If (SecHead.IndexOf("*", 0) > -1) Or (SecHead.IndexOf("?", 0) > -1) Then
              if Regex.IsMatch(Agent, "^" + Regex.Escape(SecHead).Replace("\*", ".*").Replace("\?", ".") + "$") Then
                Return SecHead
              End If
            End If
          Catch ex As Exception
            'Console.WriteLine(ex)
          End Try
        Next
        Return "*"
      End If
      Return ""
    End Function

    Public Function getValues(ByVal Agent As String) As NameValueCollection 
      Dim match As String = findMatch(Agent)
      Dim col As NameValueCollection = New NameValueCollection()
      Do
        Dim entries() As string
        Dim goon As Boolean = true
        Dim maxsize As Integer = 500
        While goon
          Dim bytes(maxsize) As Byte
          Dim size As Integer = GetPrivateProfileSection(match, bytes, maxsize, path)
          If size < maxsize - 2
            Dim section As String = Encoding.ASCII.GetString(bytes, 0, size - IIf(size > 0, 1, 0))
            entries = section.Split(New Char() {ControlChars.NullChar})
            goon = False
          End If
          maxsize = maxsize * 2
        End While
        match = ""
        If entries.Length > 0 Then
          For Each entry As String In entries
            Dim ent As String() = entry.Split(New Char() {"="C})
            If ent(0) = "Parent" Then
              match = ent(1)
            else if col(ent(0)) is nothing Then
              col.Add(ent(0), ent(1))
            End If
          Next
        End If
      Loop While match <> ""
      Return col
    End Function
End Class

以下是如何使用它：

Dim dict As Dictionary(Of String, Object) = New Dictionary(Of String, Object)
Dim bc As New BrowsCap
bc.IniFileName(Server.MapPath("/App_Data/lite_asp_browscap.ini"))
Dim Entry As NameValueCollection = bc.getValues(Request.UserAgent)
For Each s As String In Entry.AllKeys
    dict.Add(s, Entry(s))
Next
' dict("Browser") will contains browser name like "IE" or "Chrome".
' dict("Version") will contains browser version like "11.0" or "56.0".
' dict("Platform") will contains OS name and version like "Win7".

剩下要做的就是有时（比如每周一次）刷新我的browscap.ini（或lite_asp_browscap.ini）。

于 2017-02-20T15:55:09.153 回答