在线情况
楼主
  • 头像
  • 级别
  • 徽章
  • 积分106
  • 经验3588
  • 文章89
  • 注册2004-05-13
求教判断PC与手机浏览器的准确代码
不要拿简单的一句代码来回复我哦,希望看到判断精准的代码。[P]就如leadbbs的判断浏览器的代码一样。[/P][P]
[/P][P]请高手指教,谢谢![/P]
LeadBBS 官方论坛(asp论坛)感谢您的参与
在线情况
2
  • 头像
  • 小笨的爸爸
  • 级别
  • 徽章
  • 职务总版主
  • 声望+59
  • 积分8206
  • 经验586708
  • 文章7592
  • 注册2006-03-24
[CODE]
Function GetSBInfo(Flag)

     Dim Brs,Sys,I,N,Tmp,Str
     Sys = "Unknown"
     Brs = "Unknown"
     Str = Request.ServerVariables("HTTP_USER_AGENT")
     Tmp = LCase(Str)
     'If inStr(Tmp,"http://") > 0 Then
     '      Brs = "Spider"
     '      Sys = "Spider"
     'Else
           I = inStr(Tmp,"msie")
           If I > 0 Then
                 N = inStr(I,Tmp,";")
                 If N > 0 Then
                       Brs = Mid(Str,I,N-i)
                       I = inStr(N+1,Tmp,";")
                       If I > 0 Then
                             Sys = Trim(Mid(Str,N + 1,I-N-1))
                       End If
                 End If
           Else
                 I = inStr(Tmp,"opera")
                 If I > 0 Then
                       N = inStr(i,Tmp," ")
                       If N > 0 Then Brs = Replace(Mid(Str,i,n-i),"/"," ")
                       I = inStr(Tmp,"(")
                       N = inStr(Tmp,";")
                       If N > I and I > 0 Then
                             Sys = Mid(Str,I+1,N-I-1)
                       End If
                 ElseIf inStr(Tmp,"safari") > 0 Then
                       I = inStr(Tmp,"version")
                       If I > 0 Then
                             If inStr(i,Tmp," ")-I-7 > 0 Then Brs = "Safari " & Replace(Mid(Tmp,I + 7,inStr(I,Tmp," ")-I-7),"/","")
                       Else
                             I = inStr(Tmp,"chrome")
                             If I > 0 Then
                                   If inStr(I,Tmp," ") > I Then
                                         Brs = Replace(Mid(Tmp,I,inStr(I,Tmp," ")-I),"/"," ")
                                   End If
                             End If
                       End If
                 ElseIf inStr(Tmp,"wap") > 0 Then
                       Brs = "Wap"
                       Sys = "Wap"
                 Else
                       If inStr(Tmp,";")>0 then
                             Dim T
                             N = split(Str,";")
                             
                             I = inStr(Tmp,"firefox")
                             If I > 0 and Ubound(N) >=2 Then
                                   Sys = Trim(N(2))
                                   Brs = Replace(Mid(Str,I,20),"/"," ")
                             Else
                                   If Ubound(N) >=2 Then
                                         N(2) = Trim(replace(N(2),")",""))
                                         Brs = Replace(N(2),"/"," ")
                                   End If
                                   If Ubound(N) >=1 Then
                                         N(1) = Trim(N(1))
                                         Sys = N(1)
                                   End If
                             End If
                       End If
                 End If
           End If
     'End If
     If Brs = "Unknown" and inStr(Tmp,"http://") > 0 Then Brs = "Spider"
     If Sys <> "" Then
           If inStr(Tmp,"windows nt 5.0") Then
                 Sys = "Windows 2000"
           Elseif inStr(Tmp,"windows nt 5.1") Then
                 Sys = "Windows XP"
           Elseif inStr(Tmp,"windows nt 5.2") Then
                 Sys = "Windows 2003"
           Elseif inStr(Tmp,"windows nt 6.0") Then
                 Sys = "Windows Vista"
           Elseif inStr(Tmp,"windows nt 6.1") Then
                 Sys = "Windows 7"
           Elseif inStr(Tmp,"windows nt 6.2") Then
                 Sys = "Windows 8"
           Elseif inStr(Tmp,"windows vista") Then
                 Sys = "Windows Vista"
           Elseif inStr(Tmp,"windows 4.10") Then
                 Sys = "Windows 98"
           Elseif inStr(Tmp,"windows 98") Then
                 Sys = "Windows 98"
           Elseif inStr(Tmp,"windows me") Then
                 Sys = "Windows Me"
           Elseif inStr(Tmp,"ipad") Then
                 Sys = "iPad"
           Elseif inStr(Tmp,"windows 3.") Then
                 Sys = "Windows 3.1"
           elseif inStr(Tmp,"android") Then      
                 I = inStr(Tmp,"android")      
                 N = inStr(I,Tmp,";")
                 If N > 0 Then
                       Sys = Mid(Str,I,N-i)
                       Sys = Replace(Replace(Sys,"_","."),";","")
                 Else
                 Sys = "Android"
                 End If
           Elseif inStr(Tmp,"iphone") Then
                 Sys = "iPhone"
           elseif inStr(Tmp,"mac os x") Then      
                 I = inStr(Tmp,"mac os")      
                 N = inStr(I,Tmp,";")
                 If N > 0 Then
                       Sys = Mid(Str,I,N-i)
                       Sys = Replace(Replace(Sys,"_","."),";","")
                 Else
                       Sys = "Mac OS"
                 End If
           End If            
     End If
     
     If Flag = 1 Then
           GetSBInfo = Brs
     Else
           GetSBInfo = Sys
     End If

End Function


Function CheckSystem

     If Request.QueryString("homesel") = "1" Then
           CheckSystem = 0
           Response.Cookies(DEF_MasterCookies & "homesel") = "1"
           Response.Cookies(DEF_MasterCookies & "homesel").Expires = DateAdd("d",DEF_Now,30)
           Response.Cookies(DEF_MasterCookies & "homesel").Domain = DEF_AbsolutHome
           Exit Function
     End If
     If Request.Cookies(DEF_MasterCookies & "homesel") = "1" then
           CheckSystem = 0
           Exit Function
     End If
     dim sys
     sys = GetSBInfo(0)
     If sys = "iPad" or sys = "iPhone" or left(sys,7) = "Android" Then
           CheckSystem = 1
     Else
           CheckSystem = 0
     End If

End Function
[/CODE]

[CODE]
If CheckSystem = 1 Then
do sth
end if
[/CODE]

代码整理自LeadBBS源码。。
LeadBBS 官方论坛(asp论坛)感谢您的参与
在线情况
3
  • 头像
  • 『極速論壇巡檢
  • 级别
  • 徽章
  • 积分2159
  • 经验14553
  • 文章1843
  • 注册2004-10-19
[FACE=宋体][SIZE=12px] window.parent.opener.location.href[/SIZE][/FACE]
LeadBBS 官方论坛(asp论坛)感谢您的参与
在线情况
4
  • 头像
  • 级别
  • 徽章
  • 积分120
  • 经验3213
  • 文章82
  • 注册2004-04-08
大神膜拜啊[P]
[/P]
LeadBBS 官方论坛(asp论坛)感谢您的参与
Page created in 0.0234 seconds with 8 queries.