<%
'
'常用函数
'///
'读取记事本函数
function FSOFileRead(filename)
Dim objFSO,objCountFile,FiletempData
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
if instr(filename,":\")>0 or instr(filename,"\\")>0 then '//如果是绝对路径
Set objCountFile = objFSO.OpenTextFile(filename,1,True)
else'//相对路径
Set objCountFile = objFSO.OpenTextFile(Server.MapPath(filename),1,True)
end if
FSOFileRead = objCountFile.ReadAll
objCountFile.Close
Set objCountFile=Nothing
Set objFSO = Nothing
end function
'写入到记事本函数
function FSOFileWrite(filename, content)
Set fso = Server.CreateObject("scripting.FileSystemObject") '创建FSO对象
'if isServePath=true then Set fileObj = fso.opentextfile(Server.MapPath(filename),2,true) '使用FSO创建文件写入对象
Set fileObj = fso.opentextfile(filename,2,true) '使用FSO创建文件写入对象
fileObj.write content
fileObj.close
'response.Write("save succuse")
Set fileObj = nothing
Set fso = nothing
end function
'字符串截取
function ZqStr(all,sta,fin)
dim arr
dim i
arr=split(all,sta)
for i=1 to ubound(arr)
if instr(arr(i),fin)>0 then
ZqStr=split(arr(i),fin)(0)
end if
next
end function
'ASP判断文件是否存在以及删除文件实例代码
public function isFileExists(filename)
if instr(filename,":\")>0 or instr(filename,"\\")>0 then '//如果是绝对路径
filename=filename
else'//相对路径
filename=server.MapPath(filename)
end if
Set fs=Server.CreateObject("Scripting.FileSystemObject")
If fs.FileExists(filename) Then '判断文件是否存在
isFileExists=true
'fs.DeleteFile filename,true '如果文件存在,则删除文件
else
isFileExists=false
end if
Set fs=Nothing
end function
%>
<%'================================================
'函数名:URLDecode
'作 用:URL解码
'================================================
Function URLDecode(ByVal urlcode)
Dim start,final,length,char,i,butf8,pass
Dim leftstr,rightstr,finalstr
Dim b0,b1,bx,blength,position,u,utf8
On Error Resume Next
b0 = Array(192,224,240,248,252,254)
urlcode = Replace(urlcode,"+"," ")
pass = 0
utf8 = -1
length = Len(urlcode) : start = InStr(urlcode,"%") : final = InStrRev(urlcode,"%")
If start = 0 Or length < 3 Then URLDecode = urlcode : Exit Function
leftstr = Left(urlcode,start - 1) : rightstr = Right(urlcode,length - 2 - final)
For i = start To final
char = Mid(urlcode,i,1)
If char = "%" Then
bx = URLDecode_Hex(Mid(urlcode,i + 1,2))
If bx > 31 And bx < 128 Then
i = i + 2
finalstr = finalstr & ChrW(bx)
ElseIf bx > 127 Then
i = i + 2
If utf8 < 0 Then
butf8 = 1 : blength = -1 : b1 = bx
For position = 4 To 0 Step -1
If b1 >= b0(position) And b1 < b0(position + 1) Then
blength = position
Exit For
End If
Next
If blength > -1 Then
For position = 0 To blength
b1 = URLDecode_Hex(Mid(urlcode,i + position * 3 + 2,2))
If b1 < 128 Or b1 > 191 Then butf8 = 0 : Exit For
Next
Else
butf8 = 0
End If
If butf8 = 1 And blength = 0 Then butf8 = -2
If butf8 > -1 And utf8 = -2 Then i = start - 1 : finalstr = "" : pass = 1
utf8 = butf8
End If
If pass = 0 Then
If utf8 = 1 Then
b1 = bx : u = 0 : blength = -1
For position = 4 To 0 Step -1
If b1 >= b0(position) And b1 < b0(position + 1) Then
blength = position
b1 = (b1 xOr b0(position)) * 64 ^ (position + 1)
Exit For
End If
Next
If blength > -1 Then
For position = 0 To blength
bx = URLDecode_Hex(Mid(urlcode,i + 2,2)) : i = i + 3
If bx < 128 Or bx > 191 Then u = 0 : Exit For
u = u + (bx And 63) * 64 ^ (blength - position)
Next
If u > 0 Then finalstr = finalstr & ChrW(b1 + u)
End If
Else
b1 = bx * &h100 : u = 0
bx = URLDecode_Hex(Mid(urlcode,i + 2,2))
If bx > 0 Then
u = b1 + bx
i = i + 3
Else
If Left(urlcode,1) = "%" Then
u = b1 + Asc(Mid(urlcode,i + 3,1))
i = i + 2
Else
u = b1 + Asc(Mid(urlcode,i + 1,1))
i = i + 1
End If
End If
finalstr = finalstr & Chr(u)
End If
Else
pass = 0
End If
End If
Else
finalstr = finalstr & char
End If
Next
URLDecode = leftstr & finalstr & rightstr
End Function
Function URLDecode_Hex(ByVal h)
On Error Resume Next
h = "&h" & Trim(h) : URLDecode_Hex = -1
If Len(h) <> 4 Then Exit Function
If isNumeric(h) Then URLDecode_Hex = cInt(h)
End Function%>
<%
function gethttppage(url)
on error resume next
If err then
err.clear
End If
dim adxmlhttp
set adxmlhttp = Server.createobject("microsoft.xmlhttp")
adxmlhttp.open "get",url,false
adxmlhttp.send()
if adxmlhttp.readystate <> 4 then exit function
gethttppage = Bytes2bStr(adxmlhttp.responsebody)
set adxmlhttp = nothing
End function
function Bytes2bStr(vin)
Dim BytesStream,StringReturn
Set BytesStream = Server.CreateObject("adodb.stream")
BytesStream.Type = 2
BytesStream.Open
BytesStream.WriteText vin
BytesStream.Position = 0
BytesStream.Charset = "GB2312"
BytesStream.Position = 2
StringReturn =BytesStream.ReadText
BytesStream.close
Set BytesStream = Nothing
Bytes2bStr = StringReturn
End function
%>
'
'常用函数
'///
'读取记事本函数
function FSOFileRead(filename)
Dim objFSO,objCountFile,FiletempData
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
if instr(filename,":\")>0 or instr(filename,"\\")>0 then '//如果是绝对路径
Set objCountFile = objFSO.OpenTextFile(filename,1,True)
else'//相对路径
Set objCountFile = objFSO.OpenTextFile(Server.MapPath(filename),1,True)
end if
FSOFileRead = objCountFile.ReadAll
objCountFile.Close
Set objCountFile=Nothing
Set objFSO = Nothing
end function
'写入到记事本函数
function FSOFileWrite(filename, content)
Set fso = Server.CreateObject("scripting.FileSystemObject") '创建FSO对象
'if isServePath=true then Set fileObj = fso.opentextfile(Server.MapPath(filename),2,true) '使用FSO创建文件写入对象
Set fileObj = fso.opentextfile(filename,2,true) '使用FSO创建文件写入对象
fileObj.write content
fileObj.close
'response.Write("save succuse")
Set fileObj = nothing
Set fso = nothing
end function
'字符串截取
function ZqStr(all,sta,fin)
dim arr
dim i
arr=split(all,sta)
for i=1 to ubound(arr)
if instr(arr(i),fin)>0 then
ZqStr=split(arr(i),fin)(0)
end if
next
end function
'ASP判断文件是否存在以及删除文件实例代码
public function isFileExists(filename)
if instr(filename,":\")>0 or instr(filename,"\\")>0 then '//如果是绝对路径
filename=filename
else'//相对路径
filename=server.MapPath(filename)
end if
Set fs=Server.CreateObject("Scripting.FileSystemObject")
If fs.FileExists(filename) Then '判断文件是否存在
isFileExists=true
'fs.DeleteFile filename,true '如果文件存在,则删除文件
else
isFileExists=false
end if
Set fs=Nothing
end function
%>
<%'================================================
'函数名:URLDecode
'作 用:URL解码
'================================================
Function URLDecode(ByVal urlcode)
Dim start,final,length,char,i,butf8,pass
Dim leftstr,rightstr,finalstr
Dim b0,b1,bx,blength,position,u,utf8
On Error Resume Next
b0 = Array(192,224,240,248,252,254)
urlcode = Replace(urlcode,"+"," ")
pass = 0
utf8 = -1
length = Len(urlcode) : start = InStr(urlcode,"%") : final = InStrRev(urlcode,"%")
If start = 0 Or length < 3 Then URLDecode = urlcode : Exit Function
leftstr = Left(urlcode,start - 1) : rightstr = Right(urlcode,length - 2 - final)
For i = start To final
char = Mid(urlcode,i,1)
If char = "%" Then
bx = URLDecode_Hex(Mid(urlcode,i + 1,2))
If bx > 31 And bx < 128 Then
i = i + 2
finalstr = finalstr & ChrW(bx)
ElseIf bx > 127 Then
i = i + 2
If utf8 < 0 Then
butf8 = 1 : blength = -1 : b1 = bx
For position = 4 To 0 Step -1
If b1 >= b0(position) And b1 < b0(position + 1) Then
blength = position
Exit For
End If
Next
If blength > -1 Then
For position = 0 To blength
b1 = URLDecode_Hex(Mid(urlcode,i + position * 3 + 2,2))
If b1 < 128 Or b1 > 191 Then butf8 = 0 : Exit For
Next
Else
butf8 = 0
End If
If butf8 = 1 And blength = 0 Then butf8 = -2
If butf8 > -1 And utf8 = -2 Then i = start - 1 : finalstr = "" : pass = 1
utf8 = butf8
End If
If pass = 0 Then
If utf8 = 1 Then
b1 = bx : u = 0 : blength = -1
For position = 4 To 0 Step -1
If b1 >= b0(position) And b1 < b0(position + 1) Then
blength = position
b1 = (b1 xOr b0(position)) * 64 ^ (position + 1)
Exit For
End If
Next
If blength > -1 Then
For position = 0 To blength
bx = URLDecode_Hex(Mid(urlcode,i + 2,2)) : i = i + 3
If bx < 128 Or bx > 191 Then u = 0 : Exit For
u = u + (bx And 63) * 64 ^ (blength - position)
Next
If u > 0 Then finalstr = finalstr & ChrW(b1 + u)
End If
Else
b1 = bx * &h100 : u = 0
bx = URLDecode_Hex(Mid(urlcode,i + 2,2))
If bx > 0 Then
u = b1 + bx
i = i + 3
Else
If Left(urlcode,1) = "%" Then
u = b1 + Asc(Mid(urlcode,i + 3,1))
i = i + 2
Else
u = b1 + Asc(Mid(urlcode,i + 1,1))
i = i + 1
End If
End If
finalstr = finalstr & Chr(u)
End If
Else
pass = 0
End If
End If
Else
finalstr = finalstr & char
End If
Next
URLDecode = leftstr & finalstr & rightstr
End Function
Function URLDecode_Hex(ByVal h)
On Error Resume Next
h = "&h" & Trim(h) : URLDecode_Hex = -1
If Len(h) <> 4 Then Exit Function
If isNumeric(h) Then URLDecode_Hex = cInt(h)
End Function%>
<%
function gethttppage(url)
on error resume next
If err then
err.clear
End If
dim adxmlhttp
set adxmlhttp = Server.createobject("microsoft.xmlhttp")
adxmlhttp.open "get",url,false
adxmlhttp.send()
if adxmlhttp.readystate <> 4 then exit function
gethttppage = Bytes2bStr(adxmlhttp.responsebody)
set adxmlhttp = nothing
End function
function Bytes2bStr(vin)
Dim BytesStream,StringReturn
Set BytesStream = Server.CreateObject("adodb.stream")
BytesStream.Type = 2
BytesStream.Open
BytesStream.WriteText vin
BytesStream.Position = 0
BytesStream.Charset = "GB2312"
BytesStream.Position = 2
StringReturn =BytesStream.ReadText
BytesStream.close
Set BytesStream = Nothing
Bytes2bStr = StringReturn
End function
%>