Relaxlife.net最强计数器-利用操作INI文件来控制流量，也可用做系统设置

Relaxlife.net最强计数器-利用操作INI文件来控制流量，也可用做系统设置

最强计数器-利用操作INI文件来控制流量，也可用做系统设置

Function.asp
<%
Rem =================================================================
Rem = 函数文件:Function.asp
Rem = 测试文件:IniProFile.asp
Rem = 说明:setProfile写入INI文件函数，GetProfile读INI文件函数
Rem = Revision:1.01 Beta
Rem = 作者:熊氏英雄（cexo255）
Rem = Date:2005/04/22 02:00:00
Rem = QQ:30133499
Rem = MySite: Http://www.Relaxlife.net
Rem = 测试地址: http://www.relaxlife.net/2005/relaxlife/blogview.asp?logID=157
Rem = 下载地址: http://www.relaxlife.net/2005/relaxlife/blogview.asp?logID=157
Rem = QQ群：4341998
Rem = 适用:和Delphi操作INI文件一样简单，最好是用在统计访问量，读写速度非常的快。
Rem = 下版本预计改进:不能删除数据项和修改数据项，对数据的操作很全。
Rem =================================================================


Function ReadFile(FileName)
        Dim fso, f
        Const ForReading = 1, ForWriting = 2, ForAppending = 8
        Set fso = CreateObject("Scripting.FileSystemObject")
        Set f = fso.OpenTextFile(Server.MapPath(FileName), ForReading, True)
        On Error Resume Next
        ReadFile =  f.ReadAll
        If Err Then
                err.Clear:                f.Close:                :ReadFile = ""                :Exit Function
        End if
        f.Close
End Function

Sub WriteFile(FileName,Str)
        Dim fso, f
        Const ForReading = 1, ForWriting = 2, ForAppending = 8
        Set fso = CreateObject("Scripting.FileSystemObject")
        Set f = fso.OpenTextFile(Server.MapPath(FileName), ForWriting, True)
        f.Write Str
        f.Close
End Sub
'返回值1 为操作成功
Function setProfile(strFileName, strSection, strName, strSave)
        Dim strTemp, strfileback, strreturn,EditFlag,Flag:Flag = True
        strfileback = "me.tmp"
       
        strTemp = ReadFile(strFileName)
        If InStr(1,strTemp,"["&Trim(strSection)&"]")=0 Then
                If strTemp<>"" Then
                        WriteFile strFileName,strTemp & vbCrlf & "[" & Trim(strSection) & "]" & vbCrlf & Trim(strName) & "=" & strSave & vbCrlf
                Else
                        WriteFile strFileName,strTemp & "[" & Trim(strSection) & "]" & vbCrlf & Trim(strName) & "=" & strSave & vbCrlf
                End if
                setProfile = 1
                Exit Function
        End if
       
        Const ForReading = 1, ForWriting = 2, ForAppending = 8
        Dim fso, f1, f2
        Set fso = CreateObject("Scripting.FileSystemObject")
        Set f1 = fso.OpenTextFile(Server.MapPath(strFileName), ForReading, True)
        Set f2 = fso.OpenTextFile(Server.MapPath(strfileback), ForWriting, True)
       
        On Error Resume Next
        Do While  Flag
                EditFlag = 0
                strTemp = f1.ReadLine
                If Err Then
                        err.Clear
                        Exit Do
                End if
                strreturn = strTemp
                f2.Write strreturn+vbCrlf
                If InStr(1, Trim(strTemp), "[") <> 0 Then
                        If Trim(strTemp) = "["&Trim(strSection)&"]" Then
                                EditFlag = 1
                                Dim Flag1:Flag1=True
                                Do While Flag1
                                        strTemp = f1.ReadLine
                                        If Err Then
                                                err.Clear
                                                Exit Do
                                        End if
                                        If InStr(1, Trim(strTemp), Trim(strName)) <> 0 Then Exit Do  '找到所要修改的字段值
                                        strreturn = strTemp
                                        f2.Write strreturn+vbCrlf
                                Loop
                                If EditFlag = 1 Then       
                                        strreturn = strName & "=" & strSave
                                        f2.Write strreturn+vbCrlf
                                End if
                        Else
                                EditFlag = 2
                        End If
                End If
        Loop
        f1.Close
        f2.Close
       
        WriteFile strFileName,ReadFile(strfileback)

        fso.DeleteFile(Server.MapPath(strfileback))
        Set fso = Nothing
       
        setProfile = 1
