asp制作中常用到的函数库集合第2/8页

'************************************************** 
  '函数ID：0002[过滤html] 
  '函数名：GlHtml 
  '作 用：过滤html 元素 
  '参 数：str ---- 要过滤字符 
  '返回值：没有html 的字符 
  '************************************************** 
  Public Function GlHtml(ByVal str) 
   If IsNull(str) Or Trim(str) = "" Then 
   GlHtml = "" 
   Exit Function 
   End If 
   Dim re 
   Set re = New RegExp 
   re.IgnoreCase = True 
   re.Global = True 
   re.Pattern = "(\<.[^\<]*\>)" 
   str = re.Replace(str, " ") 
   re.Pattern = "(\<\/[^\<]*\>)" 
   str = re.Replace(str, " ") 
   Set re = Nothing 
   str = Replace(str, "'", "") 
   str = Replace(str, Chr(34), "") 
   GlHtml = str 
  End Function 
  '************************************************** 
  '函数ID：0003[打开任意数据表并显示表结构及内容] 
  '函数名：OpOtherDB 
  '作 用：打开任意数据表并显示表结构及内容 
  '参 数：DBtheStr ---- 要打开表的数据库链接字串 
  '参 数：Opentdname ---- 要打开表名 
  '返回值：显示表结构及内容 
  '************************************************** 
  Public Function OpOtherDB(ByVal DBtheStr,ByVal Opentdname) 
   Response.write "<table border='0' width='100%' cellspacing='0' cellpadding='0'>" & vbCrlf 
   Set Opdb_Conn=server.createobject("ADODB.Connection") 
   Set Opdb_Rs =server.createobject("ADODB.Recordset") 
   Opdb_Conn.open DBtheStr 
   Opdb_sql_str="select * from "&Opentdname 
   Opdb_Rs.open Opdb_Sql_Str,Opdb_Conn,1,1 
   Nfieldnumber=Opdb_Rs.Fields.count 
   If Nfieldnumber >0 then 
   Response.write "<tr>" & vbCrlf 
   For i=0 to (Nfieldnumber-1) 
   Response.write "<td style='border-style: ridge; border-width: 1' bgcolor='#E1E1E1' valign='middle' align='center'>" 
   Response.write Trim(Opdb_Rs.Fields(i).Name) 
   Response.write "</td>" & vbCrlf 
   Next 
   temptbi=0 
   Do While Not Opdb_Rs.Eof 
   Response.write "</tr>" & vbCrlf 
   For i=0 to (Nfieldnumber-1) 
   If (temptbi<2) Then 
   Response.write "<td style='border-style: ridge; border-width: 1' bgcolor='#F6F6F6' valign='middle'>" 
   Response.write Trim(Opdb_Rs.Fields(i)) 
   Response.write "</td>" & vbCrlf 
   temptbi=temptbi+1 
   Else 
   Response.write "<td style='border-style: ridge; border-width: 1' valign='middle'>" 
   Response.write Trim(Opdb_Rs.Fields(i)) 
   Response.write "</td>" & vbCrlf 
   If temptbi>=3 Then 
   temptbi=0 
   Else 
   temptbi=temptbi+1 
   End If 
   End If 
   Next 
   Opdb_Rs.MoveNext 
   Response.write "</tr>" & vbCrlf 
   Loop 
   End If 
   Opdb_Rs.Close 
   Opdb_Conn.Close 
   Set Opdb_Rs = Nothing 
   Set Opdb_Conn=Nothing 
   Response.write "</table>" & vbCrlf 
  End function 
  '************************************************** 
  '函数ID：0004[读取两种路径] 
  '函数名：Readsyspath 
  '作 用：读取路径 
  '参 数：lx ---- 0:服务器IP加路径 1:服务物理路径 
  '返回值：路径字串 
  '************************************************** 
  Public Function Readsyspath(ByVal lx) 
   Dim templj,aryTemp,newpath 
   templj="" 
   newpath="" 
   If lx=0 Then 
   templj="http://"&Request("SERVER_NAME")&Request("PATH_INFO") 
   aryTemp = Split(templj,"/") 
   Else 
   templj=Request("PATH_TRANSLATED") 
   aryTemp = Split(templj,"\") 
   End If 
   For i = LBound(aryTemp) To UBound(aryTemp)-1 
   If lx=0 Then 
   newpath=newpath&aryTemp(i)&"/" 
   Else 
   newpath=newpath&aryTemp(i)&"\" 
   End If 
   Next 
   Readsyspath=newpath 
  End Function 
  '************************************************** 
  '函数ID：0005[测试某个文件存在否] 
  '函数名：CheckFile 
  '作 用：测试某个文件存在否 
  '参 数：ckFilename ---- 被测试的文件名（包括路径） 
  '返回值：文件存在返回True,否则False 
  '************************************************** 
  Public Function CheckFile(ByVal ckFilename) 
   Dim M_fso 
   CheckFile=False 
   Set M_fso = CreateObject("Scripting.FileSystemObject") 
   If M_fso.FileExists(ckFilename) Then 
   CheckFile=True 
   End If 
   Set M_fso = Nothing 
  End Function 
  '************************************************** 
  '函数ID：0006[删除某个文件] 
  '函数名：DelFile 
  '作 用：删除某个文件 
  '参 数：dFilename ---- 被删除的文件名（包括路径） 
  '返回值：文件删除返回True,否则False 
  '************************************************** 
  Public Function DelFile(ByVal dFilename) 
   Dim M_fso 
   DelFile=False 
   Set M_fso = CreateObject("Scripting.FileSystemObject") 
   If M_fso.FileExists(dFilename) Then 
   M_fso.DeleteFile(dFilename) 
   DelFile=True 
   End If 
   Set M_fso = Nothing 
  End Function 
  '************************************************** 
  '函数ID：0007[判断目录是否存在] 
  '函数名：CheckDir 
  '作 用：判断目录是否存在 
  '参 数：ckDirname ---- 目录名（包括路径） 
  '返回值：目录存在返回True,否则False 
  '************************************************** 
  Public Function CheckDir(ByVal ckDirname) 
   Dim M_fso 
   CheckDir=False 
   Set M_fso = CreateObject("Scripting.FileSystemObject") 
   If (M_fso.FolderExists(ckDirname)) Then 
   CheckDir=True 
   End If 
   Set M_fso = Nothing 
  End Function 
  '************************************************** 
  '函数ID：0008[创建目录] 
  '函数名：CreateDir 
  '作 用：创建目录 
  '参 数：crDirname ---- 目录名（包括路径） 
  '返回值：目录创建成功返回True,否则False 
  '************************************************** 
  Public Function CreateDir(ByVal crDirname) 
   Dim M_fso 
   CreateDir=False 
   Set M_fso = CreateObject("Scripting.FileSystemObject") 
   If (M_fso.FolderExists(crDirname)) Then 
   CreateDir=False 
   Else 
   M_fso.CreateFolder(crDirname) 
   CreateDir=True 
   End If 
   Set M_fso = Nothing 
  End Function 
  '************************************************** 
  '函数ID：0009[删除目录] 
  '函数名：DelDir 
  '作 用：删除目录 
  '参 数：DlDirname ---- 目录名（包括路径） 
  '返回值：目录删除成功返回True,否则False 
  '************************************************** 
  Public Function DelDir(ByVal DlDirname) 
   Dim M_fso 
   DelDir=False 
   Set M_fso = CreateObject("Scripting.FileSystemObject") 
   If (M_fso.FolderExists(DlDirname)) Then 
   M_fso.DeleteFolder(DlDirname) 
   DelDir=True 
   End If 
   Set M_fso = Nothing 
  End Function 
  '************************************************** 
  '函数ID：0010[指定目录的文件列表] 
  '函数名：ListFiles 
  '作 用：指定目录的文件列表 
  '参 数：Dirname ---- 目录名（包括路径） 
  '返回值：文件列表字符串，之间用“|”相隔 
  '************************************************** 
  Public Function ListFiles(ByVal Dirname) 
   Dim M_fso,fNS,fLS,Fnames,FnamesN 
   Set M_fso = CreateObject("Scripting.FileSystemObject") 
   If (M_fso.FolderExists(Dirname)) Then 
   Set fNS = M_fso.GetFolder(Dirname) 
   Set fLS=fNS.Files 
   For Each FnamesN in fLS 
   Fnames=Fnames & FnamesN.name 
   Fnames=Fnames & "|" 
   Next 
   ListFiles=Fnames 
   End If 
   Set M_fso = Nothing 
  End Function

最新评论