ASPを書く時よく使ういくつかの関数
10109 ワード
'@
'@idate
'@itype 0 ,
function showweek(idate,itype)
if itype <> 0 then itype = 1 '//
dim inum,nday
inum = weekday(idate)
if itype = 0 then
select case inum
case 1
nday = "Sunday"
case 2
nday = "Monday"
case 3
nday = "Tuesday"
case 4
nday = "Wednesday"
case 5
nday = "Thursday"
case 6
nday = "Friday"
case 7
nday = "Saturday"
end select
else
select case inum
case 1
nday = " "
case 2
nday = " "
case 3
nday = " "
case 4
nday = " "
case 5
nday = " "
case 6
nday = " "
case 7
nday = " "
end select
end if
'//OUTPUT
showweek = nday
end function
'//*************************************************************'@
'@ ：TotalReCount:
'@page: ,pagesize: ，url:
function PageList(TotalReCount,page,pagesize,url)
dim startPage,endPage,ipage,totalPage
'//
if inStr(1,url,"?") = 0 then
url = url & "?"
else
url = url & "&"
end if
'//
totalPage = TotalReCount \ pagesize
if TotalRecount mod pagesize <> 0 then totalPage = Cint(TotalRecount\pagesize+1)
startPage = 1
endPage = totalPage
if page > 10 then startPage = page - 4
if totalPage < 10 then
endPage = totalPage
else
if page =< 10 then
endPage = 10
else
endPage = page + 4
if endPage > totalPage then endPage = totalPage
end if
end if%>
:<%=TotalReCount%> <%=pagesize%>
<%if page>1 then%>
<a href="<%=url%>page=1"><font face="webdings">9</font></a>
<a href="<%=url%>page=<%=page-1%>"><font face="webdings">7</font></a>
<%end if%>
<%for ipage = startPage to endPage
if ipage <> page then%>
<a href=""><%=ipage%></a>
<%else
response.write i&" "
end if
next%>
<%if (totalPage-page)>4 then%>
<a href="<%=url%>page=<%=page+1%>"><font face="webdings">8</font></a>
<a href="<%=url%>page=<%=totalPage%>"><font face="webdings">:</font></a>
<%end ifend function
'//*************************************************************
'//
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
'//*************************************************************Function SafeRequest(ParaName,ParaType) ' SQL
'--- ---// : SafeRequest("username",0) SafeRequest("id",1)
'ParaName: -
'ParaType: - (1 ，0 ) Dim ParaValue
ParaValue=Request(ParaName)
If ParaType=1 then
If not isNumeric(ParaValue) then
'Response.write "<script language=javascript>alert(' " & ParaName & " ！');</script>"
Response.write "<script language=javascript>window.history.back();</script>"
Response.end
elseif ParaValue < 1 then
ParaValue = 1
End if
Else
ParaValue=replace(ParaValue,"'","''")
End if
SafeRequest=ParaValue
End function
'//*************************************************************'//HTML
Function HTMLDecode(fString)
If Not IsNull(fString) Then
fString = replace(fString, ">", ">")
fString = replace(fString, "<", "<")
fString = Replace(fString, " ", CHR(32)) '
fString = Replace(fString, " ", CHR(9)) '
fString = Replace(fString, """, CHR(34)) '
'fString = Replace(fString, CHR(39), "'") '
'fString = Replace(fString, ,"" CHR(13))
fString = Replace(fString, "</p><p>", CHR(10) & CHR(10))
fString = Replace(fString, "<br>", CHR(10))
HTMLDecode = fString
End If
End Function
'//*************************************************************'//HTML
Function HTMLEncode(fString)
If Not IsNull(fString) Then
fString = replace(fString, ">", ">")
fString = replace(fString, "<", "<")
fString = Replace(fString, CHR(32), " ") '
fString = Replace(fString, CHR(9), " ") '
fString = Replace(fString, CHR(34), """) '
'fString = Replace(fString, CHR(39), "'") '
fString = Replace(fString, CHR(13), "")
fString = Replace(fString, CHR(10) & CHR(10), "</p><p>")
fString = Replace(fString, CHR(10), "<br>")
HTMLEncode = fString
End If
End Function
'//*************************************************************'CFS Encode Function
Function CfsEnCode(CodeStr)
Dim CodeLen
Dim CodeSpace
Dim NewCode
dim cecr,cecb,cec
CodeLen = 30
CodeSpace = CodeLen - Len(CodeStr)
If Not CodeSpace < 1 Then
For cecr = 1 To CodeSpace
CodeStr = CodeStr & Chr(21)
Next
End If
NewCode = 1
Dim Been
For cecb = 1 To CodeLen
Been = CodeLen + Asc(Mid(CodeStr,cecb,1)) * cecb
NewCode = NewCode * Been
Next
CodeStr = NewCode
NewCode = Empty
For cec = 1 To Len(CodeStr)
NewCode = NewCode & CfsCode(Mid(CodeStr,cec,3))
Next
For cec = 20 To Len(NewCode) - 18 Step 2
CfsEnCode = CfsEnCode & Mid(NewCode,cec,1)
Next
End FunctionFunction CfsCode(Word)
dim cc
For cc = 1 To Len(Word)
CfsCode = CfsCode & Asc(Mid(Word,cc,1))
Next
CfsCode = Hex(CfsCode)
End Function
'//*************************************************************'//
function CLMoney(thenumber)
dim Money,i,String1,String2,length,checkp'
dim one(),onestr()' String1 = " "
String2 = " " checkp=instr(thenumber,".")'
if checkp<>0 then
thenumber=replace(thenumber,".","")'
end if length=len(thenumber) '
redim one(length-1)'
redim onestr(length-1)' for i=0 to length-1 one(i)=mid(thenumber,i+1,1) '
one(i)=mid(string1,one(i)+1,1)'
if checkp=0 then
'
onestr(i)=mid(string2,14-length+i,1)
else
'
onestr(i)=mid(string2,15-length+i+len(thenumber)-checkp,1)
end if one(i)=one(i)&onestr(i)'
next Money=replace(join(one)," ","") ' ，
Money=replace(Money," "," ")
Money=replace(Money," "," ")
Money=replace(Money," "," ")
Money=replace(Money," "," ")
Money=replace(Money," "," ")
Money=replace(Money," "," ") do while not instr(Money," ")=0
Money=replace(Money," "," ")
loop
CLmoney = Money
end function
'//***********************************************************'//IP ， IP
'@
'// userIPnum = IP2Num(Request.ServerVariables("REMOTE_ADDR"))
'// if userIPnum > IP2Num("192.168.0.0") and userIPnum <
'// IP2Num("192.168.0.255") then
'// response.write ("<center> IP </center>")
'// response.end
'// end iffunction IP2Num(sip)
dim str1,str2,str3,str4
dim num
IP2Num=0
if isnumeric(left(sip,2)) then
str1=left(sip,instr(sip,".")-1)
sip=mid(sip,instr(sip,".")+1)
str2=left(sip,instr(sip,".")-1)
sip=mid(sip,instr(sip,".")+1)
str3=left(sip,instr(sip,".")-1)
str4=mid(sip,instr(sip,".")+1)
num=cint(str1)*256*256*256+cint(str2)*256*256+cint(str3)*256+cint(str4)-1
IP2Num = num
end if
end function
'//********************************************************