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

王朝asp·作者佚名  2006-01-31
窄屏简体版  字體: |||超大  

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

%>

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
 
 
© 2005- 王朝網路 版權所有 導航