")
sTemp = Replace(sTemp, Chr(10), "
")
sTemp = Replace(sTemp, Chr(32), " ")
sTemp = Replace(sTemp, " ", " ")
if checklength <> "" then
TxtCheck = Left(sTemp,CheckLength)
else
TxtCheck = sTemp
end if
case 5
sTemp = CheckString
If IsNull(sTemp) = True Then
TxtCheck=ErrorRoot&"数据为空"
Exit Function
End If
sTemp = Replace(sTemp, "&", "&")
sTemp = Replace(sTemp, "<", "<")
sTemp = Replace(sTemp, ">", ">")
sTemp = Replace(sTemp, """, Chr(34))
sTemp = Replace(sTemp, "
", Chr(10) + Chr(10))
sTemp = Replace(sTemp, "
", Chr(10))
sTemp = Replace(sTemp, " ", chr(32))
if checklength <> "" then
TxtCheck = Left(sTemp,CheckLength)
else
TxtCheck = sTemp
end if
case 6
s_BadStr = "' &<>?%,;:()`~!@#$^*{}[]|+-=" & Chr(34) & Chr(9) & Chr(32)
n = Len(s_BadStr)
IsSafeStr = True
For i = 1 To n
If Instr(CheckString, Mid(s_BadStr, i, 1)) > 0 Then
IsSafeStr = False
End If
Next
if IsSafeStr then
if checklength <> "" then
TxtCheck = Left(CheckString,CheckLength)
else
TxtCheck = CheckString
end if
else
TxtCheck = false
Exit Function
end if
case 7
s_Filter="net user|xp_cmdshell|/add|select|count|asc|char|mid|'|""|"
S_Filter=S_Filter&"insert|delete|drop|truncate|from|%|declare|-"
S_Filters=split(S_Filter,"|")
isFound=false
for i=0 to ubound(S_Filters)-1
if Instr(lcase(CheckString),lcase(S_Filters(i)))<>0 then
isFound=true
exit for
end if
next
if isFound then
TxtCheck=ErrorRoot&"黑我？靠死你~~NND~~记下你IP了，你死定老！"
Exit Function
else
if checklength <> "" then
TxtCheck = Left(CheckString,CheckLength)
else
TxtCheck = CheckString
end if
end if
End Select
End Function
' *--------------------------------------------------------------------------------------------
' * 函数：online
' * 描述：统计在线人数
' * 参数:
' * 返回：返回在线人数信息
' *--------------------------------------------------------------------------------------------
Function online()
dim fso
set fso = server.createobject("scripting.filesystemobject")
dim file
file = server.mappath("online.txt")
if not fso.fileexists(file) then
fso.createtextfile file,true,false
end if
dim ip,timenow
ip = request.ServerVariables("REMOTE_ADDR")
timenow = now()
if session(ip) = "" then
session(ip) = ip
dim txt
set txt = fso.opentextfile (file,8,false)
txt.writeline ip&"|"&timenow;
txt.close
set txt = nothing
end if
set txt = fso.opentextfile (file,1,false)
dim infostring,infoarray,i
do while not txt.atendofstream
infostring = txt.readline
infoarray = split(infostring,"|",-1,1)
if cdate(infoarray(1)) < now()-10/(24*60) then
i = i + 1
else
exit do
end if
loop
txt.close
set txt = nothing
set txt = fso.opentextfile (file,1,false)
dim a
for a = 1 to i
txt.skipline
next
dim onlineinfo
do while not txt.atendofstream
onlineinfo = txt.readall
loop
txt.close
set txt = nothing
set txt = fso.opentextfile (server.mappath("online_temp.txt"),2,true)
txt.write onlineinfo
txt.close
set txt = nothing
fso.deletefile file,true
fso.movefile server.mappath("online_temp.txt"),file
set txt = fso.opentextfile (file,1,false)
dim onlinenum
onlinenum = 0
do while not txt.atendofstream
txt.readline
onlinenum = onlinenum + 1
loop
txt.close
set txt = nothing
set fso = nothing
online = onlinenum
End Function
' *--------------------------------------------------------------------------------------------
' * 函数：strLen
' * 描述：对字符串长度进行字符型判断
' * 参数: str
' * 说明:
' * str待检测字符串:任意字符串.
' * 返回：字符串单字节长度
' *--------------------------------------------------------------------------------------------
Function strLen(str)
dim i,l,t,c
l=len(str)
t=l
for i=1 to l
c=asc(mid(str,i,1))
if c<0 then c=c+65536
if c>255 then
t=t+1
end if
next
strLen=t
End Function
' *--------------------------------------------------------------------------------------------
' * 函数：strLeft
' * 描述：以单字符取字符串左起数
' * 参数: str,l
' * 说明:
' * str待检测字符串:任意字符串.
' * l待取的字符串长度：任意整形数字.
' * 返回：字符串左起l长度字符.
' *--------------------------------------------------------------------------------------------
Function Strleft(Str,L)
Temp_Str=Len(Str)
For I=1 To Temp_Str
Test_Str=(Mid(Str,I,1))
Strleft=Strleft&Test;_Str
If Asc(Test_Str)>0 Then
lens=lens+1
Else
lens=lens+2
End If
If lens>=L Then Exit For
Next
End Function
' *--------------------------------------------------------------------------------------------
' * 函数：IPToDvInt
' * 描述：将IP转换成动网IP数据类型
' * 参数: sip
' * 说明:
' * sip待转换IP:标准IP格式.
' * 返回：动网IP类型数据.
' *--------------------------------------------------------------------------------------------
Function IPToDvInt(sip)
esip=cstr(sip)
str1=Left(sip,CInt(InStr(sip,".")-1))
sip=Mid(sip,cint(instr(sip,"."))+1)
str2=Left(sip,cint(instr(sip,"."))-1)
sip=mid(sip,cint(instr(sip,"."))+1)
str3=left(sip,cint(instr(sip,"."))-1)
str4=mid(sip,cint(instr(sip,"."))+1)
IPToDvInt=cint(str1)*256*256*256+cint(str2)*256*256+cint(str3)*256+cint(str4)-1
End Function
' *--------------------------------------------------------------------------------------------
' * 函数：DvIntToIP
' * 描述：将动网IP数据转换成真实IP
' * 参数: sip
' * 说明:
' * sip待转换动网IP数据:动网IP数据.
' * 返回：真实IP数据.
' *--------------------------------------------------------------------------------------------
Function DvIntToIP(sip)
sip=sip+1
s1=int(sip/256/256/256)
s21=s1*256*256*256
s2=int((sip-s21)/256/256)
s31=s2*256*256+s21
s3=int((sip-s31)/256)
s4=sip-s3*256-s31
DvIntToIP=cstr(s1)+"."+cstr(s2)+"."+cstr(s3)+"."+cstr(s4)
End Function
' *--------------------------------------------------------------------------------------------
' * 函数：GetExtend
' * 描述：获得文件扩展名
' * 参数：filename
' * 说明:
' * filename待处理文件全名:文件全名
' * 返回：文件扩展名
' *--------------------------------------------------------------------------------------------
Function GetExtend(filename)
if filename<>"" then
GetExtend=LCase(mid(filename,instrrev(filename,".")+1,len(filename)-instrrev(filename,".")))
else
GetExtend=""
end if
End Function
' *--------------------------------------------------------------------------------------------
' * 函数：alertm
' * 描述：在客户端显示消息框
' * 参数：message:要显示的信息
' * 返回：--
' *--------------------------------------------------------------------------------------------
Sub alertm(message)
message = replace(message,"'","’")
Response.Write ("")
End Sub
' *--------------------------------------------------------------------------------------------
' * 函数：alertmGo
' * 描述：在客户端显示消息框并转移到指定页
' * 参数：message
' * 说明：
' * message:提交的信息
' * url:信息最后\nn\为前标识的URL地址 如：\nn\../index.asp
' * 返回：--
' *--------------------------------------------------------------------------------------------
Sub alertmGo(message)
message = replace(message,"'","’")
if instr(message, "\nn\") = 0 then
Response.Write ("")
Response.write ("")
Else
Url=mid(message, instr(message, "\nn\")+4)
message = left(message, instr(message, "\nn\")-1)
Response.Write ("")
Response.write ("")
End if
End Sub
' *--------------------------------------------------------------------------------------------
' * 函数：GoBack
' * 描述：在客户端返回上一页
' * 参数：--
' * 返回：--
' *--------------------------------------------------------------------------------------------
Sub GoBack()
Response.write ("")
End Sub
' *--------------------------------------------------------------------------------------------
' * 函数：GoUrl
' * 描述：重定向另外的连接
' * 参数：--
' * 返回：--
' *--------------------------------------------------------------------------------------------
Sub GoUrl(url)
Response.write ("")
End Sub
' *--------------------------------------------------------------------------------------------
' * 函数：GoPage
' * 描述：按指定秒数重定向另外的连接
' * 参数：url,s
' * 说明：
' * url:指定的连接
' * s:等待转移的秒数
' * 返回：--
' *--------------------------------------------------------------------------------------------
Sub GoPage(url,s)
Response.Write ""
End Sub
' *--------------------------------------------------------------------------------------------
' * 函数：DelFile
' * 描述：删除虚拟目录下的文件
' * 参数：filepath:文件虚拟路径
' * 返回：--
' *--------------------------------------------------------------------------------------------
Function DelFile(filepath)
imangepath=trim(filepath)
path=server.MapPath(imangepath)
SET fs=server.CreateObject("Scripting.FileSystemObject")
if FS.FileExists(path) then
FS.DeleteFile(path)
end if
set fs=nothing
End Function
' *--------------------------------------------------------------------------------------------
' * 函数：random
' * 描述：产生随机数
' * 参数：num:需要产生随机数的最大值
' * 返回：一个随机数
' *--------------------------------------------------------------------------------------------
Function random(num)
randomize
num=(int(rnd()*num)+1)
random=num
End Function
' *--------------------------------------------------------------------------------------------
' * 函数：IsObjInstalled
' * 描述：检测服务器是否支持该组件
' * 参数：strClassString
' * 说明：
' * strClassString:组件名
' * 返回：为True为存在 否则不存在
' *--------------------------------------------------------------------------------------------
Function IsObjInstalled(strClassString)
On Error Resume Next
IsObjInstalled = False
Err = 0
Dim xTestObj
Set xTestObj = Server.CreateObject(strClassString)
If 0 = Err Then IsObjInstalled = True
Set xTestObj = Nothing
Err = 0
End Function
' *--------------------------------------------------------------------------------------------
' * 函数：FSOChange
' * 描述：使用FSO修改文件特定内容
' * 参数：filename,Target,String
' * 说明：
' * filename:需要修改的文件名
' * Target:需要修改的内容
' * String:修改后的结果内容
' * 返回：--
' *--------------------------------------------------------------------------------------------
Function FSOChange(filename,Target,String)
Dim objFSO,objCountFile,FiletempData
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
if not objFSO.fileExists(server.mappath(filename)) then
FSOchange = "该文件不存在"
exit Function
End if
Set objGetFile = objFSO.GetFile(server.mappath(filename))
objFileV = objGetFile.Attributes
objGetFile.Attributes = 0
Set objCountFile = objFSO.OpenTextFile(Server.MapPath(filename),1,True)
FiletempData = objCountFile.ReadAll
objCountFile.Close
FiletempData=Replace(FiletempData,Target,String)
Set objCountFile = objFSO.CreateTextFile(Server.MapPath(filename),True)
objCountFile.Write FiletempData
objCountFile.Close
objGetFile.Attributes = objFileV
set objGetFile=Nothing
Set objCountFile=Nothing
Set objFSO = Nothing
FSOchange = "文件修改成功"
End Function
' *--------------------------------------------------------------------------------------------
' * 函数：FSOFileRead
' * 描述：使用FSO读取指定文件的内容
' * 参数：filename
' * 说明：
' * filename:需要读取的文件名
' * 返回：--
' *--------------------------------------------------------------------------------------------
function FSOFileRead(filename)
Dim objFSO,objCountFile,FiletempData
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
if not objFSO.fileExists(server.mappath(filename)) then
FSOchange = "该文件不存在"
exit Function
End if
Set objCountFile = objFSO.OpenTextFile(Server.MapPath(filename),1,True)
FSOFileRead = TxtCheck(objCountFile.ReadAll,4,"")
objCountFile.Close
Set objCountFile=Nothing
Set objFSO = Nothing
End Function
' *--------------------------------------------------------------------------------------------
' * 函数：FSOlineRead
' * 描述：使用FSO读取文件某一行的函数
' * 参数：filename,lineNum
' * 说明：
' * filename:需要读取的文件名
' * lineNum:需要读取的行数
' * 返回：--
' *--------------------------------------------------------------------------------------------
Function FSOlineRead(filename,lineNum)
if linenum < 1 then exit function
dim objFSO,f,temparray,tempcnt
set objFSO = server.CreateObject("scripting.filesystemobject")
if not objFSO.fileExists(server.mappath(filename)) then
FSOlineRead = "文件不存在"
Exit function
End if
set f = objFSO.opentextfile(server.mappath(filename),1)
if not f.AtEndofStream then
tempcnt = f.readall
f.close
set f = nothing
temparray = split(tempcnt,chr(13)&chr;(10))
if lineNum>ubound(temparray)+1 then
FSOlineRead = "没有该行"
exit function
else
FSOlineRead = TxtCheck(temparray(lineNum-1),4,"")
if FSOlineRead = "" then
FSOlineRead = "该行无数据"
End if
end if
else
FSOlineRead = "该文件没有数据"
end if
End Function
' *--------------------------------------------------------------------------------------------
' * 函数：FSOlineWrite
' * 描述：使用FSO改写指定行内容
' * 参数：filename,lineNum,Linecontent
' * 说明：
' * filename:需要读取的文件名
' * lineNum:需要读取的行数
' * Linecontent:改些的内容
' * 返回：--
' *--------------------------------------------------------------------------------------------
Function FSOlineWrite(filename,lineNum,Linecontent)
if linenum < 1 then exit function
dim objFSO,f,temparray,tempcnt
set objFSO = server.CreateObject("scripting.filesystemobject")
if not objFSO.fileExists(server.mappath(filename)) then
FSOlineWrite = "文件不存在"
Exit function
End if
Set objGetFile = objFSO.GetFile(server.mappath(filename))
objFileV = objGetFile.Attributes
objGetFile.Attributes = 0
set f = objFSO.opentextfile(server.mappath(filename),1)
if not f.AtEndofStream then
tempcnt = f.readall
f.close
set f = nothing
temparray = split(tempcnt,chr(13)&chr;(10))
if lineNum>ubound(temparray)+1 then
FSOlineWrite = "没有该行"
exit function
else
temparray(lineNum-1) = lineContent
tempcnt = join(temparray,chr(13)&chr;(10))
set f = objFSO.createtextfile(server.mappath(filename),true)
f.write tempcnt
objGetFile.Attributes = objFileV
FSOlineWrite = "文件修改成功"
End if
else
FSOlineWrite = "该文件没有数据"
end if
End Function
' *--------------------------------------------------------------------------------------------
' * 函数：FSOappline
' * 描述：使用FSO在指定行填加新行
' * 参数：filename,lineNum,Linecontent
' * 说明：
' * filename:需要读取的文件名
' * lineNum:需要读取的行数
' * Linecontent:改些的内容
' * 返回：-------------------未做好，累啊，不想做了啊--------------------
' *--------------------------------------------------------------------------------------------
Function FSOappline(filename,lineNum,Linecontent)
dim objFSO,f
set objFSO = server.CreateObject("scripting.filesystemobject")
if not objFSO.fileExists(server.mappath(filename)) then
FSOappline = "该文件不存在"
exit Function
End if
Set objGetFile = objFSO.GetFile(server.mappath(filename))
objFileV = objGetFile.Attributes
objGetFile.Attributes = 0
set f = objFSO.opentextfile(server.mappath(filename),1)
tempcnt = f.readall
f.close
set f = nothing
temparray = split(tempcnt,chr(13)&chr;(10))
if lineNum = 0 then
set f = fso.opentextfile(server.mappath(filename),8,1)
f.write chr(13)&chr;(10)&Linecontent;
f.close
elseif lineNum = z then
else
if lineNum>ubound(temparray)+1 then
FSOlineWrite = "没有该行"
exit function
else
temparray(lineNum-1) = lineContent
tempcnt = join(temparray,chr(13)&chr;(10))
set f = objFSO.createtextfile(server.mappath(filename),true)
f.write tempcnt
objGetFile.Attributes = objFileV
FSOlineWrite = "文件修改成功"
End if
End if
set f = fso.opentextfile(server.mappath(filename),8,1)
f.write chr(13)&chr;(10)&Linecontent;
f.close
objGetFile.Attributes = objFileV
set f = nothing
End Function
' *--------------------------------------------------------------------------------------------
' * 函数：Encrypt
' * 描述：RC2字符串加密
' * 参数：prestring
' * 说明：
' * prestring:任意字符串
' * 返回：加密后的字符串
' *--------------------------------------------------------------------------------------------
Function Encrypt(prestring)
Dim texts
Dim seed
Dim i,length
prestring = trim(preString)
length = len(preString)
seed = length
Randomize(length)
texts = ""
for i = 1 to length
seed = int(95*rnd(-asc(mid(preString,i,1))-seed*asc(right(prestring,1)))+32)
texts = texts & chr(seed) & chr(int(95*rnd(-seed)+32))
next
encrypt = texts
End Function
' *--------------------------------------------------------------------------------------------
' * 函数：IsValidEmail
' * 描述：判断是否为真实EMAIL地址
' * 参数：email
' * 说明：
' * email:任意字符串
' * 返回：如果正确返回true 否者返回false
' *--------------------------------------------------------------------------------------------
Function IsValidEmail(email)
Dim names, name, i, c
IsValidEmail = true
names = Split(email, "@")
if UBound(names) <> 1 then
IsValidEmail = false
Exit function
end if
for each name in names
if Len(name) <= 0 then
IsValidEmail = false
exit function
end if
for i = 1 to Len(name)
c = Lcase(Mid(name, i, 1))
if InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 and not IsNumeric(c) then
IsValidEmail = false
exit function
end if
next
if Left(name, 1) = "." or Right(name, 1) = "." then
IsValidEmail = false
exit function
end if
next
if InStr(names(1), ".") <= 0 then
IsValidEmail = false
exit function
end if
i = Len(names(1)) - InStrRev(names(1), ".")
if i <> 2 and i <> 3 then
IsValidEmail = false
exit function
end if
if InStr(email, "..") > 0 then
IsValidEmail = false
end if
end function
' *--------------------------------------------------------------------------------------------
' * 函数：makePassword
' * 描述：产生全大写跟数字字符串
' * 参数：maxLen
' * 说明：
' * ByVal maxLen:任意整数数字
' * 返回：返回相应长度字符串
' *--------------------------------------------------------------------------------------------
Function makePassword(ByVal maxLen)
Dim strNewPass
Dim whatsNext, upper, lower, intCounter
Randomize
For intCounter = 1 To maxLen
whatsNext = Int((1 - 0 + 1) * Rnd + 0)
If whatsNext = 0 Then
'character
upper = 90
lower = 65
Else
upper = 57
lower = 48
End If
strNewPass = strNewPass & Chr(Int((upper - lower + 1) * Rnd + lower))
Next
makePassword = strNewPass
End Function
' *--------------------------------------------------------------------------------------------
' * 函数：StrRandomize
' *--------------------------------------------------------------------------------------------
Sub StrRandomize(strSeed)
Dim i, nSeed
nSeed = CLng(0)
For i = 1 To Len(strSeed)
nSeed = nSeed Xor ((256 * ((i - 1) Mod 4) * AscB(Mid(strSeed, i, 1))))
Next
Randomize nSeed
End Sub
Function GeneratePassword(nLength)
Dim i, bMadeConsonant, c, nRnd
Const strDoubleConsonants = "bdfglmnpst"
Const strConsonants = "bcdfghklmnpqrstv"
Const strVocal = "aeiou"
GeneratePassword = "DAILI"
bMadeConsonant = False
For i = 0 To nLength
nRnd = Rnd
If GeneratePassword <> "" AND (bMadeConsonant <> True) AND (nRnd < 0.15) Then
c = Mid(strDoubleConsonants, Int(Len(strDoubleConsonants) * Rnd + 1), 1)
c = c & c
i = i + 1
bMadeConsonant = True
Else
If (bMadeConsonant <> True) And (nRnd < 0.95) Then
c = Mid(strConsonants, Int(Len(strConsonants) * Rnd + 1), 1)
bMadeConsonant = True
Else
c = Mid(strVocal,Int(Len(strVocal) * Rnd + 1), 1)
bMadeConsonant = False
End If
End If
GeneratePassword = GeneratePassword & c
Next
If Len(GeneratePassword) > nLength Then
GeneratePassword = Left(GeneratePassword, nLength)
End If
End Function
' *--------------------------------------------------------------------------------------------
' * 函数：RandomPassword
' *--------------------------------------------------------------------------------------------
function RandomPassword(sText)
on error resume next
Randomize()
iUpperbound = int(left(sText, (len(sText)-2)))
iLowerbound = int(Year(Now) / (second(Now)+ 1))
iRandomNumber = int((iUpperbound - iLowerbound + 1) * Rnd + iLowerbound)
if len(iRandomNumber) < 6 then
do until len(iRandomNumber) = 6
iExtraDigit = int((9-0+1) * Rnd + 0)
iRandomNumber = iRandomNumber & iExtraDigit
loop
end if
sNewPassword = right(sText,1) & iRandomNumber & left(right(sText,2),1)
randompassword = sNewPassword
end function
' *--------------------------------------------------------------------------------------------
' * 函数：Password_GenPasss
' * 描述：产生一个可以带规则的随机数,不带规则则产生一个字符加数字的随机数
' * 参数：nNoChars, sValidChars
' * 说明：
' * nNoChars:任意整数数字=密码的长度
' * intNumber:字符串=有效的字符 为空则默认规则
' * 返回：返回指定长度的随机数
' *--------------------------------------------------------------------------------------------
Function Password_GenPass( nNoChars, sValidChars )
Const szDefault = "abcdefghijklmnopqrstuvxyzABCDEFGHIJKLMNOPQRSTUVXYZ0123456789"
Dim nCount
Dim sRet
Dim nNumber
Dim nLength
Randomize 'init random
If sValidChars = "" Then
sValidChars = szDefault
End If
nLength = Len( sValidChars )
For nCount = 1 To nNoChars
nNumber = Int((nLength * Rnd) + 1)
sRet = sRet & Mid( sValidChars, nNumber, 1 )
Next
Password_GenPass = sRet
End Function
' *--------------------------------------------------------------------------------------------
' * 函数：Password_GenPasss
' * 描述：产生一个前面英文字母，中间数字，后面符号的随机数
' * 参数：intEnglish,intNumber,intChar
' * 说明：
' * intEnglish:任意整数数字=返回英文字母
' * intNumber:任意整数数字=返回数字
' * intChar:任意整数数字=返回符号
' * 返回：返回指定长度的随机数
' *--------------------------------------------------------------------------------------------
Function Password_GenPasss(intEnglish,intNumber,intChar)
Const sEnglish = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
Const sNumber = "0123456789"
Const sChar = "~!@#$%^&*()_{}\|/<>?"
Dim sRet
Dim iEnglist
Dim iNumber
Dim iChar
Dim iLength
Dim intSum
Randomize
iEnglish = Len( sEnglish )
iNumber = Len(sNumber)
iChar = Len(sChar)
intSum = intEnglish + intNumber + intChar
For i = 1 to intSum
If i < (intEnglish + 1) Then
iLength = Int((iEnglish * Rnd) + 1)
sRet = sRet & Mid(sEnglish,iLength,1)
End If
If (i < intEnglish + intNumber + 1) and (i > intEnglish) Then
iLength = Int((iNumber * Rnd) + 1)
sRet = sRet & Mid(sNumber,iLength,1)
End If
If (i < intSum + 1) and (i > intEnglish + intNumber) Then
iLength = Int((iChar * Rnd) + 1)
sRet = sRet & Mid(sChar,iLength,1)
End If
Next
Password_GenPasss = sRet
End Function
' *--------------------------------------------------------------------------------------------
' * 函数：CompactDB
' * 描述：压缩MDB数据库文件
' * 参数：dbPath,boolIs97
' * 说明：
' * dbPath:任意文件路径=MDB文件的相对路径
' * boolIs97:布尔型值=为TRUE则数据为97型 否则2000型
' * 返回：压缩完成的数据文件，并返回成否是否的提示信息
' *--------------------------------------------------------------------------------------------
Function CompactDB(dbPath, boolIs97)
Dim fso, Engine, strDBPath,JET_3X
strDBPath = left(dbPath,instrrev(DBPath,"\"))
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(dbPath) Then
fso.CopyFile dbpath,strDBPath & "temp.mdb"
Set Engine = CreateObject("JRO.JetEngine")
If boolIs97 = "True" Then
Engine.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDBPath & "temp.mdb", _
"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDBPath & "temp1.mdb;" _
& "Jet OLEDB:Engine Type=" & JET_3X
Else
Engine.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDBPath & "temp.mdb", _
"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDBPath & "temp1.mdb"
End If
fso.CopyFile strDBPath & "temp1.mdb",dbpath
fso.DeleteFile(strDBPath & "temp.mdb")
fso.DeleteFile(strDBPath & "temp1.mdb")
Set fso = nothing
Set Engine = nothing
CompactDB = "你的数据库, " & dbpath & ", 已经压缩成功!"
Else
CompactDB = "数据库名称或路径不正确. 请重试!"
End If
End Function
' *--------------------------------------------------------------------------------------------
' * 函数：CopyFile
' * 描述：根据指定复制文件
' * 参数：FilePath,FilePathC
' * 说明：
' * FilePath:任意文件路径=文件的绝对路径
' * FilePathC:任意文件路径=文件的绝对路径
' * 返回：压缩完成的数据文件，并返回成否是否的提示信息
' *--------------------------------------------------------------------------------------------
Function CopyFile(FilePath, FilePathC)
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
fso.CopyFile FilePath,FilePathC
Set fso = nothing
End Function
' *--------------------------------------------------------------------------------------------
' * 函数：CheckDir
' * 描述：检查目录是否存在
' * 参数：FolderPath
' * 说明：
' * FolderPath:任意路径=需要检查是否存在的路径
' * 返回：BOOL型数据 存在则TRUE 否则FLASE
' *--------------------------------------------------------------------------------------------
Function CheckDir(FolderPath)
folderpath=Server.MapPath(".")&"\"&folderpath;
Set fso1 = CreateObject("Scripting.FileSystemObject")
If fso1.FolderExists(FolderPath) then
'存在
CheckDir = True
Else
'不存在
CheckDir = False
End if
Set fso1 = nothing
End Function
Function MakeFile(FolderPath,str)
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile(FolderPath, True)
a.WriteLine(str)
a.Close
Set a = nothing
Set fs = nothing
End Function
' *--------------------------------------------------------------------------------------------
' * 函数：MakeNewsDir
' * 描述：根据指定名称生成目录
' * 参数：foldername
' * 说明：
' * foldername:任意目录名=需要生成的目录名
' * 返回：BOOL型数据 生成了则为TRUE
' *--------------------------------------------------------------------------------------------
Function MakeNewsDir(foldername)
dim f
Set fso1 = CreateObject("Scripting.FileSystemObject")
Set f = fso1.CreateFolder(foldername)
MakeNewDir = foldername
Set fso1 = nothing
End Function
Sub MakeNewsDir1(foldername)
dim f
Set fso1 = CreateObject("Scripting.FileSystemObject")
Set f = fso1.CreateFolder(foldername)
Set fso1 = nothing
End Sub
' *--------------------------------------------------------------------------------------------
' * 函数：AddHackInfo
' * 描述：对非法操作进行记录
' * 参数：str
' * 说明：
' * str:任意字符串=需要记录的非法信息
' * 返回：
' *--------------------------------------------------------------------------------------------
Sub AddHackInfo(str)
dim conn1
dim connstr1
dim db1
db1="/data/DB.MDB"
Set conn1 = Server.CreateObject("ADODB.Connection")
connstr1="Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(""&db1;&"")
conn1.Open connstr1
Set HackRs = Server.CreateObject("Adodb.RecordSet")
HackSql = "Select * From HackInfo where (ID is null)"
HackRs.open HackSql,Conn1,1,3
HackRs.addnew
HackRs("IP") = Request.ServerVariables("REMOTE_HOST")
HackRs("HackInfo") = str
HackRs.update
HackRs.close
set HackRs = nothing
conn1.close
set conn1=nothing
End Sub
'***********************************************
'函数名：JoinChar
'作 用：向地址中加入 ? 或 &
'参 数：strUrl ----网址
'返回值：加了 ? 或 & 的网址
'***********************************************
function JoinChar(strUrl)
if strUrl="" then
JoinChar=""
exit function
end if
if InStr(strUrl,"?")"
sfilename=JoinChar(sfilename)
if CurrentPage<2 then
strTemp=strTemp & "首页 上一页 "
else
strTemp=strTemp & "首页 "
strTemp=strTemp & "上一页 "
end if
if n-currentpage<1 then
strTemp=strTemp & "下一页 尾页"
else
strTemp=strTemp & "下一页 "
strTemp=strTemp & "尾页"
end if
strTemp=strTemp & " 页次：" & CurrentPage & "/" & n & "页 "
strTemp=strTemp & " " & maxperpage & "" & "条/页"
strTemp=strTemp & " 转到："
strTemp=strTemp & " 时尚杂志调查
时尚杂志排行
