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>"
%>