End Function
'返回值Empty 为操作失败
Function GetProfile(strFileName, strSection, strName)
        Dim strTemp,strcharA, strcharB,Flag:Flag=True
        Dim fso, f1
        strTemp = ReadFile(strFileName)
        If InStr(1,strTemp,"["&Trim(strSection)&"]")=0 Then
                GetProfile = Empty
                Exit Function
        End if
        Const ForReading = 1, ForWriting = 2, ForAppending = 8
        strSectionTemp = "":        strNameTemp = "":        strreturn = ""
        Set fso = CreateObject("Scripting.FileSystemObject")
        On Error Resume Next
       
        If Err Then
                err.Clear:                GetProfile = "":                f1.Close:                Exit Function
        End if
       
        Set f1 = fso.OpenTextFile(Server.MapPath(strFileName), ForReading, True)
        Do While Flag
                strcharA = f1.Read(1)
                If strcharA = "[" Then
                        Do While True
                                strcharB = f1.Read(1)
                                If strcharB = "]" Then Exit Do
                                strSectionTemp = strSectionTemp & strcharB
                        Loop
                End If
                If strSectionTemp = strSection Then
                        strcharA = f1.Read(2)
                        FindFlag = 1
                        Exit Do
                Else
                        FindFlag = 2
                        strSectionTemp = ""
                End If
        Loop
       
        If Err Then
                err.Clear:                GetProfile = "":                f1.Close:                Exit Function
        End if
       
        Flag = True
        Do While Flag
                strNameTemp = ""
                Do While True
                        strcharA = f1.Read(1)
                        If strcharA <> "=" Then
                                strNameTemp = strNameTemp & strcharA  '得到名称
                        Else
                                Exit Do
                        End If
                Loop
                If strNameTemp = strName Then
                        strreturn = f1.ReadLine  '如果找到与它匹配的字段名，就返回得到的值
                        GetProfile = strreturn
                        Exit Function
                Else
                        strreturn = f1.ReadLine  '如果未找到与它匹配的字段名，就继续找
                        If Err Then
                                err.Clear:                GetProfile =Empty :                f1.Close:                Exit Function
                        End if
                End If
        Loop
        f1.Close
        GetProfile = strreturn
        Exit Function
End Function
%>

&&&&&&&&&&&&&&& &&&&&&&&&&&&&&& &&用做计数器％％％％％％％％％％％％％％％％％
'Count.ini
'[访问量]
'开始年=2005
'开始月=2
'密码=49ba59abbe56e057
'URL=http://www.relaxlife.net
'Name=放松生活网
'今天日期=2005年5月5日
'总访问量=8000
'2005年访问量=60
'2005年2月访问量=1000
'2005年3月访问量=1800
'2005年4月访问量=3000
'2005年5月访问量=3140
'今天的访问量=300
'昨天的访问量=315
'前天的访问量=380

-----------------------显示访问量------------------------
DispNum.asp
<link href="Css/styles.css" rel="stylesheet" type="text/css">
<!--#include file="Function.asp" -->
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<title>由“放松生活网----访问量计数器”支持</title>
<meta name="DESCRIPTION" content="放松生活网----访问量计数器,Relaxlife.net,Relaxlife,放松生活网,放松生活">
<meta name="keywords" content="放松生活网----访问量计数器,Relaxlife.net,Relaxlife,放松生活网,放松生活">
<meta name="author" content="RelaxLife">
<meta name="robots" content="all">
<link href="styles.css" rel="stylesheet" type="text/css">
<%
Dim UserName
UserName = Request.QueryString("User")
myini = "/Count/Ini/" & UserName & ".ini"

