ASP函数库

　　ASP函数库
　　%
　　''''                   函数目录                    ''''
　　''''-----------------------------------------------''''
　　'''' 函数ID：0001[截字符串]                        ''''
　　'''' 函数ID：0002[过滤html]                        ''''
　　'''' 函数ID：0003[打开任意数据表并显示表结构及内容]''''
　　'''' 函数ID：0004[读取两种路径]                    ''''
　　'''' 函数ID：0005[测试某个文件存在否]              ''''
　　'''' 函数ID：0006[删除某个文件]                    ''''
　　'''' 函数ID：0007[判断目录是否存在]                ''''
　　'''' 函数ID：0008[创建目录]                        ''''
　　'''' 函数ID：0009[删除目录]                        ''''
　　'''' 函数ID：0010[指定目录的文件列表]              ''''
　　'''' 函数ID：0011[指定目录的目录列表]              ''''
　　'''' 函数ID：0012[创建文本文件]                    ''''
　　'''' 函数ID：0013[读取文本文件]                    ''''
　　'''' 函数ID：0014[检测ID是否为数字类型]            ''''
　　'''' 函数ID：0015[正则表达式测试]                  ''''
　　'''' 函数ID：0016[获得执行程序的名称]              ''''
　　'''' 函数ID：0017[读取用户IP地址信息]              ''''
　　'''' 函数ID：0018[上传文件到指定目录并改文件名称]  ''''
　　'''' 函数ID：0019[过滤HTML脚本]                    ''''
　　'''' 函数ID：0020[创建MsAccess数据库]              ''''
　　'''' 函数ID：0021[创建MsSQLServer数据库]           ''''
　　'''' 函数ID：0022[通过JMAIL发信]                   ''''
　　'''' 函数ID：0023[测试组件是否安装]                ''''
　　'''' 函数ID：0024[上传文件的窗口]                  ''''
　　'''' 函数ID：0025[取得数据库链接字串]              ''''
　　'''' 函数ID：0026[取得multipart/form-data形式上传文件]
　　'''' 函数ID：0027[保存或查看上传到数据库中的数据，带调用上传窗口]
　　'''' 函数ID：0028[取得图像的类型|宽|高]            ''''
　　'''' 函数ID：0029[将本地文件进行二进制分析，并保存到服务器的指定目录下]
　　'''' 函数ID：0030[将本地数据表或库上传并导入到服务器数据库的表中]
　　'''' 函数ID：0031[返回服务器信息]                  ''''
　　'''' 函数ID：0032[产生20位长度的唯一标识ID]        ''''
　　'''' 函数ID：0033[用于左填充指定数量的字符]        ''''
　　'''' 函数ID：0034[用于右填充指定数量的字符]        ''''
　　'''' 函数ID：0035[格式化时间(显示)]                ''''
　　'''' 函数ID：0036[测试数据库是否存在]              ''''
　　'''' 函数ID：0037[测试数据库中的表是否存在]        ''''
　　'''' 函数ID：0038[在线HTML编辑器]                  ''''
　　'''' 函数ID：0039[判断是否奇数]                    ''''
　　'''' 函数ID：0040[生成验证码图像BMP]               ''''
　　'''' 函数ID：0041[生成随机密码]                    ''''
　　'''' 函数ID：0042[字符加解密]                      ''''
　　'''' 函数ID：0043[解密字符加解密]                  ''''
　　'''' 函数ID：0044[创建数据表]                      ''''
　　'''' 函数ID：0045[在数据库中插入字段值]            ''''
　　'''' 函数ID：0046[Cookie防乱码写入时用]            ''''
　　'''' 函数ID：0047[Cookie防乱码读出时用]            ''''
　　'''' 函数ID：0048[检测用户名和密码是否正确]        ''''
　　'''' 函数ID：0049[生成时间的整数]                  ''''
　　'''' 函数ID：0050[获得栏目的所有子栏目字符串并用","隔开]
　　''''                                               ''''
　　''''                                               ''''
　　''''                                               ''''
　　'**************************************************''''
　　'函数ID：0001[截字符串]
　　'函数名：SubstZFC
　　'作 用：截字符串，汉字一个算两个字符，英文算一个字符
　　'参 数：str   ----原字符串
　　'       strlen ----截取长度
　　'返回值：截取后的字符串
　　'**************************************************
　　Public Function SubstZFC(ByVal str, ByVal strlen)
　　    If str = "" Then
　　        SubstZFC = ""
　　        Exit Function
　　    End If
　　    Dim l, t, c, i, strTemp
　　    str = Replace(Replace(Replace(Replace(str, " ", " "), """, Chr(34)), ">", ""), "<", "")
　　    l = Len(str)
　　    t = 0
　　    strTemp = str
　　    strlen = CLng(strlen)
　　    For i = 1 To l
　　        c = Abs(Asc(Mid(str, i, 1)))
　　        If c 255 Then
　　            t = t + 2
　　        Else
　　            t = t + 1
　　        End If
　　        If t = strlen Then
　　            strTemp = Left(str, i)
　　            Exit For
　　        End If
　　    Next
　　    SubstZFC = Replace(Replace(Replace(Replace(strTemp, " ", " "), Chr(34), """), "", ">"), "", "<")
　　End Function
　　'**************************************************
　　'函数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 (temptbi2) 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
　　'**************************************************
　　'函数ID：0011[指定目录的目录列表]
　　'函数名：ListDirs
　　'作 用：指定目录的目录列表
　　'参 数：Dirname ----  目录名（包括路径）
　　'返回值：目录列表字符串，之间用“|”相隔
　　'**************************************************
　　Public Function ListDirs(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.SubFolders
　　     For Each FnamesN in fLS
　　         Fnames=Fnames & FnamesN.name
　　         Fnames=Fnames & "|"
　　     Next
　　     ListDirs=Fnames
　　  End If
　　  Set M_fso = Nothing
　　End Function
　　'**************************************************
　　'函数ID：0012[创建文本文件]
　　'函数名：WritTextFile
　　'作 用：创建文本文件
　　'参 数：Fname      ----  文本文件名称（包括路径）
　　'参 数：WritString ----  写入的内容
　　'返回值：创建成功返回True，否则False
　　'**************************************************
　　Public Function WritTextFile(ByVal Fname,ByVal WritString)
　　  Dim M_fso,FnameN
　　  WritTextFile=False
　　  Set M_fso = CreateObject("Scripting.FileSystemObject")
　　  Set FnameN= M_fso.OpenTextFile(Fname,2,True)
　　  FnameN.Write WritString
　　  FnameN.Close
　　  Set M_fso = Nothing
　　  WritTextFile=True
　　End Function
　　'**************************************************
　　'函数ID：0013[读取文本文件]
　　'函数名：ReadTextFile
　　'作 用：读取文本文件
　　'参 数：Fname ----  文本文件名称（包括路径）
　　'返回值：返回读取的文本内容
　　'**************************************************
　　Public Function ReadTextFile(ByVal Fname)
　　  Dim M_fso,FnameN,Fnr
　　  ReadTextFile=""
　　  Set M_fso = CreateObject("Scripting.FileSystemObject")
　　  Set FnameN= M_fso.OpenTextFile(Fname,1,True)
　　  Fnr=FnameN.ReadAll
　　  FnameN.Close
　　  Set M_fso = Nothing
　　  ReadTextFile=Fnr
　　End Function
　　'**************************************************
　　'函数ID：0014[检测ID是否为数字类型]
　　'函数名：JCID
　　'作 用：检测ID是否为数字类型
　　'参 数：ParaValue ---- 被检测的ID值
　　'返回值：返回ID值，如果不为数字类型返回0
　　'**************************************************
　　Public Function JCID(ByVal ParaValue)
　　  If ((Not isNumeric(ParaValue)) OR (Trim(ParaValue)="")) Then
　　     JCID=0
　　  Else
　　     JCID=ParaValue
　　  End If
　　End function
　　'**************************************************
　　'函数ID：0015[正则表达式测试]
　　'函数名：CheckExp
　　'作 用：正则表达式测试
　　'参 数：patrn ---- 正则表达式
　　'参 数：strng ---- 要测试的字符串
　　'返回值：测试如果成立返回 True 否则 False
　　'例 CheckExp("(.[^]*)","br")
　　'**************************************************
　　Public Function CheckExp(ByVal patrn, ByVal strng)
　　  Dim regEx, retVal
　　  Set regEx = New RegExp
　　  regEx.Pattern = patrn
　　  regEx.IgnoreCase = False
　　  retVal = regEx.Test(strng)
　　  CheckExp = retVal
　　End Function
　　'**************************************************
　　'函数ID：0016[获得执行程序的名称]
　　'函数名：GT_the_proname
　　'作 用：获得执行程序的名称
　　'参 数：
　　'返回值：返回执行程序的名称
　　'**************************************************
　　Public Function GT_the_proname()
　　  Dim fu_name,temp,tempsiz
　　  temp=Request.ServerVariables("PATH_INFO")
　　  fu_name=Split(temp, "/", -1, 1)
　　  tempsiz=UBound(fu_name)
　　  GT_the_proname=fu_name(tempsiz)
　　End function
　　'**************************************************
　　'函数ID：0017[读取用户IP地址信息]
　　'函数名：Readusip
　　'作 用：读取用户IP地址信息
　　'参 数：
　　'返回值：返回用户IP地址
　　'**************************************************
　　Public Function Readusip()
　　  Dim strIPAddr
　　  If Request.ServerVariables("HTTP_X_FORWARDED_FOR") = "" OR InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), "unknown") 0 Then
　　      strIPAddr = Request.ServerVariables("REMOTE_ADDR")
　　  ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",") 0 Then
　　      strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",")-1)
　　  ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";") 0 Then
　　      strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";")-1)
　　  Else
　　      strIPAddr = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
　　  End If
　　  Readusip = Trim(Mid(strIPAddr, 1, 30))
　　End Function
　　'**************************************************
　　'函数ID：0018[无组件上传文件到指定目录并改文件名称]
　　'函数名：UpFsRn
　　'作 用：无组件上传文件到指定目录并更改文件名称
　　'参 数：RetSize--- 上传限止大小（单位是M）
　　'参 数：Fdir  ---- 目标路径
　　'参 数：Objwj ---- 目标文件名称
　　'返回值：如果成功 True 否则 False
　　'例 UpFsRn(10,Readsyspath(1)&"zfkhauto","test.txt")
　　'使用表单提取文件 form method='POST' action='function.asp' enctype='multipart/form-data'input type='file' name='T1'input type='submit' value='提交' name='B1'/form
　　'**************************************************
　　Public Function UpFsRn(ByVal RetSize,ByVal Fdir,ByVal Objwj)
　　  UpFsRn=False
　　  Dim oUpStream,oStream,formsize,Formdata,strFileName,strFileDir,ObjAllPath,datastart,dataend
　　  strFileDir  = Fdir
　　  strFileName = Swj
　　  ObjAllPath  = ""
　　  If Right(strFileDir,1)"" Then strFileDir=strFileDir&""
　　  ObjAllPath  =strFileDir&Objwj
　　  If CheckFile(ObjAllPath) Then DelFile(ObjAllPath)
　　  formsize=Request.TotalBytes
　　  if (formsize=(RetSize*1024*1024)) then
　　     Formdata=Request.BinaryRead(formsize)
　　     Pos_ts=LenB(getByteString(Chr(13) & Chr(10) & Chr(13) & Chr(10)))
　　     Pos_b=InstrB(Formdata,getByteString(Chr(13) & Chr(10) & Chr(13) & Chr(10)))+Pos_ts
　　     nFormdata=MidB(Formdata,Pos_b)
　　     Pos_ts=InstrB(nFormdata,getByteString(Chr(13) & Chr(10) & "--"))
　　     nnFormdata=MidB(nFormdata,Pos_ts)
　　     Pos_e=LenB(Formdata)-LenB(nnFormdata)-Pos_b+1
　　     datastart =Pos_b
　　     dataend=Pos_e
　　     set oUpStream = Server.CreateObject("adodb.stream")
　　     oUpStream.Type = 1
　　     oUpStream.Mode = 3
　　     oUpStream.Open
　　     set oStream = Server.CreateObject("adodb.stream")
　　     oStream.Type = 1
　　     oStream.Mode = 3
　　     oStream.Open
　　     oUpStream.Write Formdata
　　     oUpStream.position=datastart-1
　　     oUpStream.copyto oStream,dataend
　　     oStream.SaveToFile ObjAllPath,2
　　     oStream.Close
　　     set oStream=nothing
　　     UpFsRn=True
　　  End If
　　End function
　　'**************************************************
　　'函数ID：0019[过滤HTML脚本]
　　'函数名：FilterJS
　　'作 用：过滤HTML脚本
　　'参 数：strHTML ---- 被检测的HTML字串
　　'返回值：返回过滤后的HTML
　　'**************************************************
　　Function FilterJS(ByVal strHTML)
　　  Dim objReg,strContent 
　　  If IsNull(strHTML) OR strHTML="" Then Exit Function 
　　  Set objReg=New RegExp
　　  objReg.IgnoreCase =True
　　  objReg.Global=True
　　  objReg.Pattern="(&#)"
　　  strContent=objReg.Replace(strHTML,"")
　　  objReg.Pattern="(function|meta|value|window.|script|js:|about:|file:|Document.|vbs:|frame|cookie)"
　　  strContent=objReg.Replace(strContent,"")
　　  objReg.Pattern="(on(finish|mouse|Exit=|error|click|key|load|focus|Blur))"
　　  strContent=objReg.Replace(strContent,"")
　　  FilterJS=strContent
　　  strContent=""
　　  Set objReg=Nothing 
　　End Function
　　'**************************************************
　　'函数ID：0020[创建MsAccess数据库]
　　'函数名：CrDb_MsAccess
　　'作 用：创建MsAccess数据库
　　'参 数：DbPath     ---- 目标目录信息
　　'参 数：DbFileName ---- 目标库文件名称
　　'参 数：DbUpwd     ---- 目标库打开密码
　　'返回值：建立成功返回 True 否则 False
　　'**************************************************
　　Public Function CrDb_MsAccess(ByVal DbPath,ByVal DbFileName,ByVal DbUpwd)
　　  CrDb_MsAccess=False
　　  On Error GoTo 0
　　  On Error Resume Next
　　  DIM fxztxt,fu_fu_db_str,fu_db_str
　　  fxztxt=Chr(60)&"%Response.end()%"&Chr(62)
　　  If Right(DbPath,1)"" Then DbPath=DbPath & ""
　　  fu_fu_db_str="Provider=Microsoft.Jet.OLEDB.4.0;Data Source="&DbPath&"temp.mdb;"
　　  fu_db_str     ="Provider=Microsoft.Jet.OLEDB.4.0;Data Source="&DbPath&DbFileName&";Jet OLEDB:Database Password="&DbUpwd&";"
　　  Set fu_Ca = Server.CreateObject("ADOX.Catalog")
　　  fu_Ca.Create fu_fu_db_str
　　  Set fu_Ca = Nothing
　　  Set fu_Je = Server.CreateObject("JRO.JetEngine")
　　  fu_Je.CompactDatabase fu_fu_db_str,fu_db_str
　　  Set fu_fso = CreateObject("Scripting.FileSystemObject")
　　  fu_fso.DeleteFile(DbPath&"temp.mdb")
　　  Set fu_Je   = Nothing
　　  Set fu_fso  = Nothing
　　  set fu_Conn =server.createobject("ADODB.Connection")
　　  set fu_Rs   =server.createobject("ADODB.Recordset")
　　  fu_Conn.open fu_db_str
　　  fu_Sql_Str="CREATE TABLE [0] ([0] Text DEFAULT Notxt NOT NULL,[11] int IDENTITY (1, 1) NOT NULL PRIMARY KEY)"
　　  fu_Conn.Execute(fu_Sql_Str)
　　  fu_Sql_Str="Select * From [0]"
　　  fu_Rs.open fu_Sql_Str,fu_Conn,1,3
　　  fu_Rs.addnew
　　  fu_Rs("0")=fxztxt
　　  fu_Rs.update
　　  fu_Rs.Close
　　  fu_Conn.Close
　　  Set fu_Rs = Nothing
　　  Set fu_Conn = Nothing
　　  If Err.Number = 0 Then
　　     CrDb_MsAccess=True
　　  End If
　　  On Error GoTo 0
　　End function
　　'**************************************************
　　'函数ID：0021[创建MsSQLServer数据库]
　　'函数名：CrDb_MsSQLServer
　　'作 用：创建MsSQLServer数据库
　　'参 数：DbIp   ---- 数据库所在IP或主机名称
　　'参 数：DbSamc ---- 数据库超管用户名称
　　'参 数：DbSapwd---- 数据库超管用户口令
　　'参 数：DbName ---- 新建数据库名称
　　'参 数：DbUpmc ---- 新建数据库所属用户名称
　　'参 数：DbUpwd ---- 新建数据库所属用户密码
　　'返回值：建立成功返回 True 否则 False
　　'**************************************************
　　Public Function CrDb_MsSQLServer(ByVal DbIp,ByVal DbSamc,ByVal DbSapwd,ByVal DbName,ByVal DbUpmc,ByVal DbUpwd)
　　  CrDb_MsSQLServer=False
　　  On Error GoTo 0
　　  On Error Resume Next
　　  DIM fu_Sa_Str,fu_Ua_Str,fu_Conn,fu_Rs,fu_Sql_Str,fxztxt
　　  fxztxt=Chr(60)&"%Response.end()%"&Chr(62)
　　  fu_Sa_Str  ="DRIVER=SQL Server;UID="&DbSamc&";DATABASE=master;SERVER="&DbIp&";PWD="&DbSapwd&";"
　　  fu_Ua_Str  ="DRIVER=SQL Server;UID="&DbUpmc&";DATABASE="&DbName&";SERVER="&DbIp&";PWD="&DbUpwd&";"
　　  Set fu_Conn = Server.CreateObject("ADODB.Connection")
　　  fu_Conn.Open fu_Sa_Str
　　  fu_Conn.Execute "CREATE DATABASE " &DbName
　　  fu_Conn.Close
　　  fu_DB_Conn_Str="DRIVER=SQL Server;UID="&DbSamc&";DATABASE="&DbName&";SERVER="&DbIp&";PWD="&DbSapwd&";"
　　  fu_Conn.Open fu_DB_Conn_Str
　　  fu_Sql_Str="EXEC sp_addlogin '"&DbUpmc&"','"&DbUpwd&"','"&DbName&"'"
　　  fu_Conn.Execute fu_Sql_Str
　　  fu_Sql_Str="EXEC sp_grantdbaccess '"&DbUpmc&"'"
　　  fu_Conn.Execute fu_Sql_Str
　　  fu_Sql_Str="EXEC sp_addrolemember 'db_owner', '"&DbUpmc&"'"
　　  fu_Conn.Execute fu_Sql_Str
　　  fu_Sql_Str="EXEC sp_defaultdb "&DbUpmc&","&DbName
　　  fu_Conn.Execute fu_Sql_Str
　　  fu_Conn.Close
　　  fu_Conn.open fu_Ua_Str
　　  fu_Sql_Str="CREATE TABLE [0] ([0] Text DEFAULT ('Notxt') NOT NULL,[11] int IDENTITY (1, 1) NOT NULL PRIMARY KEY)"
　　  fu_Conn.Execute fu_Sql_Str
　　  Set fu_Rs=server.createobject("ADODB.Recordset")
　　  fu_Sql_Str="Select * From [0]"
　　  fu_Rs.open fu_Sql_Str,fu_Conn,1,3
　　  fu_Rs.addnew
　　  fu_Rs("0")=fxztxt
　　  fu_Rs.update
　　  fu_Rs.Close
　　  fu_Conn.Close
　　  Set fu_Rs = Nothing
　　  Set fu_Conn=Nothing
　　  If Err.Number = 0 Then
　　     CrDb_MsSQLServer=True
　　  End If
　　  On Error GoTo 0
　　End function
　　'**************************************************
　　'函数ID：0022[通过JMAIL发信]
　　'函数名：MSMail
　　'作 用：通过JMAIL发信
　　'参 数：subject      ---- 邮件的标题
　　'参 数：mailaddress  ---- 邮件服务器地址
　　'参 数：senderName   ---- 发件人名称
　　'参 数：email        ---- 收件人E-MAIL地址
　　'参 数：content      ---- 邮件内容
　　'参 数：fromer       ---- 发件人E-MAIL地址
　　'参 数：serEmailUser ---- 邮件服务器权限用户名
　　'参 数：serEmailPass ---- 邮件服务器权限用户密码
　　'返回值：发送成功返回 True 否则 False
　　'示 例：MSMail("test","smtp.163.com","mzy","mzymcm@yahoo.com.cn","test","mzymcm@163.com","mzymcm","abcmzy1029abc")
　　'**************************************************
　　Public Function MSMail(ByVal subject, ByVal mailaddress, ByVal senderName, ByVal email, ByVal content, ByVal fromer, ByVal serEmailUser, ByVal serEmailPass)
　　  dim JmailMsg
　　  MSMail=False
　　  set JmailMsg=server.createobject("jmail.message")
　　  JmailMsg.mailserverusername=serEmailUser
　　  JmailMsg.mailserverpassword=serEmailPass
　　  JmailMsg.addrecipient email
　　  JmailMsg.from=fromer
　　  JmailMsg.fromname=senderName
　　  JmailMsg.charset="gb2312"
　　  JmailMsg.logging=true
　　  JmailMsg.silent=true
　　  JmailMsg.subject=Subject
　　  JmailMsg.body=Server.HTMLEncode(content)
　　  JmailMsg.htmlbody=content
　　  if not JmailMsg.send(mailaddress) then
　　      MSMail=False
　　  else
　　      MSMail=True
　　  end if
　　  JmailMsg.close
　　  set JmailMsg=nothing
　　End function
　　'**************************************************
　　'函数ID：0023[测试组件是否安装]
　　'函数名：IsObjInstalled
　　'作 用：测试组件是否安装
　　'参 数：strClassString ---- 组件名称或标识字串
　　'返回值：测试成功返回 True 否则 False
　　'示 例：IsObjInstalled("JMAIL.Message")
　　'**************************************************
　　Public Function IsObjInstalled(ByVal 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
　　'**************************************************
　　'函数名：GetObjVer
　　'作 用：返回组件版本信息
　　'参 数：strClassString ---- 组件名称或标识字串
　　'返回值：返回组件版本信息字串
　　'示 例：GetObjVer("JMAIL.Message")
　　'**************************************************
　　Public Function GetObjVer(ByVal strClassString)
　　  On Error Resume Next
　　  GetObjVer=""
　　  Err = 0
　　  Dim xTestObj
　　  Set xTestObj = Server.CreateObject(strClassString)
　　  If 0 = Err Then GetObjVer=xtestobj.version
　　  Set xTestObj = Nothing
　　  Err = 0
　　End Function
　　'**************************************************
　　'函数名：ListObjInfo
　　'作 用：列出组件安装信息
　　'参 数： ----
　　'返回值：列出组件安装信息
　　'示 例：ListObjInfo()
　　'**************************************************
　　Public Function ListObjInfo()
　　  Dim TempBs,TempBsXX,TempObjType,tmpObjs
　　  TempBs="×"
　　  TempBsXX=""
　　  TempObjType=""
　　  tmpObjs=""
　　  tmpObjs=tmpObjs& "JMail.Message|"
　　  tmpObjs=tmpObjs& "ADODB.Stream|"
　　  tmpObjs=tmpObjs& "MSWC.AdRotator|"
　　  tmpObjs=tmpObjs& "MSWC.BrowserType|"
　　  tmpObjs=tmpObjs& "MSWC.NextLink|"
　　  tmpObjs=tmpObjs& "MSWC.Tools|"
　　  tmpObjs=tmpObjs& "MSWC.Status|"
　　  tmpObjs=tmpObjs& "MSWC.Counters|"
　　  tmpObjs=tmpObjs& "MSWC.PermissionChecker|"
　　  tmpObjs=tmpObjs& "Scripting.FileSystemObject|"
　　  tmpObjs=tmpObjs& "adodb.connection|"
　　  tmpObjs=tmpObjs& "SoftArtisans.FileUp|"
　　  tmpObjs=tmpObjs& "SoftArtisans.FileManager|"
　　  tmpObjs=tmpObjs& "CDONTS.NewMail|"
　　  tmpObjs=tmpObjs& "Persits.MailSender|"
　　  tmpObjs=tmpObjs& "LyfUpload.UploadFile|"
　　  tmpObjs=tmpObjs& "Persits.Upload.1|"
　　  tmpObjs=tmpObjs& "w3.upload|"
　　  tmpObjs=Split(tmpObjs,"|")
　　  Response.write "centertable border='1' bordercolor='#000000' cellspacing='0' cellpadding='0' style='font-size: 9pt;""宋体'trtd width='33%' valign='middle' align='center' style='border-left: 1 solid #808080; border-right: 1 solid #FFFFFF; border-top: 1 solid #FFFFFF; border-bottom: 1 solid #808080; padding-left: 2; padding-right: 2; padding-top: 1; padding-bottom: 1'组件标识/tdtd width='33%' valign='middle' align='center' style='border-left: 1 solid #808080; border-right: 1 solid #FFFFFF; border-top: 1 solid #FFFFFF; border-bottom: 1 solid #808080; padding-left: 2; padding-right: 2; padding-top: 1; padding-bottom: 1'√|×/tdtd width='34%' valign='middle' align='center' style='border-left: 1 solid #808080; border-right: 1 solid #FFFFFF; border-top: 1 solid #FFFFFF; border-bottom: 1 solid #808080; padding-left: 2; padding-right: 2; padding-top: 1; padding-bottom: 1'版本/td/tr" & vbCrlf
　　  For i = LBound(tmpObjs) To UBound(tmpObjs)
　　      If Trim(tmpObjs(i))"" Then
　　         If IsObjInstalled(tmpObjs(i)) Then
　　            TempObjType=tmpObjs(i)
　　            TempBs="√"
　　            TempBsXX=GetObjVer(tmpObjs(i))
　　            If TempBsXX="" Then TempBsXX=" "
　　         Else
　　            TempObjType="font color='#800000'"&tmpObjs(i)&"/font"
　　            TempBs="font color='#800000'×/font"
　　            TempBsXX=" "
　　         End If
　　         Response.write "tr" & vbCrlf
　　         Response.write "td valign='middle' style='border-left: 1 solid #808080; border-right: 1 solid #FFFFFF; border-top: 1 solid #FFFFFF; border-bottom: 1 solid #808080; padding-left: 2; padding-right: 2; padding-top: 1; padding-bottom: 1'"&TempObjType&"/td" & vbCrlf
　　         Response.write "td valign='middle' align='center' style='border-left: 1 solid #808080; border-right: 1 solid #FFFFFF; border-top: 1 solid #FFFFFF; border-bottom: 1 solid #808080; padding-left: 2; padding-right: 2; padding-top: 1; padding-bottom: 1'"&TempBs&"/td" & vbCrlf
　　         Response.write "td valign='middle' align='center' style='border-left: 1 solid #808080; border-right: 1 solid #FFFFFF; border-top: 1 solid #FFFFFF; border-bottom: 1 solid #808080; padding-left: 2; padding-right: 2; padding-top: 1; padding-bottom: 1'"&TempBsXX&"/td" & vbCrlf
　　         Response.write "/tr" & vbCrlf
　　      End If
　　  Next
　　  Response.write "/table/center" & vbCrlf
　　End Function
　　'**************************************************
　　'函数ID：0024[上传文件的窗口]
　　'函数名：PosImageWin
　　'作 用：上传选择文件窗口，可自动提取文件名及类型
　　'参 数：PfUrlstr ---- 处理二进制文件信息的URL地址
　　'返回值：网页HTML文件
　　'示 例：库结构例子 CREATE TABLE [IMAGES]  ([ID] int IDENTITY (1,1) NOT NULL PRIMARY KEY,[MC]  varchar(50),[LX] varchar(20),[MEM] Text,[IMGS] image)
　　'**************************************************
　　Public Function PosImageWin(ByVal PfUrlstr)
　　  PosImageWin=""
　　  PosImageWin=PosImageWin &  "centertable border='0' width='0' cellspacing='0' cellpadding='0' style='font-size: 9pt'" & vbCrlf
　　  PosImageWin=PosImageWin &  "SCRIPT LANGUAGE=JAVASCRIPT"&vbCrlf
　　  PosImageWin=PosImageWin &  "function ckfilelx(){"&vbCrlf
　　  PosImageWin=PosImageWin &  "tempwjm=POFile.ImageFs.value;"&vbCrlf
　　  PosImageWin=PosImageWin &  "fgwjm=tempwjm.split('.');"&vbCrlf
　　  PosImageWin=PosImageWin &  "newwjm=fgwjm.reverse();"&vbCrlf
　　  PosImageWin=PosImageWin &  "POMem.ImageType.value=newwjm[0].toUpperCase();"&vbCrlf
　　  PosImageWin=PosImageWin &  "tempwjm=newwjm[1].toUpperCase();"&vbCrlf
　　  PosImageWin=PosImageWin &  "fgwjm=tempwjm.split('');"&vbCrlf
　　  PosImageWin=PosImageWin &  "newwjm=fgwjm.reverse();"&vbCrlf
　　  PosImageWin=PosImageWin &  "POMem.ImageName.value=newwjm[0].toUpperCase();"&vbCrlf
　　  PosImageWin=PosImageWin &  "POMem.ImageReadme.value=newwjm[0].toUpperCase();"&vbCrlf
　　  PosImageWin=PosImageWin &  "}"&vbCrlf
　　  PosImageWin=PosImageWin &  "function Reedit(){POFile.reset();POMem.reset();}"&vbCrlf
　　  PosImageWin=PosImageWin &  "function PostDo(){if (POFile.ImageFs.value==''){alert('没有选择文件哟！');}else{bc.innerHTML='正在上传，请稍后...';POFile.action=POFile.action+'&mc='+POMem.ImageName.value+'&lx='+POMem.ImageType.value+'&mem='+POMem.ImageReadme.value;bc.style.visibility='visible';ReEd.disabled=true;PoSe.disabled=true;POFile.submit();POFile.ImageFs.disabled=true;}}"&vbCrlf
　　  PosImageWin=PosImageWin &  "/SCRIPT"&vbCrlf
　　  PosImageWin=PosImageWin &  "trform method='POST' name='POFile' enctype='multipart/form-data' ACTION='"&PfUrlstr&"' target='tempa'td width='100%' valign='middle'" & vbCrlf
　　  PosImageWin=PosImageWin &  "选择文件：input type='file' name='ImageFs' ONCHANGE='ckfilelx();' style='font-size: 9pt;width:300;'" & vbCrlf
　　  PosImageWin=PosImageWin &  "/td/form/tr" & vbCrlf
　　  PosImageWin=PosImageWin &  "trform method='POST' name='POMem'td width='100%' valign='middle'" & vbCrlf
　　  PosImageWin=PosImageWin &  "文件ID号：input type='text' name='ImageID' ReadOnly  style='font-size: 9pt;width:300;'br" & vbCrlf
　　  PosImageWin=PosImageWin &  "文件名称：input type='text' name='ImageName'  style='font-size: 9pt;width:300;'br" & vbCrlf
　　  PosImageWin=PosImageWin &  "文件类型：input type='text' name='ImageType' ReadOnly style='font-size: 9pt;width:300;'br" & vbCrlf
　　  PosImageWin=PosImageWin &  "文件介绍：textarea rows='8' name='ImageReadme' cols='20' style='font-size: 9pt;width:300;'还没有/textarea" & vbCrlf
　　  PosImageWin=PosImageWin &  "/td/form/tr" & vbCrlf
　　  PosImageWin=PosImageWin &  "trtd width='100%' valign='middle' align='center'" & vbCrlf
　　  PosImageWin=PosImageWin &  "input type='button' value='重置' name='ReEd' OnClick='Reedit();'  input type='button' value='上传' name='PoSe' OnClick='PostDo();'" & vbCrlf
　　  PosImageWin=PosImageWin &  "/td/tr/table/centerdiv id='bc' name='bc' style='position: absolute; left: 45%; top:40%; z-index: 0;background-color: #EAEAEA;visibility: hidden;' valign='middle' align='center'/div" & vbCrlf
　　  PosImageWin=PosImageWin &  "iframe src='' ID='tempa' NAME='tempa' frameborder='0' width='0' height='0' style='width:0;Height:0;'" & vbCrlf
　　End Function
　　'**************************************************
　　'函数ID：0025[取得数据库链接字串]
　　'函数名：GetConnStr
　　'作 用：取得数据库链接字串，能生成MsAccess和MsSqlServer链接串
　　'参 数：Lx         ---- 0 是MsAccess , 1 是MsSqlServer
　　'参 数：Dbiporpath ---- 数据库IP或路径
　　'参 数：Dbmc       ---- 数据库名称
　　'参 数：Dbuid      ---- 数据库用户名称
　　'参 数：Dbupwd     ---- 数据库用户密码
　　'返回值：链接字串
　　'示 例：http://school.cnd8.com/
　　'**************************************************
　　Public Function GetConnStr(ByVal Lx,ByVal Dbiporpath,ByVal Dbmc,ByVal Dbuid,ByVal Dbupwd)
　　  GetConnStr=""
　　  If Lx=0 Then
　　     If Right(Dbiporpath,1)"" Then Dbiporpath=Dbiporpath & ""
　　     GetConnStr ="Provider=Microsoft.Jet.OLEDB.4.0;Data Source="&Dbiporpath&Dbmc&";Jet OLEDB:Database Password="&Dbupwd&";"
　　  End If
　　  If Lx=1 Then
　　     GetConnStr ="DRIVER=SQL Server;UID="&Dbuid&";DATABASE="&Dbmc&";SERVER="&Dbiporpath&";PWD="&Dbupwd&";"
　　  End If
　　End Function
　　'**************************************************
　　'函数ID：0026[取得multipart/form-data形式上传文件]
　　'函数名：GetImageData
　　'作 用：取得multipart/form-data形式上传文件
　　'参 数：MaxSize ---- 上传的限止大小,单位：M(兆)
　　'返回值：二进制数据
　　'示 例：
　　'**************************************************
　　Public Function GetImageData(ByVal MaxSize)
　　  GetImageData=""
　　  DIM formsize,Formdata,bncrlf,divider,datastart,dataend,mydata
　　  formsize=Request.TotalBytes
　　  if (formsize=(MaxSize*1024*1024)) then
　　     Formdata=Request.BinaryRead(formsize)
　　     Pos_ts=LenB(getByteString(Chr(13) & Chr(10) & Chr(13) & Chr(10)))
　　     Pos_b=InstrB(Formdata,getByteString(Chr(13) & Chr(10) & Chr(13) & Chr(10)))+Pos_ts
　　     nFormdata=MidB(Formdata,Pos_b)
　　     Pos_ts=InstrB(nFormdata,getByteString(Chr(13) & Chr(10) & "--"))
　　     nnFormdata=MidB(nFormdata,Pos_ts)
　　     Pos_e=LenB(Formdata)-LenB(nnFormdata)-Pos_b+1
　　     datastart =Pos_b
　　     dataend=Pos_e
　　     mydata=midb(Formdata,datastart,dataend)
　　  End If
　　  GetImageData=mydata
　　End Function
　　'''' 将字串转为二进制串
　　Function getByteString(StringStr)
　　  For i=1 to Len(StringStr)
　　      char=Mid(StringStr,i,1)
　　      getByteString=getByteString & chrB(AscB(char))
　　  Next
　　End function
　　'**************************************************
　　'函数ID：0027[保存或查看上传到数据库中的数据，带调用上传窗口]
　　'函数名：GoImgToDb
　　'作 用：保存或查看上传到数据库中的数据，带调用上传窗口
　　'参 数：PPLX       ---- 执行类型(空为保存，ID号为查看该ID的文件)
　　'参 数：PUrl       ---- 主执行程序的URL部份
　　'参 数：ConnStr    ---- 上传文件的数据库链接字串
　　'参 数：ImagTbname ---- 文件保存的数据表名称
　　'参 数：Did        ---- 文件ID字段名
　　'参 数：Dmc        ---- 文件名称字段名
　　'参 数：Dlx        ---- 文件类型字段名
　　'参 数：Dmem       ---- 文件说明字段名
　　'参 数：Ddata      ---- 文件的二进制数据的字段名
　　'参 数：MaxSize    ---- 上传的限止大小,单位：M(兆)
　　'参 数：IDLX       ---- 标识ID字段的类型 ( 0 字符型 1 数值(非自增量型) 2 数值型(自增量型)  )
　　'返回值：成功保存的JAVASCRIPT  注在非自动增量情况下标识字段长度应超过20个字符
　　'示 例：GoImgToDb("17","http://127.0.0.1/function.asp",GetConnStr(1,"127.0.0.1","temp","sa","mzy1029"),"img","id","mc","lx","mem","data",20)
　　'示 例：GoImgToDb("","http://127.0.0.1/function.asp",GetConnStr(1,"127.0.0.1","temp","sa","mzy1029"),"img","id","mc","lx","mem","data",20)
　　'**************************************************
　　Public Function GoImgToDb(ByVal PPLX,ByVal PUrl,ByVal ConnStr,ByVal ImagTbname,ByVal Did,ByVal Dmc,ByVal Dlx,ByVal Dmem,ByVal Ddata,ByVal MaxSize,ByVal IDLX)
　　  DIM Pjobs,Pjurl
　　  tempimg_conn_str=ConnStr
　　  Set fu_Conn=server.createobject("ADODB.Connection")
　　  Set fu_Rs=server.createobject("ADODB.Recordset")
　　  fu_Conn.open tempimg_conn_str
　　  If JCID(PPLX)=0 Then
　　     Pjobs=Request("img")
　　     If InStr(PUrl,"？")0 Then
　　        Pjurl=PUrl&"&img=sav"
　　     Else
　　        Pjurl=PUrl&"？img=sav"
　　     End If
　　     If Pjobs="" then Response.write PosImageWin(Pjurl)
　　     If Pjobs="sav" Then
　　        Sql_Str="SELECT "&Did&","&Dmc&","&Dlx&","&Dmem&","&Ddata&" FROM "&ImagTbname
　　        fu_Rs.open Sql_Str,fu_Conn,3,3
　　        fu_Rs.addnew
　　        If IDLX 2 Then
　　           fu_Rs(Did)  =MakeTheID()
　　        End If
　　        fu_Rs(Dmc)  =Request("mc")
　　        fu_Rs(Dlx)  =Request("lx")
　　        fu_Rs(Dmem) =Request("mem")
　　        fu_Rs(Ddata).AppendChunk GetImageData(JCID(MaxSize))
　　        fu_Rs.update
　　        fu_Rs.Close
　　        fu_Rs.open Sql_Str,fu_Conn,3,3
　　        fu_Rs.MoveLast
　　        Response.write "SCRIPT LANGUAGE=JAVASCRIPT"&vbCrlf
　　        Response.write "parent.POMem.ImageID.value='"&fu_Rs(Did)&"';"&vbCrlf
　　        Response.write "parent.bc.innerHTML='已成功保存数据!';"
　　        Response.write "/SCRIPT"&vbCrlf
　　      End If
　　  Else
　　     If IDLX 0 Then
　　        Sql_Str="SELECT "&Did&","&Dmc&","&Dlx&","&Dmem&","&Ddata&" FROM "&ImagTbname&" WHERE ("&Did&" ="&PPLX&")"
　　     Else
　　        Sql_Str="SELECT "&Did&","&Dmc&","&Dlx&","&Dmem&","&Ddata&" FROM "&ImagTbname&" WHERE ("&Did&" ='"&PPLX&"')"
　　     End If
　　     fu_Rs.open Sql_Str,fu_Conn,1,1
　　     If fu_Rs.RecordCount 0 Then
　　        tempaa=Trim(fu_Rs(Dlx))
　　        Response.Clear
　　        Response.Expires = -9999
　　        Response.AddHeader "pragma", "no-cache"
　　        Response.AddHeader "cache-ctrol", "no-cache"
　　        Response.Buffer = TRUE
　　        Response.AddHeader "Content-Disposition:","attachment;filename="&fu_Rs(Dmc)&"."&tempaa
　　        Response.ContentType="application/"&Trim(fu_Rs(Dlx))
　　        Response.Flush
　　        Response.BinaryWrite fu_Rs(Ddata)
　　        Response.End
　　     End If
　　  End If
　　  fu_Rs.Close
　　  fu_Conn.close
　　  Set fu_Rs = Nothing
　　  Set fu_Conn = Nothing
　　End Function
　　'**************************************************''''
　　'函数ID：0028[取得图像的类型|宽|高]
　　'函数名：GetImageDx
　　'作 用：取得图像的类型|宽|高
　　'参 数：filepath ---- 文件路径及文件命名
　　'返回值："类型|宽|高"
　　'************************