使用 browscap.ini 和 VB.Net
Using browscap.ini with VB.Net
自 2013 年至今(3 年多),我一直在我的主要 VB.Net 项目中使用 http://www.useragentstring.com/ 来获取浏览器 name/version 和 OS name/version 从用户代理字符串向我的本地 Web 应用程序添加统计信息。
但是,最近,在过去的几个月里,这个网站一直不可靠,有很多停机时间。因此,为了避免在我的统计数据中丢失数据,我搜索了本地解决方案而不是在线解决方案。我找到 http://browscap.org/ is an old web site (since 1998) that still upload updated user agent information to this day (browscap.ini). It is designed for PHP, but I found a C# implementation there: https://www.gocher.me/C-Sharp-Browscap .
但作为 VB.Net 开发人员,我没有找到任何 VB 实现。我用谷歌搜索了很多但没有成功。 VB.NET 有人得到一个吗?
我终于开始将 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)(比如每周一次)。
自 2013 年至今(3 年多),我一直在我的主要 VB.Net 项目中使用 http://www.useragentstring.com/ 来获取浏览器 name/version 和 OS name/version 从用户代理字符串向我的本地 Web 应用程序添加统计信息。
但是,最近,在过去的几个月里,这个网站一直不可靠,有很多停机时间。因此,为了避免在我的统计数据中丢失数据,我搜索了本地解决方案而不是在线解决方案。我找到 http://browscap.org/ is an old web site (since 1998) that still upload updated user agent information to this day (browscap.ini). It is designed for PHP, but I found a C# implementation there: https://www.gocher.me/C-Sharp-Browscap .
但作为 VB.Net 开发人员,我没有找到任何 VB 实现。我用谷歌搜索了很多但没有成功。 VB.NET 有人得到一个吗?
我终于开始将 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)(比如每周一次)。