Dim FSO
Set FSO = Server.CreateObject("Scripting.FileSystemObject")
IF FSO.FileExists(Server.Mappath(myini)) then
        '总
        Response.Write "<br><font color=red><b>总访问量：" & GetProfile(myini, "访问量", "总访问量") & "</b></font> <br><br>"
        '年
        StartYear = GetProfile(myini, "访问量", "开始年")
        For i = StartYear to Year(Date())
                Response.Write i & "年访问量：" & GetProfile(myini, "访问量", i & "年访问量") & "<br>"
        Next
        Response.Write "<br>"
        '月
        StartMonth = GetProfile(myini, "访问量", "开始月")
        For i = StartYear to Year(Date())
                For j = 1 to 12
                        If  GetProfile(myini, "访问量", i & "年" & j & "月" & "访问量")  <> Empty Then
                                Response.Write i & "年" & j & "月" & "访问量：" & GetProfile(myini, "访问量", i & "年" & j & "月" & "访问量") & "<br>"
                        End if
                Next
        Next
        Response.Write "<br>"
       
        Response.Write "<font color=red><b>今天的访问量(" & Date() & ")：" & GetProfile(myini, "访问量", "今天的访问量")  & "</font><br>"
        Response.Write "昨天的访问量：" & GetProfile(myini, "访问量", "昨天的访问量")  & "<br>"
        Response.Write "前天的访问量：" & GetProfile(myini, "访问量", "前天的访问量")  & "</b><br><br>"
        Response.Write "<a href=manage.asp>管理个人计数器</a>"
       
Else
        Response.Write("错误的参数或参数个数！！！")
End if
Set FSO=Nothing


%>
--------------------累加器-------------------
UpNum.asp
<link href="Css/styles.css" rel="stylesheet" type="text/css">
<!--#include file="Function.asp" -->
<%
Dim UserName
UserName = Request.QueryString("User")
myini = "/Count/Ini/" & UserName & ".ini"

Dim GuestCli_IP
GuestCli_IP=Request.ServerVariables("REMOTE_ADDR")
IF Session("Guest_IP")=Empty Then
        Dim FSO
        Set FSO = Server.CreateObject("Scripting.FileSystemObject")
        IF FSO.FileExists(Server.Mappath(myini)) then
       
                TotalNum =         GetProfile(myini, "访问量", "总访问量") + 1
                setProfile myini, "访问量", "总访问量", TotalNum
               
                StartYearNum =         GetProfile(myini, "访问量", "开始年")
       
                YearNum =         GetProfile(myini, "访问量", Year(Date()) & "年访问量")
                If YearNum = Empty Then
                        setProfile myini, "访问量",  Year(Date()) & "年访问量", 1
                Else
                        setProfile myini, "访问量",  Year(Date()) & "年访问量", YearNum + 1
                End if
               
                MonthStr = Year(Date()) & "年" & Month(Date()) & "月" & "访问量"
                MonthNum =         GetProfile(myini, "访问量", MonthStr)
                If MonthNum = Empty Then
                        setProfile myini, "访问量", MonthStr, 1
                Else
                        setProfile myini, "访问量", MonthStr, MonthNum + 1
                End if
       
                NowDay = GetProfile(myini, "访问量", "今天日期")
                NDayNum =         GetProfile(myini, "访问量", "今天的访问量")
                DayDate = Year(Date()) & "年" & Month(Date()) & "月" & Day(Date()) & "日"
                If NowDay = DayDate Then
                        setProfile myini, "访问量", "今天的访问量", NDayNum + 1
                Else
                        setProfile myini, "访问量", "前天的访问量",  GetProfile(myini, "访问量", "昨天的访问量")
                        setProfile myini, "访问量", "昨天的访问量",  GetProfile(myini, "访问量", "今天的访问量")
                        setProfile myini, "访问量", "今天的访问量", 1
                        setProfile myini, "访问量", "今天日期", DayDate
                End if
       
                Session("Guest_IP")=GuestCli_IP
        Else
                Response.Write("错误的参数或参数个数！！！")
        End if
        Set FSO=Nothing
