用户登录  |  用户注册  | 
首 页火爆电影好玩游戏精彩文章软件下载超酷动画好听音乐精彩论坛更多栏目
影视资讯 | 在线电影 | 新片上映 | 影视排行 | 影视热评 | 影视明星 | 音乐报道 | 新歌上架 | 歌曲排行 | 歌手档案 | 乐评精选 | 游戏资讯 | 游戏排行 | 游戏评测
当前位置:飞亚网精彩文章网络教程软件教程
日期:2007-11-17 11:03:50  来源:CSDN

常用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=rndnum&num1
  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
  Set conn = Server.CreateObject("ADODB.Connection")
  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+"<"
   case ">"
   result=result+">"
    case chr(13)
      if session("admin_system")="" then
   result=result+"<br>"
      end if
   case chr(34)
   result=result+"""
   case "&"
   result=result+"&"
case chr(32)  
   'result=result+" "
   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+" "
   else
   result=result+" "
   end if
   else
   result=result+" "  
   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, ">", ">")
fString = replace(fString, "<", "<")
fString = Replace(fString, " ", 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, ">", ">")
fString = replace(fString, "<", "<")
fString = Replace(fString, chr(32), " ")
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=server.CreateObject("Scripting.FileSystemObject")
if FS.FileExists(path) then
FS.DeleteFile(path)
end if
set fs=nothing
end function


rem ---得到真实的客户端IP---
CODE Copy ... 
Public Function GetClientIP()
dim uIpAddr
' 本函数参考webcn.Net/AspHouse 文献<取真实的客户IP>
uIpAddr = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
If uIpAddr = "" Then uIpAddr = Request.ServerVariables("REMOTE_ADDR")
GetClientIP = uIpAddr
uIpAddr = ""
End function


数据库查询中的特殊字符的问题
在进行数据库的查询时,会经常遇到这样的情况:
  例如想在一个用户数据库中查询他的用户名和他的密码,但恰好该用户使用的名字和密码中有特殊的字符,例如单引号,“|”号,双引号或者连字符“&”。
  例如他的名字是1"test,密码是A|&900
  这时当你执行以下的查询语句时,肯定会报错:
SQL = "SELECT * FROM SecurityLevel WHERE UID="" & UserID & """
SQL = SQL & " AND PWD="" & Password & """
  因为你的SQL将会是这样:
SELECT * FROM SecurityLevel WHERE UID="1"test" AND PWD="A|&900"
  在SQL中,"|"为分割字段用的,显然会出错了。现在提供下面的几个函数 专门用来处理这些头疼的东西:
Quoted from Unkown:

Function ReplaceStr (TextIn, ByVal SearchStr As String, _
ByVal Replacement As String, _
ByVal CompMode As Integer)


 Dim WorkText As String, Pointer As Integer
 If IsNull(TextIn) Then
  ReplaceStr = Null
 Else
  WorkText = TextIn
  Pointer = InStr(1, WorkText, SearchStr, CompMode)
  Do While Pointer > 0
   WorkText = Left(WorkText, Pointer - 1) & Replacement & _
   Mid(WorkText, Pointer + Len(SearchStr))
   Pointer = InStr(Pointer + Len(Replacement), WorkText, SearchStr, CompMode)
  Loop
  ReplaceStr = WorkText
 End If
End Function


Function SQLFixup(TextIn)
 SQLFixup = ReplaceStr(TextIn, """, """", 0)
End Function
Function JetSQLFixup(TextIn)
 Dim Temp
 Temp = ReplaceStr(TextIn, """, """", 0)
 JetSQLFixup = ReplaceStr(Temp, "|", "" & chr(124) & "", 0)
End Function


Function FindFirstFixup(TextIn)
 Dim Temp
 Temp = ReplaceStr(TextIn, """, "" & chr(39) & "", 0)
 FindFirstFixup = ReplaceStr(Temp, "|", "" & chr(124) & "", 0)
End Function
 
rem 借助RecordSet将二进制流转化成文本
Quoted from Unkown:
Function BinaryToString(biData,Size)
  Const adLongVarChar = 201
  Set RS = CreateObject("ADODB.Recordset")
  RS.Fields.Append "mBinary", adLongVarChar, Size
  RS.Open
  RS.AddNew
  RS("mBinary").AppendChunk(biData)
  RS.Update
  BinaryToString = RS("mBinary").Value
  RS.Close
End Function






  

  

Tags:

作者:未知

文章评论评论内容只代表网友观点,与本站立场无关!

   评论摘要(共 0 条,得分 0 分,平均 0 分) 查看完整评论
Copyright © 2005-2010 fyf8.com. All Rights Reserved .
页面执行时间:307,890.60000 毫秒
 鲁ICP备06013895号