'************************************************** 
  '函數(shù)ID：0002[過(guò)濾html] 
  '函數(shù)名：GlHtml 
  '作 用：過(guò)濾html 元素 
  '參 數(shù)：str ---- 要過(guò)濾字符 
  '返回值：沒(méi)有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 
  '************************************************** 
  '函數(shù)ID：0003[打開(kāi)任意數(shù)據(jù)表并顯示表結(jié)構(gòu)及內(nèi)容] 
  '函數(shù)名：OpOtherDB 
  '作 用：打開(kāi)任意數(shù)據(jù)表并顯示表結(jié)構(gòu)及內(nèi)容 
  '參 數(shù)：DBtheStr ---- 要打開(kāi)表的數(shù)據(jù)庫(kù)鏈接字串 
  '參 數(shù)：Opentdname ---- 要打開(kāi)表名 
  '返回值：顯示表結(jié)構(gòu)及內(nèi)容 
  '************************************************** 
  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 
  '************************************************** 
  '函數(shù)ID：0004[讀取兩種路徑] 
  '函數(shù)名：Readsyspath 
  '作 用：讀取路徑 
  '參 數(shù)：lx ---- 0:服務(wù)器IP加路徑 1:服務(wù)物理路徑 
  '返回值：路徑字串 
  '************************************************** 
  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 
  '************************************************** 
  '函數(shù)ID：0005[測(cè)試某個(gè)文件存在否] 
  '函數(shù)名：CheckFile 
  '作 用：測(cè)試某個(gè)文件存在否 
  '參 數(shù)：ckFilename ---- 被測(cè)試的文件名（包括路徑） 
  '返回值：文件存在返回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 
  '************************************************** 
  '函數(shù)ID：0006[刪除某個(gè)文件] 
  '函數(shù)名：DelFile 
  '作 用：刪除某個(gè)文件 
  '參 數(shù)：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 
  '************************************************** 
  '函數(shù)ID：0007[判斷目錄是否存在] 
  '函數(shù)名：CheckDir 
  '作 用：判斷目錄是否存在 
  '參 數(shù)：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 
  '************************************************** 
  '函數(shù)ID：0008[創(chuàng)建目錄](méi) 
  '函數(shù)名：CreateDir 
  '作 用：創(chuàng)建目錄 
  '參 數(shù)：crDirname ---- 目錄名（包括路徑） 
  '返回值：目錄創(chuàng)建成功返回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 
  '************************************************** 
  '函數(shù)ID：0009[刪除目錄](méi) 
  '函數(shù)名：DelDir 
  '作 用：刪除目錄 
  '參 數(shù)：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 
  '************************************************** 
  '函數(shù)ID：0010[指定目錄的文件列表] 
  '函數(shù)名：ListFiles 
  '作 用：指定目錄的文件列表 
  '參 數(shù)：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

最新評(píng)論