End IF
%>

&&&&&&&&&&&&&&& &&&&&&&&&&&&&&& &&用做系统设置％％％％％％％％％％％％％％％％％
iniProFile.asp
<%
Rem =================================================================
Rem = 函数文件:Function.asp
Rem = 测试文件:IniProFile.asp
Rem = 说明:setProfile写入INI文件函数，GetProfile读INI文件函数
Rem = Revision:1.01 Beta
Rem = 作者:熊氏英雄（cexo255）
Rem = Date:2005/04/22 02:00:00
Rem = QQ:30133499
Rem = MySite: Http://www.Relaxlife.net
Rem = 测试地址: http://www.relaxlife.net/2005/relaxlife/blogview.asp?logID=157
Rem = 下载地址: http://www.relaxlife.net/2005/relaxlife/blogview.asp?logID=157
Rem = QQ群：4341998
Rem = 适用:和Delphi操作INI文件一样简单，最好是用在统计访问量，读写速度非常的快。
Rem = 下版本预计改进:不能删除数据项和修改数据项，对数据的操作很全。
Rem =================================================================
%>


<!--#include file="Function.asp" -->
<%
myini = "me.ini"
'实例1：操作ini文件中存在的数据项
'先定义ini文件中的数据项如下：
'[database]
'mbackcolor=-2147483643
'mforecolor=-2147483640
'mfontsize=14
'mfontname=宋体
'mheight=6450
'mleft=2310
'mtop=3195
'mwidth=10425
'ini 文件中写入数据
setProfile myini, "database", "mbackcolor", "-2147483643"
setProfile myini, "database", "mforecolor", "-2147483640"
setProfile myini, "database", "mfontsize", 14
setProfile myini, "database", "mfontname", "宋体"
setProfile myini, "database", "mheight", 6450
setProfile myini, "database", "mleft", 2310
setProfile myini, "database", "mtop", 3195
setProfile myini, "database", "mwidth", 10425

'ini 文件中读出数据并显示
mbackcolor =         GetProfile(myini, "database", "mbackcolor")
mforecolor =         GetProfile(myini, "database", "mforecolor")
mfontsize =         GetProfile(myini, "database", "mfontsize")
mfontname =         GetProfile(myini, "database", "mfontname")
mheight =                 GetProfile(myini, "database", "mheight")
mtop =                         GetProfile(myini, "database", "mtop")
mleft =                 GetProfile(myini, "database", "mleft")
mwidth =                GetProfile(myini, "database", "mwidth")
Response.Write mbackcolor & "<br>"
Response.Write mforecolor & "<br>"
Response.Write mfontsize& "<br>"
Response.Write mfontname & "<br>"
Response.Write mheight & "<br>"
Response.Write mtop & "<br>"
Response.Write mleft & "<br>"
Response.Write mwidth & "<br>"

'实例2：操作ini文件中不存在的数据项
'ini 文件中写入数据，在此不用定义ini文件数据项
setProfile myini, "database2", "mbackcolor2", "-2147483643"
setProfile myini, "database2", "mforecolor2", "-2147483640"

'ini 文件中读出数据，在此不用定义ini文件数据项
mbackcolor2 = GetProfile(myini, "database2", "mbackcolor2")
mforecolor2 = GetProfile(myini, "database2", "mforecolor2")
if mbackcolor2=Empty Then        Response.Write "Null"        Else        Response.Write mbackcolor2 & "<br>"
if mforecolor2=Empty Then        Response.Write "Null"        Else        Response.Write mforecolor2 & "<br>"

'ini 文件中读出不存在的数据项
mbackcolor3 = GetProfile(myini, "database3", "mforecolor3")
if mbackcolor3=Empty Then        Response.Write "Null"        Else        Response.Write mbackcolor3 & "<br>"



%>