常用ASP自定义函数集 (S.Sams)

　　rem ---表单提示函数 Being-----------------------------
CODE Copy ...
Function Check_submit(str,restr)
if str= then
response.write <script>
response.write alert(restr);
response.write history.go(-1)
response.write </script>
response.end
else
Check_submit=str
end if
End Function

　　
CODE Copy ...
Function Alert_submit(str)
response.write <script>
response.write alert(str);
response.write location.reload();
response.write </script>
End Function

　　
CODE Copy ...
Function localhost_submit(str,urls)
response.write <script>
if str<> then
response.write alert(str);
end if
response.write location=urls;
response.write </script>
End Function

　　rem ---生成自定义位随机数 Being-----------------------------
CODE Copy ...
Function makerndid(byVal maxLen)
Dim strNewPass
Dim whatsNext, upper, lower, intCounter
RANdomize
For intCounter = 1 To maxLen
whatsNext = int(2 * Rnd)
If whatsNext = 0 Then
upper = 80
lower = 70
Else
upper = 48
lower = 39
End If
strNewPass = strNewPass Chr(Int((upper - lower + 1) * Rnd + upper))
Next
makerndid = strNewPass
End Function

　　rem ---生成四位随机数 Being-----------------------------
CODE Copy ...
Function get_rand()
dim num1
dim rndnum
Randomize
Do While Len(rndnum)<4
num1=CStr(Chr((57-48)*rnd+48))
rndnum=rndnumnum1
loop
get_rand=rndnum
End Function

　　rem ---判断数据是否整型 Being-----------------------------
CODE Copy ...
Function IsInteger(para)
on error resume next
dim str
dim l,i
if isNUll(para) then
isInteger=false
exit function
end if
str=cstr(para)
if trim(str)= then
isInteger=false
exit function
end if
l=len(str)
for i=1 to l
if mid(str,i,1)>9 or mid(str,i,1)<0 then
isInteger=false
exit function
end if
next
isInteger=true
if err.number<>0 then err.clear
End Function

　　rem ---数据库链接函数 Being-----------------------------
CODE Copy ...
Function OpenCONN
connstr=Provider=Microsoft.Jet.OLEDB.4.0;Data Source= Server.MapPath(DB_login)
conn.Open connstr
End Function

　　rem ---中文字符转Uncode代码函数 Being-----------------------------
CODE Copy ...
Function URLEncoding(vstrIn)
strReturn =
For i = 1 To Len(vstrIn)
ThisChr = Mid(vStrIn,i,1)
If Abs(Asc(ThisChr)) < HFF Then
strReturn = strReturn ThisChr
Else
innerCode = Asc(ThisChr)
If innerCode < 0 Then
innerCode = innerCode + H10000
End If
Hight8 = (innerCode And HFF00) HFF
Low8 = innerCode And HFF
strReturn = strReturn % Hex(Hight8) % Hex(Low8)
End If
Next
URLEncoding = strReturn
End Function

　　rem ---Html过滤函数 Being-----------------------------Function Htmlout(str)
CODE Copy ...
dim result
dim l
if isNULL(str) then
Htmlout=
exit function
end if
l=len(str)
result=
dim i
for i = 1 to l
select case mid(str,i,1)
case <
result=result+lt;
case >
result=result+gt;
case chr(13)
if session(admin_system)= then
result=result+<br>
end if
case chr(34)
result=result+quot;
case
result=result+amp;
case chr(32)
result=result+nbsp;
if i+1<=l and i-1>0 then
if mid(str,i+1,1)=chr(32) or mid(str,i+1,1)=chr(9) or mid(str,i-1,1)=chr(32) or mid(str,i-1,1)=chr(9) then
result=result+nbsp;
else
result=result+
end if
else
result=result+nbsp;
end if
case chr(9)
result=result+
case else
result=result+mid(str,i,1)
end select
next
Htmlout=result
End Function

　　rem ---textarea显示用---
CODE Copy ...
function htmlencode1(fString)
if fString<> and not isnull(fString) then
fString = replace(fString, gt;, >)
fString = replace(fString, lt;, <)
fString = Replace(fString, nbsp;, chr(32))
fString = Replace(fString, </p><p>, CHR(10) CHR(10))
fString = Replace(fString, <br>, CHR(10))
htmlencode1=fString
else
htmlencode1=
end if
end function

　　rem ---页面显示用---
CODE Copy ...
function htmlencode2(fString)
if fString<> and not isnull(fString) then
fString = replace(fString, >, gt;)
fString = replace(fString, <, lt;)
fString = Replace(fString, chr(32), nbsp;)
fString = Replace(fString, CHR(10) CHR(10), </p><p>)
fString = Replace(fString, CHR(10), <br>)
htmlencode2=fString
else
htmlencode2=
end if
end function

　　
rem ---取出指定字符串前后的字符串方法---
CODE Copy ...
function GetStrs(str1,CharFlag,Dflag)
dim tmpstr
if Dflag=0 then取左
pos1=instr(str1,charFlag)
if pos1<=20 then
tmpstr=left(str1,pos1-1)
else
tmpstr=mid(str1,pos1-20,20)
end if
else 取右
pos1=instr(str1,charFlag)+len(charFlag)
if len(str1)-pos1<=20 then
tmpstr=right(str1,len(str1)-pos1)
else
tmpstr=mid(str1,pos1+1,20)
end if
end if
GetStrs=tmpstr
end function

　　
rem ---取出文件名---
CODE Copy ...
function getfilename(str)
pos=instr(str,.)
if str<> then
str=mid(str,pos,len(str))
end if
getfilename=str
end function

　　rem ---取到浏览器版本转换字符串---
CODE Copy ...
function browser()
dim text
text = Request.ServerVariables(HTTP_USER_AGENT)
if Instr(text,MSIE 5.5)>0 then
browser=IE 5.5
elseif Instr(text,MSIE 6.0)>0 then
browser=IE 6.0
elseif Instr(text,MSIE 5.01)>0 then
browser=IE 5.01
elseif Instr(text,MSIE 5.0)>0 then
browser=IE 5.00
elseif Instr(text,MSIE 4.0)>0 then
browser=IE 4.01
else
browser=未知
end if
end function

　　
rem ---取到系统脚本转换字符串---
CODE Copy ...
function system(text)
if Instr(text,NT 5.1)>0 then
system=system+Windows XP
elseif Instr(text,NT 5)>0 then
system=system+Windows 2000
elseif Instr(text,NT 4)>0 then
system=system+Windows NT4
elseif Instr(text,4.9)>0 then
system=system+Windows ME
elseif Instr(text,98)>0 then
system=system+Windows 98
elseif Instr(text,95)>0 then
system=system+Windows 95
else
system=system+未知
end if
end function

　　
rem ---=删除文件---
CODE Copy ...
function delfile(filepath)
imangepath=trim(filepath)
path=server.MapPath(imangepath)
SET fs=se