|
Tmpstr(3)="1" Then
IsSearch = True
End If
Exit Sub
End If
Browser="unknown"
version="unknown"
platform="unknown"
Agent=Request.ServerVariables("HTTP_USER_AGENT")
''''Agent="Opera/7.23 (X11; Linux i686; U) [en]"
If Left(Agent,7) ="Mozilla" Then ''''有此标识为浏览器
Agent=Split(Agent,";")
If InStr(Agent(1),"MSIE")>0 Then
Browser="Microsoft Internet Explorer "
version=Trim(Left(Replace(Agent(1),"MSIE",""),6))
ElseIf InStr(Agent(4),"Netscape")>0 Then
Browser="Netscape "
tmpstr=Split(Agent(4),"/")
version=tmpstr(UBound(tmpstr))
ElseIf InStr(Agent(4),"rv:")>0 Then
Browser="Mozilla "
tmpstr=Split(Agent(4),":")
version=tmpstr(UBound(tmpstr))
If InStr(version,")") > 0 Then
tmpstr=Split(version,")")
version=tmpstr(0)
End If
End If
If UBound(Agent)>2 Then
platform = UserPlatForm(Agent(2),Agent(3),UBound(Agent))
Else
platform = UserPlatForm(Agent(2),"",UBound(Agent))
End If
ElseIf Left(Agent,5) ="Opera" Then
Agent=Split(Agent,"/")
Browser="Mozilla "
tmpstr=Split(Agent(1)," ")
version=tmpstr(0)
If UBound(Agent)>2 Then
platform = UserPlatForm(Agent(1),Agent(3),UBound(Agent))
Else
platform = UserPlatForm(Agent(1),"",UBound(Agent))
End If
Else
''''识别搜索引擎
Dim botlist
Botlist="Google,Isaac,SurveyBot,Baiduspider,ia_archiver,P.Arthur,FAST-WebCrawler,Java,Microsoft-ATL-Native,TurnitinBot,WebGather,Sleipnir"
Botlist=split(Botlist,",")
For i=0 to UBound(Botlist)
If InStr(Agent,Botlist(i))>0 Then
platform=Botlist(i)&"搜索器"
IsSearch=True
Exit For
End If
Next
End If
If version<>"unknown" Then
Dim Tmpstr1
Tmpstr1=Trim(Replace(version,".",""))
If Not IsNumeric(Tmpstr1) Then
version="unknown"
End If
End If
If IsSearch Then
Browser=""
version=""
Session(Dvbbs.CacheName & "Cls_Browser") = Browser &"|||"& version &"|||"& platform&"|||1"
Else
Session(Dvbbs.CacheName & "Cls_Browser") = Browser &"|||"& version &"|||"& platform&"|||0"
End If
End Sub
Private Function UserPlatForm(UserAgent1,UserAgent2,UserAgentNum)
If InStr(UserAgent1,"NT 5.2")>0 Then
UserPlatForm="Windows 2003"
ElseIf InStr(UserAgent1,"Windows CE")>0 Then
UserPlatForm="Windows CE"
ElseIf InStr(UserAgent1,"NT 5.1")>0 Then
UserPlatForm="Windows XP"
ElseIf InStr(UserAgent1,"NT 4.0")>0 Then
UserPlatForm="Windows NT"
ElseIf InStr(UserAgent1,"NT 5.0")>0 Then
UserPlatForm="Windows 2000"
ElseIf InStr(UserAgent1,"NT")>0 Then
UserPlatForm="Windows NT"
ElseIf InStr(UserAgent1,"9x")>0 Then
UserPlatForm="Windows ME"
ElseIf InStr(UserAgent1,"98")>0 Then
UserPlatForm="Windows 98"
ElseIf InStr(UserAgent1,"95")>0 Then
UserPlatForm="Windows 95"
ElseIf InStr(UserAgent1,"Win32")>0 Then
UserPlatForm="Win32"
ElseIf InStr(UserAgent1,"Linux")>0 Then
UserPlatForm="Linux"
ElseIf InStr(UserAgent1,"SunOS")>0 Then
UserPlatForm="SunOS"
ElseIf InStr(UserAgent1,"Mac")>0 Then
UserPlatForm="Mac"
ElseIf UserAgentNum>2 Then
If InStr(UserAgent2,"NT 5.1")>0 Then UserPlatForm="Windows XP"
If InStr(UserAgent2,"Linux")>0 Then UserPlatForm="Linux"
End If
End Function ''''---------------------------------------------------
''''记录道具操作日志信息(发生数量，记录事件类型，备注内容，用户最后剩余金币和点券（金币|点券）)
''''Log_ID,ToolsID,CountNum,Log_Money,Log_Ticket,AddUserName,AddUserID,Log_IP,Log_Time,Log_Type,BoardID,Conect,HMoney
''''Log_Type类型(0=其它,1=使用,2=转让,3=充值,4=购买,5=奖励,6=vip交易)
''''HMoney最后剩余金币和点券（金币|点券）
''''boardid 记录版面参数，后台为-1
''''---------------------------------------------------
Public Sub ToolsLog(Log_ToolsID,CountNum,Log_Money,Log_Ticket,Log_Type,Conect,HMoney)
Dim Sql
Conect = CheckStr(Conect)
HMoney = CheckStr(HMoney)
Sql = "Insert into [Dv_MoneyLog] (ToolsID,CountNum,Log_Money,Log_Ticket,AddUserName,AddUserID,Log_IP,Log_Type,BoardID,Conect,HMoney) values (" &_
CheckNumeric(Log_ToolsID) &","&_
CheckNumeric(CountNum) &","&_
CheckNumeric(Log_Money) &","&_
CheckNumeric(Log_Ticket) &",''''"&_
MemberName &"'''',"&_
UserID &",''''"&_
UserTrueIP &"'''',"&_
Log_Type &","&_
BoardID &",''''"&_
Conect &"'''',''''"&_
HMoney &"''''"&_
")"
''''Response.Write Sql
Dvbbs.Execute(Sql)
End Sub
End Class
Class cls_Templates
Public html,Strings,pic
Public Property Let Value(ByVal vNewValue)
Dim TemplateStr,tmpstr:TemplateStr = vNewValue
TemplateStr = Replace(TemplateStr,"{$PicUrl}",Dvbbs.Forum_PicUrl)
tmpstr = Split(TemplateStr,"@@@")
html = Split(tmpstr(0),"|||"):Strings = Split(tmpstr(1),"|||"):pic = Split(tmpstr(2),"|||")
End Property
End Class
Class cls_UserOnlne
Public Forum_Online,Forum_UserOnline,Forum_GuestOnline
Private l_Online,l_GuestOnline
Private Sub Class_Initialize()
Dvbbs.Name="Forum_Online"
Dvbbs.Reloadtime=60
If Dvbbs.ObjIsEmpty() Then ReflashOnlineNum
Dvbbs.Name="Forum_Online"
Forum_Online = Dvbbs.Value
Dvbbs.Name="Forum_UserOnline"
If Dvbbs.ObjIsEmpty() Then ReflashOnlineNum
Forum_UserOnline=Dvbbs.Value
If Forum_Online < 0 Or Forum_UserOnline < 0 Or Forum_UserOnline > Forum_Online Then ReflashOnlineNum
Forum_GuestOnline = Forum_Online - Forum_UserOnline
l_Online=-1:l_GuestOnline=-1
Dvbbs.Reloadtime=28800
End Sub
Public Sub OnlineQuery()
Dim SQL,SQL1
Dim TempNum,TempNum1
Dvbbs.Name="delOnline_time"
If Dvbbs.ObjIsEmpty() Then Dvbbs.Value=Now()
If DateDiff("s",Dvbbs.Value,Now()) > Clng(Dvbbs.Forum_Setting(8))*10 Then
Dvbbs.Value=Now()
If Not IsObject(Conn) Then ConnectionDatabase
If IsSqlDataBase = 1 Then
SQL = "Delete From [DV_Online] Where UserID=0 And Datediff(Mi, Lastimebk, " & SqlNowString & ") > " & Clng(Dvbbs.Forum_Setting(8))
SQL1 = "Delete From [DV_Online] Where UserID>0 And Datediff(Mi, Lastimebk, " & SqlNowString & ") > " & Clng(Dvbbs.Forum_Setting(8))
& 上一页 [1] [2] [3] [4] [5] [6] [7] [8] [9] [10] ... 下一页 >>
[Web开发]指定资源下载失败msxml3.dll 错误 800c0008的解决… [Web开发]"ActiveX部件不能创建对象"错误如何解决？
[办公软件]Office程序常见错误及解决方案 [办公软件]Excel如何避免出现错误信息的提示
[办公软件]Excel常见错误信息以及解决方法 [Sql Server]Win2003中安装Sql2000出现日志错误的解决办法
[Web开发]asp.net自定义错误处理及错误显示页！ [Web开发]分析器错误信息:无法识别的配置节“connectionStr…
[Web开发](“/”应用程序中的服务器错误)ASP.NET程序上传到… [Web开发]authentication mode=Windows/之“/”应用程序中的…
|
注：本站部分文章源于互联网，版权归原作者所有！如有侵权，请原作者与本站联系，本站将立即删除！ 本站文章除特别注明外均可转载，但需注明出处！ [MinTao学以致用网] 
