asp函数库_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 (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
**************************************************
函数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 "<center><table border=1 bordercolor=#000000 cellspacing=0 cellpadding=0 style=font-size: 9pt;"">宋体><tr><td 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>组件标识</td><td 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>√|×</td><td 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 & "<center><table 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 & "<tr><form 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 & "<tr><form 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 & "<tr><td 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></center><div 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://www.knowsky.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 ---- 文件路径及文件命名
返回值："类型|宽|高"
**************************************************
Public Function GetImageDx(ByVal filepath)
DIM Tempsm,NBxx,WJXX(3)
SET Tempsm = Server.CreateObject("ADODB.Stream")
Tempsm.Mode=3
Tempsm.Type=1
Tempsm.Open
Tempsm.LoadFromFile filepath
NBxx=Hex(BinVal(Tempsm.Read(3)))
WJXX(0)=NBxx
WJXX(1)="0"
WJXX(2)="0"
If NBxx="464947" Then
     WJXX(0)="GIF"
     Tempsm.Read(3)
     WJXX(1)=BinVal(Tempsm.Read(2))
     WJXX(2)=BinVal(Tempsm.Read(2))
End If
If NBxx="FFD8FF" Then
     WJXX(0)="JPG"
     do
     do: p1=binVal(Tempsm.Read(1)): loop while p1=255 and not Tempsm.EOS
     if p1>191 and p1<196 then exit do else Tempsm.Read(binval2(Tempsm.Read(2))-2)
     do:p1=binVal(Tempsm.Read(1)):loop while p1<255 and not Tempsm.EOS
     loop while true
     Tempsm.Read(3)
     WJXX(2)=binval2(Tempsm.Read(2))
     WJXX(1)=binval2(Tempsm.Read(2))
End If
If Mid(NBxx,3)="4D42" Then
     Tempsm.Read(15)
     WJXX(0)="BMP"
     WJXX(1)=binval(Tempsm.Read(4))
     WJXX(2)=binval(Tempsm.Read(4))
End If
If NBxx="4E5089" Then
     WJXX(0)="PNG"
     Tempsm.Read(15)
     WJXX(1)=BinVal2(Tempsm.Read(2))
     Tempsm.Read(2)
     WJXX(2)=BinVal2(Tempsm.Read(2))
End If
If NBxx="535743" Then
     WJXX(0)="SWF"
     Tempsm.Read(5)
     binData=Tempsm.Read(1)
     sConv=Num2Str(ascb(binData),2 ,8)
     nBits=Str2Num(left(sConv,5),2)
     sConv=mid(sConv,6)
     while(len(sConv)<nBits*4)
        binData=Tempsm.Read(1)
        sConv=sConv&Num2Str(ascb(binData),2 ,8)
     wend
     WJXX(1)=int(abs(Str2Num(mid(sConv,1*nBits+1,nBits),2)-Str2Num(mid(sConv,0*nBits+1,nBits),2))/20)
     WJXX(2)=int(abs(Str2Num(mid(sConv,3*nBits+1,nBits),2)-Str2Num(mid(sConv,2*nBits+1,nBits),2))/20)
End If
Tempsm.Close
SET Tempsm=nothing
GetImageDx = WJXX(0)&"|"&WJXX(1)&"|"&WJXX(2)
End Function
Function BinVal(bin)
dim ret
ret = 0
for i = lenb(bin) to 1 step -1
      ret = ret *256 + ascb(midb(bin,i,1))
next
BinVal=ret
End Function
Function BinVal2(bin)
dim ret
ret = 0
for i = 1 to lenb(bin)
      ret = ret *256 + ascb(midb(bin,i,1))
next
BinVal2=ret
End Function
Function Str2Num(str,base)
dim ret
ret = 0
for i=1 to len(str)
      ret = ret *base + cint(mid(str,i,1))
next
Str2Num=ret
End Function
Function Num2Str(num,base,lens)
dim ret
ret = ""
while(num>=base)
ret = (num mod base) & ret
num = (num - num mod base)/base
wend
Num2Str = right(string(lens,"0") & num & ret,lens)
End Function
**************************************************
函数ID：0029[将本地文件进行二进制分析，并保存到服务器的指定目录下]
函数名：TxtBinInfo
作用：将本地文件进行二进制分析，并保存到服务器的指定目录下
参数：Filestr ---- 被分析文件路径及文件命名
参数：WebSvFile ---- 分析信息保存文件路径及文件命名
返回值：成功返回 True 否则 False
示例： TempSj=Request.Form("Tfile")
示例： If Trim(TempSj)<>"" Then CALL TxtBinInfo(TempSj,"d:\aa.txt")
示例： Response.write "<form method=POST action=test.asp><input type=file name=Tfile><input type=submit value=提交 name=B1></form>"
**************************************************
Public Function TxtBinInfo(ByVal Filestr,ByVal WebSvFile)
TxtBinInfo=False
DIM Wtempxx
Wtempxx=""
SET Tempsm = Server.CreateObject("ADODB.Stream")
Tempsm.Mode=3
Tempsm.Type=1
Tempsm.Open
Tempsm.LoadFromFile (Filestr)
tempRedImg=Tempsm.Read
for i = lenb(tempRedImg) to 1 step -1
      Wtempxx=Wtempxx& "地址号：" &i &"地址十六进制："& Hex(ascb(midb(tempRedImg,i,1))) &" 十进制："&ascb(midb(tempRedImg,i,1))&vbCrlf
next
Wtempxx=Wtempxx&vbCrlf&"大小："&lenb(tempRedImg)&"字节该文件名称为：" &Filestr
Set M_fso = CreateObject("Scripting.FileSystemObject")
Set FnameN= M_fso.OpenTextFile(WebSvFile,2,True)
FnameN.Write Wtempxx
FnameN.Close
Set M_fso = Nothing
Tempsm.Close
SET Tempsm=nothing
TxtBinInfo=True
End Function
**************************************************
函数ID：0030[将本地数据表或库上传并导入到服务器数据库的表中]
函数名：ReadCdbToServ
作用：将本地数据表或库上传并导入到服务器数据库的表中
参数：CdbFileUp ---- 被上传的库或表文件路径及文件名
参数：SdbConnStr ---- 服务器数据库链接字串
参数：SdbTbname ---- 服务器将打开的表名
参数：FildStrArr ---- 导入的数据字段串(各字段用","隔开)
返回值：成功返回 True 否则 False
注可导入的文件类型有(0:Excel 1:Access 2:Text 3:DBF/FoxPro)
注：Excel 的表为Sheet名称，文本及DBF/FoxPro的表名为数据文件的全名，如 aa.txt 或 aa.dbf
注：Text 文本数据表是以","为分隔的格式，重点：被导入的数据库只能包含一个表，并且导入的字段应和服务器数据库的表相一致
示例： CALL ReadCdbToServ(TempSj,"DRIVER=SQL Server;UID=sa;DATABASE=temp;SERVER=127.0.0.1;PWD=mzy1029;","img","mc,lx,mem")
示例： Response.write "<form method=POST action=test.asp enctype=multipart/form-data><input type=file name=Tfile><input type=submit value=提交 name=B1></form>"
**************************************************
Public Function ReadCdbToServ(ByVal CdbFileUp,ByVal SdbConnStr,ByVal SdbTbname,ByVal FildStrArr)
ReadCdbToServ=False
Dim MbDir,Mbwjmc,aryTemp,VrCdb_Conn_Str,ofu_Conn,ofu_Rs,sfu_Conn,sfu_Rs,ofu_sql_str,sfu_sql_str,oaryTemp,TpTrs,Gtlx,CdbTbname
VrCdb_Conn_Str=""
MbDir=Readsyspath(1)
If Right(MbDir,1)<>"\" Then MbDir=MbDir&"\"
Mbwjmc=CdbFileUp
aryTemp = Split(Mbwjmc,"\")
Mbwjmc=aryTemp(UBound(aryTemp))
aryTemp=Split(Mbwjmc,".")
Gtlx=UCase(aryTemp(UBound(aryTemp)))
If UpFsRn(100,MbDir,"temp."&Gtlx) Then
     If Gtlx="XLS" Then VrCdb_Conn_Str ="Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source="&MbDir&"temp."&Gtlx&";"             Excel [Tbname$]
     If Gtlx="MDB" Then VrCdb_Conn_Str ="Provider=Microsoft.Jet.OLEDB.4.0;Data Source="&MbDir&"temp."&Gtlx&";Jet OLEDB:Database Password=;"              Access
     If Gtlx="TXT" Then VrCdb_Conn_Str ="Provider=Microsoft.Jet.OLEDB.4.0;Data Source="&MbDir&";Extended Properties=text;HDR=Yes;FMT=Delimited"        Text(,分割)
     If Gtlx="DBF" Then VrCdb_Conn_Str ="Provider=Microsoft.Jet.OLEDB.4.0;Data Source="&MbDir&";Extended Properties=dBASE IV;User ID=Admin;Password="    DBF/FoxPro
     Set sfu_Conn=server.createobject("ADODB.Connection")
     Set sfu_Rs =server.createobject("ADODB.Recordset")
     sfu_Conn.open SdbConnStr
     sfu_sql_str="select "&FildStrArr&" from "&SdbTbname
     Set ofu_Conn=server.createobject("ADODB.Connection")
     Set ofu_Rs =server.createobject("ADODB.Recordset")
     ofu_Conn.open VrCdb_Conn_Str
     Set TpTrs=ofu_Conn.OpenSchema(20)
     CdbTbname=TpTrs(2)
     TpTrs.Close
     Set TpTrs = Nothing
     If Gtlx="XLS" Then CdbTbname="["&CdbTbname&"]"
     ofu_sql_str="select "&FildStrArr&" from "&CdbTbname
     oaryTemp = Split(FildStrArr,",")
     sfu_Rs.open sfu_sql_str,sfu_Conn,1,3
     ofu_Rs.open ofu_sql_str,ofu_Conn,1,3
     Do While Not ofu_Rs.Eof
        sfu_Rs.addnew
        For i = LBound(oaryTemp) To UBound(oaryTemp)
            sfu_Rs(oaryTemp(i))=ofu_Rs(oaryTemp(i))
        Next
        sfu_Rs.update
        ofu_Rs.MoveNext
     Loop
     ofu_Rs.Close
     ofu_Conn.Close
     Set ofu_Rs = Nothing
     Set ofu_Conn=Nothing
     sfu_Rs.Close
     sfu_Conn.Close
     Set sfu_Rs = Nothing
     Set sfu_Conn=Nothing
     ReadCdbToServ=True
     DelFile(MbDir&"temp."&Gtlx)
End If
End Function
**************************************************
函数ID：0031[返回服务器信息]
函数名：GetServerInfo
作用：返回服务器信息
参数：Lx ---- 返回信息代码类
0 : 服务器的域名
1 : 服务器的IP地址
2 : 服务器操作系统
3 : 服务器解译引擎
4 : 服务器软件的名称及版本
5 : 服务器正在运行的端口
6 : 服务器CPU数量
7 : 服务器Application数量
8 : 服务器Session数量
9 : 请求的物理路径
10 : 请求的URL
11 : 服务器当前时间
12 : 脚本连接超时时间
13 : 服务器CPU详情
14 :
返回值：返回信息字串
示例：GetServerInfo(2)
**************************************************
Public Function GetServerInfo(ByVal Lx)
GetServerInfo=""
Dim okCPUS, okCPU, okOS
on error resume next
Set WshShell = server.CreateObject("WScript.Shell")
Set WshSysEnv = WshShell.Environment("SYSTEM")
okOS = cstr(WshSysEnv("OS"))
okCPUS = cstr(WshSysEnv("NUMBER_OF_PROCESSORS"))
okCPU = cstr(WshSysEnv("PROCESSOR_IDENTIFIER"))
if isnull(okCPUS) & "" = "" then
    okCPUS = Request.ServerVariables("NUMBER_OF_PROCESSORS")
end if
tnow = now():oknow = cstr(tnow)
if oknow <> year(tnow) & "-" & month(tnow) & "-" & day(tnow) & " " & hour(tnow) & ":" & right(FormatNumber(minute(tnow)/100,2),2) & ":" & right(FormatNumber(second(tnow)/100,2),2) then oknow = oknow & " (日期格式不规范)"
If Lx=0 Then GetServerInfo=Request.ServerVariables("server_name")
If Lx=1 Then GetServerInfo=Request.ServerVariables("LOCAL_ADDR")
If Lx=2 Then GetServerInfo=okOS     Request.ServerVariables("OS")
If Lx=3 Then GetServerInfo=ScriptEngine & "/"& ScriptEngineMajorVersion &"."&ScriptEngineMinorVersion&"."& ScriptEngineBuildVersion
If Lx=4 Then GetServerInfo=Request.ServerVariables("SERVER_SOFTWARE")
If Lx=5 Then GetServerInfo=Request.ServerVariables("server_port")
If Lx=6 Then GetServerInfo=okCPUS   Request.ServerVariables("NUMBER_OF_PROCESSORS")
If Lx=7 Then GetServerInfo=Application.Contents.Count
If Lx=8 Then GetServerInfo=Session.Contents.Count
If Lx=9 Then GetServerInfo=Request.ServerVariables("path_translated")
If Lx=10 Then GetServerInfo=Request.ServerVariables("server_name")&Request.ServerVariables("script_name")
If Lx=11 Then GetServerInfo=oknow
If Lx=12 Then GetServerInfo=Server.ScriptTimeout
If Lx=13 Then GetServerInfo=okCPU
End Function
**************************************************
函数ID：0032[产生20位长度的唯一标识ID]
函数名：MakeTheID
作用：产生20位长度的唯一标识ID
参数： ----
返回值：返回20位长度的唯一标识ID
示例：MakeTheID()
**************************************************
Public Function MakeTheID()
DIM datestr,mytime,myyear,mymonth,myday,i
myyear = cstr(year(date()))
mymonth = cstr(month(date()))
myday = cstr(day(date()))
mymonth = lpad(mymonth,0,2)
MakeTheID = myyear & "_" & mymonth & "_" & myday & "_"
datestr=cstr(now())
i = instr(datestr," ")
mytime = right(datestr,len(datestr)-i)
mytime = replace(mytime,":","_")
randomize
i = Int((9999 - 1000 + 1) * Rnd + 1000)
MakeTheID = MakeTheID & mytime & "_" & i
MakeTheID = replace(MakeTheID,"_","")
end function
**************************************************
函数ID：0033[用于左填充指定数量的字符,以达到规范长度]
函数名：lpad
作用：用于左填充指定数量的字符,以达到规范长度
参数：desstr ---- 目标字符
参数：padchar ---- 填充字符
参数：lenint ---- 填充后的字符总长度
返回值：返回字符
示例：response.write lpad(4,0,5),结果显示00004
**************************************************
Public Function lpad(ByVal desstr,ByVal padchar,ByVal lenint)
dim d,p,t
d = cstr(desstr)
p = cstr(padchar)
lpad=""
for t=1 to lenint-len(d)
      lpad = p & lpad
next
lpad = lpad & d
end function
**************************************************
函数ID：0034[用于右填充指定数量的字符,以达到规范长度]
函数名：rpad
作用：用于右填充指定数量的字符,以达到规范长度
参数：desstr ---- 目标字符
参数：padchar ---- 填充字符
参数：lenint ---- 填充后的字符总长度
返回值：返回字符
示例：response.write rpad(a,0,5),结果显示a0000
**************************************************
Public Function rpad(ByVal desstr,ByVal padchar,ByVal lenint)
dim d,p,t
d = cstr(desstr)
p = cstr(padchar)
rpad=""
for t=1 to lenint-len(d)
      rpad = p & rpad
next
rpad = d & rpad
end function
**************************************************
函数ID：0035[格式化时间(显示)]
函数名：Format_Time
作用：格式化时间(显示)
参数：s_Time ---- 时间变量
参数：n_Flag ---- 时间样式类型代码
1:"yyyy-mm-dd hh:mm:ss"
2:"yyyy-mm-dd"
3:"hh:mm:ss"
4:"yyyy年mm月dd日"
5:"yyyymmdd"
6:"MM/DD"
返回值：返回格式化后时间
示例：response.write Format_Time(now(),4)
**************************************************
Public Function Format_Time(ByVal s_Time,ByVal n_Flag)
Dim y, m, d, h, mi, s
Format_Time = ""
If IsDate(s_Time) = False Then Exit Function
y = cstr(year(s_Time))
m = cstr(month(s_Time))
If len(m) = 1 Then m = "0" & m
d = cstr(day(s_Time))
If len(d) = 1 Then d = "0" & d
h = cstr(hour(s_Time))
If len(h) = 1 Then h = "0" & h
mi = cstr(minute(s_Time))
If len(mi) = 1 Then mi = "0" & mi
s = cstr(second(s_Time))
If len(s) = 1 Then s = "0" & s
Select Case n_Flag
Case 1
yyyy-mm-dd hh:mm:ss
   Format_Time = y & "-" & m & "-" & d & " " & h & ":" & mi & ":" & s
Case 2
yyyy-mm-dd
   Format_Time = y & "-" & m & "-" & d
Case 3
hh:mm:ss
   Format_Time = h & ":" & mi & ":" & s
Case 4
yyyy年mm月dd日
   Format_Time = y & "年" & m & "月" & d & "日"
Case 5
yyyymmdd
   Format_Time = y & m & d
Case 6
mm/dd
   Format_Time = m & "/" & d
case 7
   Format_Time = m & "/" & d & "/" & right(y,2)
End Select
End Function
**************************************************
函数ID：0036[测试数据库是否存在]
函数名：TestDBOK
作用：测试数据库是否存在
参数：TestConnStr ---- 数据库链接字串
返回值：测试成功返回 True 否则 False
示例：TestDBOK("testConnString")
**************************************************
Public Function TestDBOK(ByVal TestConnStr)
TestDBOK=False
DIM fu_Conn
Set fu_Conn=server.createobject("ADODB.Connection")
On Error GoTo 0
On Error Resume Next
fu_Conn.open TestConnStr
If Err.Number = 0 Then
     TestDBOK=True
End If
On Error GoTo 0
Set fu_Conn = Nothing
End Function
**************************************************
函数ID：0037[测试数据库中的表是否存在]
函数名：TestTbOK
作用：测试数据库中的表是否存在
参数：ObjConnName ---- 数据库链接定义
参数：TestDbname ---- 被测试表的名称
返回值：测试成功返回 True 否则 False
示例：TestTbOK(TestConn,"tbname")
**************************************************
Public Function TestTbOK(ByVal ObjConnName,ByVal TestDbname)
TestTbOK=False
DIM fu_Rs
Set fu_Rs=server.createobject("ADODB.Recordset")
On Error GoTo 0
On Error Resume Next
fu_Rs.open "SELECT * FROM "&TestDbname,ObjConnName,1,1
fu_Rs.Close
If Err.Number = 0 Then
     TestTbOK=True
End If
On Error GoTo 0
Set fu_Rs = Nothing
End Function
**************************************************
函数ID：0038[在线HTML编辑器]
函数名：HTML_MZYEDIT
作用：测试数据库中的表是否存在
参数：MEIPath     ---- 各图标图像所在的路径
参数：GtimgPath   ---- 图片上传程序的URL
参数：GtswfPath   ---- Flash动画上传程序的URL
参数：GtwavPath   ---- 音乐文件上传程序的URL
参数：GtotherPath ---- 其他文件上传程序的URL
返回值：HTML编辑器
示例：
**************************************************
Public Function HTML_MZYEDIT(ByVal MEIPath,ByVal GtimgPath,ByVal GtswfPath,ByVal GtwavPath,ByVal GtotherPath)
Response.Write "" & vbCrlf
Response.Write "<style>img{border: 1 solid #DFDED2;}</style>" & vbCrlf
Response.Write "<table onConTextMenu =event.returnValue=false; style="">宋体; font-size: 9pt;cursor:default;width:100%;height:100%; bgcolor=#DFDED2><tr><td style=width:100%;height:0%;>" & vbCrlf
Response.Write "<IMG BORDER=0 ALT=撤消 SRC="&MEIPath&"undo.gif NAME=Undo ONCLICK=dojob(this.name); onmouseout=mmoo(); onmouseover=mmoo(); onmousedown=mmoo(); onmouseup=mmoo();> " & vbCrlf
Response.Write "<IMG BORDER=0 ALT=恢复 SRC="&MEIPath&"redo.gif NAME=Redo ONCLICK=dojob(this.name); onmouseout=mmoo(); onmouseover=mmoo(); onmousedown=mmoo(); onmouseup=mmoo();> " & vbCrlf
Response.Write "<IMG BORDER=0 ALT=剪切 SRC="&MEIPath&"cut.gif NAME=Cut ONCLICK=dojob(this.name); onmouseout=mmoo(); onmouseover=mmoo(); onmousedown=mmoo(); onmouseup=mmoo();> " & vbCrlf
Response.Write "<IMG BORDER=0 ALT=拷贝 SRC="&MEIPath&"copy.gif NAME=Copy ONCLICK=dojob(this.name); onmouseout=mmoo(); onmouseover=mmoo(); onmousedown=mmoo(); onmouseup=mmoo();> " & vbCrlf
Response.Write "<IMG BORDER=0 ALT=粘贴 SRC="&MEIPath&"paste.gif NAME=Paste ONCLICK=dojob(this.name); onmouseout=mmoo(); onmouseover=mmoo(); onmousedown=mmoo(); onmouseup=mmoo();> " & vbCrlf
Response.Write "<IMG BORDER=0 ALT=删除 SRC="&MEIPath&"delete.gif NAME=Delete ONCLICK=dojob(this.name); onmouseout=mmoo(); onmouseover=mmoo(); onmousedown=mmoo(); onmouseup=mmoo();> " & vbCrlf
Response.Write "<IMG BORDER=0 ALT=距左 SRC="&MEIPath&"aleft.gif NAME=JustifyLeft ONCLICK=dojob(this.name); onmouseout=mmoo(); onmouseover=mmoo(); onmousedown=mmoo(); onmouseup=mmoo();> " & vbCrlf
Response.Write "<IMG BORDER=0 ALT=距中 SRC="&MEIPath&"center.gif NAME=JustifyCenter ONCLICK=dojob(this.name); onmouseout=mmoo(); onmouseover=mmoo(); onmousedown=mmoo(); onmouseup=mmoo();> " & vbCrlf
Response.Write "<IMG BORDER=0 ALT=距右 SRC="&MEIPath&"aright.gif NAME=JustifyRight ONCLICK=dojob(this.name); onmouseout=mmoo(); onmouseover=mmoo(); onmousedown=mmoo(); onmouseup=mmoo();> " & vbCrlf
Response.Write "<IMG BORDER=0 SRC="&MEIPath&"fgs.gif> " & vbCrlf
Response.Write "<IMG BORDER=0 ALT=加粗 SRC="&MEIPath&"bold.gif NAME=Bold ONCLICK=dojob(this.name); onmouseout=mmoo(); onmouseover=mmoo(); onmousedown=mmoo(); onmouseup=mmoo();> " & vbCrlf
Response.Write "<IMG BORDER=0 ALT=斜体 SRC="&MEIPath&"italic.gif NAME=Italic ONCLICK=dojob(this.name); onmouseout=mmoo(); onmouseover=mmoo(); onmousedown=mmoo(); onmouseup=mmoo();> " & vbCrlf
Response.Write "<IMG BORDER=0 ALT=下划线 SRC="&MEIPath&"underline.gif NAME=Underline ONCLICK=dojob(this.name); onmouseout=mmoo(); onmouseover=mmoo(); onmousedown=mmoo(); onmouseup=mmoo();> " & vbCrlf
Response.Write "<IMG BORDER=0 ALT=超链 SRC="&MEIPath&"wlink.gif NAME=CreateLink ONCLICK=dojob(this.name); onmouseout=mmoo(); onmouseover=mmoo(); onmousedown=mmoo(); onmouseup=mmoo();> " & vbCrlf
Response.Write "<IMG BORDER=0 ALT=取消超链 SRC="&MEIPath&"uwlink.gif NAME=Unlink ONCLICK=dojob(this.name); onmouseout=mmoo(); onmouseover=mmoo(); onmousedown=mmoo(); onmouseup=mmoo();> " & vbCrlf
Response.Write "<IMG BORDER=0 ALT=取消格式 SRC="&MEIPath&"untype.gif NAME=RemoveFormat ONCLICK=dojob(this.name); onmouseout=mmoo(); onmouseover=mmoo(); onmousedown=mmoo(); onmouseup=mmoo();> " & vbCrlf
Response.Write "<IMG BORDER=0 ALT=水平线 SRC="&MEIPath&"hr.gif NAME=InsertHorizontalRule ONCLICK=dojob(this.name); onmouseout=mmoo(); onmouseover=mmoo(); onmousedown=mmoo(); onmouseup=mmoo();> " & vbCrlf
Response.Write "<IMG BORDER=0 ALT=缩进 SRC="&MEIPath&"indent.gif NAME=Indent ONCLICK=dojob(this.name); onmouseout=mmoo(); onmouseover=mmoo(); onmousedown=mmoo(); onmouseup=mmoo();> " & vbCrlf
Response.Write "<IMG BORDER=0 ALT=取消缩进 SRC="&MEIPath&"outdent.gif NAME=Outdent ONCLICK=dojob(this.name); onmouseout=mmoo(); onmouseover=mmoo(); onmousedown=mmoo(); onmouseup=mmoo();> " & vbCrlf
Response.Write "<IMG BORDER=0 ALT=数字标识 SRC="&MEIPath&"numlist.gif NAME=InsertOrderedList ONCLICK=dojob(this.name); onmouseout=mmoo(); onmouseover=mmoo(); onmousedown=mmoo(); onmouseup=mmoo();> " & vbCrlf
Response.Write "<IMG BORDER=0 ALT=点标识 SRC="&MEIPath&"bullist.gif NAME=InsertUnorderedList ONCLICK=dojob(this.name); onmouseout=mmoo(); onmouseover=mmoo(); onmousedown=mmoo(); onmouseup=mmoo();> " & vbCrlf
Response.Write "<IMG BORDER=0 ALT=加入图片 SRC="&MEIPath&"img.gif NAME=InsertImage ONCLICK=inputimage(); onmouseout=mmoo(); onmouseover=mmoo(); onmousedown=mmoo(); onmouseup=mmoo();> " & vbCrlf
Response.Write "<IMG BORDER=0 ALT=加入FLASH SRC="&MEIPath&"intole.gif NAME=Inputother ONCLICK=inputother(); onmouseout=mmoo(); onmouseover=mmoo(); onmousedown=mmoo(); onmouseup=mmoo();> " & vbCrlf
Response.Write "<IMG BORDER=0 ALT=加入影音文件 SRC="&MEIPath&"play.gif NAME=Inputother ONCLICK=inputotherpl(); onmouseout=mmoo(); onmouseover=mmoo(); onmousedown=mmoo(); onmouseup=mmoo();> " & vbCrlf
Response.Write "<IMG BORDER=0 ALT=加入文件链接 SRC="&MEIPath&"otlin.gif NAME=Inputother ONCLICK=inputotlink(); onmouseout=mmoo(); onmouseover=mmoo(); onmousedown=mmoo(); onmouseup=mmoo();> " & vbCrlf
Response.Write "<IMG BORDER=0 ALT=插入Excel工作表 SRC="&MEIPath&"excel.gif NAME=excel ONCLICK=inputexcel(); onmouseout=mmoo(); onmouseover=mmoo(); onmousedown=mmoo(); onmouseup=mmoo();> " & vbCrlf
Response.Write "<IMG BORDER=0 ALT=去除Word格式 SRC="&MEIPath&"wordtot.gif NAME=wordtot ONCLICK=wtohtm(); onmouseout=mmoo(); onmouseover=mmoo(); onmousedown=mmoo(); onmouseup=mmoo();> " & vbCrlf
Response.Write "<IMG BORDER=0 ALT=转为TXT格式 SRC="&MEIPath&"txt.gif NAME=totxt ONCLICK=atotxt(); onmouseout=mmoo(); onmouseover=mmoo(); onmousedown=mmoo(); onmouseup=mmoo();> " & vbCrlf
Response.Write "<IMG BORDER=0 ALT=查看源码 SRC="&MEIPath&"html.gif NAME=edbh ID=edbh ONCLICK=htbhtxt(); onmouseout=mmoo(); onmouseover=mmoo(); onmousedown=mmoo(); onmouseup=mmoo();> " & vbCrlf
Response.Write "<IMG BORDER=0 ALT=在IE里预览 SRC="&MEIPath&"view.gif NAME=bh ONCLICK=view(); onmouseout=mmoo(); onmouseover=mmoo(); onmousedown=mmoo(); onmouseup=mmoo(); >" & vbCrlf
Response.Write "<IMG BORDER=0 SRC="&MEIPath&"fgs.gif> " & vbCrlf
Response.Write "<SELECT NAME=FontName STYLE=width:94;font-size: 9pt;cursor:default; ONCHANGE=doadv(this.name,this[this.selectedIndex].value);this.selectedIndex=0;>" & vbCrlf
Response.Write "<OPTION SELECTED>字体</OPTION><OPTION VALUE=宋体>宋体</OPTION><OPTION VALUE=黑体>黑体</OPTION><OPTION VALUE=楷体_GB2312>楷体</OPTION><OPTION VALUE=Arial>Arial</OPTION><OPTION VALUE=Arial Black>Arial Black</OPTION><OPTION VALUE=Wingdings>Wingdings</OPTION>" & vbCrlf
Response.Write "</SELECT><SELECT NAME=FontSize STYLE=width:50;font-size: 9pt;cursor:default; ONCHANGE=doadv(this.name,this[this.selectedIndex].value);this.selectedIndex=0;>" & vbCrlf
Response.Write "<OPTION SELECTED>字号</OPTION><OPTION VALUE=7>一号</OPTION><OPTION VALUE=6>二号</OPTION><OPTION VALUE=5>三号</OPTION><OPTION VALUE=4>四号</OPTION><OPTION VALUE=3>五号</OPTION><OPTION VALUE=2>六号</OPTION><OPTION VALUE=1>七号</OPTION>" & vbCrlf
Response.Write "</SELECT><SELECT NAME=ForeColor STYLE=width:50;font-size: 9pt;cursor:default; ONCHANGE=doadv(this.name,this[this.selectedIndex].value);this.selectedIndex=0;>" & vbCrlf
Response.Write "<OPTION SELECTED VALUE=#000000>字色</OPTION><OPTION VALUE=#FFFFFF STYLE=color:#FFFFFF>●</OPTION><OPTION VALUE=#000000 STYLE=color:#000000>●</OPTION><OPTION VALUE=#800000 STYLE=color:#800000>●</OPTION><OPTION VALUE=#FF0000 STYLE=color:#FF0000>●</OPTION><OPTION VALUE=#000080 STYLE=color:#000080>●</OPTION>" & vbCrlf
Response.Write "</SELECT><font color=#3D3D3D> 表格[<INPUT TYPE=text NAME=T_H SIZE=3 VALUE=2 style="">宋体; font-size: 9pt>行<INPUT TYPE=text NAME=T_L SIZE=3 VALUE=2 style="">宋体; font-size: 9pt>列<INPUT TYPE=button VALUE=插入 NAME=B1 ONCLICK=InsertOle(inputtable(T_H.value,T_L.value)); style="">宋体; font-size: 9pt>]</font> <IMG BORDER=0 SRC="&MEIPath&"fgs.gif>" & vbCrlf
Response.Write "</td></tr><tr><td style=width:100%;height:100%;>"
Response.Write "<IFRAME SRC=about:blank ID=MZYEDITWINDOW style=width:100%;height:100%;></IFRAME><div id=Temp_HTML style=VISIBILITY: hidden; OVERFLOW: hidden; POSITION: absolute; WIDTH: 1px; HEIGHT: 1px></div>" & vbCrlf
Response.Write "</td></tr></table>" & vbCrlf
Response.Write "<SCRIPT language=javascript>" & vbCrlf
Response.Write "var Htmlmode=Y;" & vbCrlf
Response.Write "var Htmldata=;" & vbCrlf
Response.Write "MZYEDITWINDOW.document.designMode=On;MZYEDITWINDOW.focus();" & vbCrlf
Response.Write "var pjob;" & vbCrlf
Response.Write "function mmoo()" & vbCrlf
Response.Write "{pjob=(window.event.type).toUpperCase();" & vbCrlf
Response.Write "if ((pjob==MOUSEOVER) || (pjob==MOUSEUP)){event.srcElement.style.borderLeft=1 solid #808080;" & vbCrlf
Response.Write "event.srcElement.style.borderRight=1 solid #FFFFFF;" & vbCrlf
Response.Write "event.srcElement.style.borderTop=1 solid #FFFFFF;" & vbCrlf
Response.Write "event.srcElement.style.borderBottom=1 solid #808080;}" & vbCrlf
Response.Write "if ((pjob==MOUSEOUT) || (pjob==MOUSEDOWN)){event.srcElement.style.border=1 solid #DFDED2;}" & vbCrlf
Response.Write "}" & vbCrlf
Response.Write "function dojob(doname)" & vbCrlf
Response.Write "{MZYEDITWINDOW.focus();" & vbCrlf
Response.Write "ckmode();MZYEDITWINDOW.document.execCommand(doname);}" & vbCrlf
Response.Write "function doadv(doname,jobtxt)" & vbCrlf
Response.Write "{MZYEDITWINDOW.focus();" & vbCrlf
Response.Write "ckmode();MZYEDITWINDOW.document.execCommand(doname,false,jobtxt);}" & vbCrlf
Response.Write "function InsertOle(date)" & vbCrlf
Response.Write "{ckmode();MZYEDITWINDOW.focus();MZYEDITWINDOW.document.selection.createRange().pasteHTML(date);}" & vbCrlf
Response.Write "function htbhtxt()" & vbCrlf
Response.Write "{MZYEDITWINDOW.focus();" & vbCrlf
Response.Write "if (Htmlmode==Y){MZYEDITWINDOW.document.body.innerText=MZYEDITWINDOW.document.body.innerHTML;Htmlmode=N;edbh.alt=恢复HTML编辑状态;" & vbCrlf
Response.Write "}else{MZYEDITWINDOW.document.body.innerHTML=MZYEDITWINDOW.document.body.innerText;Htmlmode=Y;edbh.alt=查看源码;}}" & vbCrlf
Response.Write "function ckmode()" & vbCrlf
Response.Write "{if (Htmlmode==N){MZYEDITWINDOW.document.body.innerHTML=MZYEDITWINDOW.document.body.innerText;Htmlmode=Y;}" & vbCrlf
Response.Write "}" & vbCrlf
Response.Write "function view(){testwin=open(, testwin,status=no,menubar=no,toolbar=no,resizable=yes,scrollbars=yes);testwin.document.open();testwin.document.write(MZYEDITWINDOW.document.body.innerHTML);}" & vbCrlf
Response.Write "function inputexcel(){s=<OBJECT id=Spreadsheet1 codeBase=file:\Bobsoftwareoffice2000msowc.cab height=250 width=100% classid=clsid:0002E510-0000-0000-C000-000000000046></OBJECT>;InsertOle(s);}" & vbCrlf
Response.Write "function inputtable(h,l)" & vbCrlf
Response.Write "{" & vbCrlf
Response.Write "s=<table border=1 width=100% cellspacing=0 cellpadding=0>;" & vbCrlf
Response.Write "for(i=1 ;i<=l;i++){s=s+<tr>;for(j=1;j<=h;j++)s=s+<td> </td>;s=s+</tr>;}" & vbCrlf
Response.Write "s=s+</table>;" & vbCrlf
Response.Write "return s;" & vbCrlf
Response.Write "}" & vbCrlf
Response.Write "function inputimage()" & vbCrlf
Response.Write "{" & vbCrlf
Response.Write "var temp=showModalDialog("&GtimgPath&",, dialogWidth:30em; dialogHeight:26em; status:0);" & vbCrlf
Response.Write "MZYEDITWINDOW.focus();" & vbCrlf
Response.Write "if ((temp!==null) && (temp!==))" & vbCrlf
Response.Write "doadv(InsertImage,temp);" & vbCrlf
Response.Write "}" & vbCrlf
Response.Write "function inputother()" & vbCrlf
Response.Write "{" & vbCrlf
Response.Write "var temp=showModalDialog("&GtswfPath&",, dialogWidth:30em; dialogHeight:26em;status:0);" & vbCrlf
Response.Write "var tempa="&chr(34)&"<p align=center><a onclick=MZYmovie.Play(); STYLE=cursor:hand;>播放</a>　<a onclick=MZYmovie.StopPlay(); STYLE=cursor:hand;>暂停</a>　<a onclick=\"&chr(34)&"MZYmovie.width=600;MZYmovie.height=600;\"&chr(34)&" STYLE=cursor:hand;>最大化</a>　<a onclick=\"&chr(34)&"MZYmovie.width=500;MZYmovie.height=400;\"&chr(34)&" STYLE=cursor:hand;>恢复</a><br><table NAME=FFWH ID=FFWH border=0 width=100% height=100% cellspacing=0 cellpadding=0><tr><td width=100% height=90% valign=middle align=center>"&chr(34)&";" & vbCrlf
Response.Write "var tempb="&chr(34)&"<EMBED SRC="&chr(34)&";" & vbCrlf
Response.Write "var tempc="&chr(34)&" WIDTH=500 HEIGHT=400 QUALITY=high PLUGINSPAGE=http://www.macromedia.com/go/getflashplayer TYPE=application/x-shockwave-flash ID=MZYmovie NAME=MZYmovie MENU=false>"&chr(34)&";" & vbCrlf
Response.Write "var tempd="&chr(34)&"</td></tr></table></p>"&chr(34)&";" & vbCrlf
Response.Write "MZYEDITWINDOW.focus();" & vbCrlf
Response.Write "if ((temp!==null) && (temp!==))" & vbCrlf
Response.Write "temp=tempa+tempb+temp+tempc+tempd;" & vbCrlf
Response.Write "InsertOle(temp);" & vbCrlf
Response.Write "}" & vbCrlf
Response.Write "function inputotherpl()" & vbCrlf
Response.Write "{" & vbCrlf
Response.Write "var pl_w = prompt(录入影片的宽度, 100);" & vbCrlf
Response.Write "var pl_h = prompt(录入影片的高度, 100);" & vbCrlf
Response.Write "var tempwh="&chr(34)&"WIDTH="&chr(34)&"+pl_w+"&chr(34)&" HEIGHT="&chr(34)&"+pl_h;"
Response.Write "var temp=showModalDialog("&GtwavPath&",, dialogWidth:30em; dialogHeight:26em; status:0);" & vbCrlf
Response.Write "var temprma="&chr(34)&"<OBJECT CLASSID=clsid:CFCDAA03-8BE4-11CF-B84B-0020AFBBCCFA ID=MZYMPL "&chr(34)&";"
Response.Write "var temprmb="&chr(34)&"><PARAM NAME=SRC VALUE="&chr(34)&";"
Response.Write "var temprmc="&chr(34)&"></OBJECT>"&chr(34)&";"
Response.Write "var tempmpa="&chr(34)&"<OBJECT CLASSID=clsid:6BF52A52-394A-11D3-B153-00C04F79FAA6 ID=MZYMPL"&chr(34)&";"
Response.Write "var tempmpb="&chr(34)&"><PARAM NAME=URL VALUE="&chr(34)&";"
Response.Write "var tempmpc="&chr(34)&"></OBJECT>"&chr(34)&";"
Response.Write "MZYEDITWINDOW.focus();" & vbCrlf
Response.Write "if ((temp!==null) && (temp!==))" & vbCrlf
Response.write "var pllx = confirm(是否使用Windows media player?)"&vbCrlf
Response.write "if (pllx != 0){"&vbCrlf
Response.Write "temp=tempmpa+ +tempwh+ +tempmpb+temp+tempmpc;"&vbCrlf
Response.Write "}else{"&vbCrlf
Response.Write "temp=temprma+ +tempwh+ +temprmb+temp+temprmc;"&vbCrlf
Response.Write "}"&vbCrlf
Response.Write "InsertOle(temp);" & vbCrlf
Response.Write "}" & vbCrlf
Response.Write "function inputotlink()" & vbCrlf
Response.Write "{" & vbCrlf
Response.Write "var linkname = prompt(录入链接文字说明, 点这下载);" & vbCrlf
Response.Write "var temp=showModalDialog("&GtotherPath&",, dialogWidth:30em; dialogHeight:26em; status:0);" & vbCrlf
Response.Write "MZYEDITWINDOW.focus();" & vbCrlf
Response.Write "if ((temp!==null) && (temp!==)){" & vbCrlf
Response.Write "temp="&chr(34)&"<a href="&chr(34)&"+temp+"&chr(34)&" _fcksavedurl=""&chr(34)&"+temp+"&chr(34)&"" _fcksavedurl=""&chr(34)&"+temp+"&chr(34)&"" _fcksavedurl=""&chr(34)&"+temp+"&chr(34)&"" target=_blank>"&chr(34)&"+linkname+"&chr(34)&"</a>"&chr(34)&";" & vbCrlf
Response.Write "InsertOle(temp);}" & vbCrlf
Response.Write "}" & vbCrlf
Response.Write "function HTMLEncode(text){" & vbCrlf
Response.Write "text = text.replace(/&/g, &) ;" & vbCrlf
Response.Write "text = text.replace(/""/g, ") ;" & vbCrlf
Response.Write "text = text.replace(/</g, <) ;" & vbCrlf
Response.Write "text = text.replace(/>/g, >) ;" & vbCrlf
Response.Write "text = text.replace(//g, ) ;" & vbCrlf
Response.Write "text = text.replace(/\ /g, );" & vbCrlf
Response.Write "text = text.replace(/\n/g,<br>);" & vbCrlf
Response.Write "text = text.replace(/\t/g,    );" & vbCrlf
Response.Write "return text;" & vbCrlf
Response.Write "}" & vbCrlf
Response.Write "function cleanword(text) {" & vbCrlf
Response.Write "text = text.replace(/<\/?SPAN[^>]*>/gi, );" & vbCrlf
Response.Write "text = text.replace(/<(\w[^>]*) class=([^ |>]*)([^>]*)/gi, <$1$3) ;" & vbCrlf
Response.Write "text = text.replace(/<(\w[^>]*)([^""]*)""([^>]*)/gi, <$1$3) ;" & vbCrlf
Response.Write "text = text.replace(/<(\w[^>]*) lang=([^ |>]*)([^>]*)/gi, <$1$3) ;" & vbCrlf
Response.Write "text = text.replace(/<\\?\?xml[^>]*>/gi, ) ;" & vbCrlf
Response.Write "text = text.replace(/<\/?\w+:[^>]*>/gi, ) ;" & vbCrlf
Response.Write "text = text.replace(/ /, );" & vbCrlf
Response.Write "var re = new RegExp((<P)([^>]*>.*?)(<\/P>),gi) ;" & vbCrlf
Response.Write "text = text.replace( re, <div$2</div> ) ;" & vbCrlf
Response.Write "return text;" & vbCrlf
Response.Write "}" & vbCrlf
Response.Write "function atotxt()" & vbCrlf
Response.Write "{if ( confirm(如果转为文本格式将丢失所有排版内容，请确认是否这样做？)){MZYEDITWINDOW.focus();" & vbCrlf
Response.Write "MZYEDITWINDOW.document.body.innerHTML=HTMLEncode(MZYEDITWINDOW.document.body.innerText);}}" & vbCrlf
Response.Write "function wtohtm()" & vbCrlf
Response.Write "{if ( confirm(是否要将WORD格式去除？)){MZYEDITWINDOW.focus();" & vbCrlf
Response.Write "MZYEDITWINDOW.document.body.innerHTML=cleanword(MZYEDITWINDOW.document.body.innerHTML);}}" & vbCrlf
Response.Write "function CKjtb() {" & vbCrlf
Response.Write "var oDiv = document.getElementById(Temp_HTML);" & vbCrlf
Response.Write "oDiv.innerHTML = ;" & vbCrlf
Response.Write "var oTextRange = document.body.createTextRange() ;" & vbCrlf
Response.Write "oTextRange.moveToElementText(oDiv) ;" & vbCrlf
Response.Write "oTextRange.execCommand(Paste) ;" & vbCrlf
Response.Write "var sData = oDiv.innerHTML ;" & vbCrlf
Response.Write "oDiv.innerHTML = ;" & vbCrlf
Response.Write "var re = /<\w[^>]* class=""?MsoNormal""?/gi ; var nsData=sData;" & vbCrlf
Response.Write "if ( re.test(sData)){" & vbCrlf
Response.Write "if (confirm( 你要粘贴的内容好象是从Word中拷出来的，是否要先清除Word格式再粘贴？ )){" & vbCrlf
Response.Write "nsData=cleanword(sData) ;" & vbCrlf
Response.Write "}" & vbCrlf
Response.Write "}" & vbCrlf
Response.Write "MZYEDITWINDOW.document.selection.createRange().pasteHTML(nsData);" & vbCrlf
Response.Write "return false ;" & vbCrlf
Response.Write "}" & vbCrlf
Response.Write "setTimeout(""MZYEDITWINDOW.document.body.onpaste =CKjtb;"",1000);" & vbCrlf
Response.Write "</SCRIPT>" & vbCrlf
Response.Write "" & vbCrlf
End Function
**************************************************
函数ID：0039[判断是否奇数]
函数名：Is_JS
作用：判断是否奇数
参数：num ---- 要判断的数
返回值：返回True,否则False
**************************************************
Public Function Is_JS(ByVal num)
n=num mod 2
if n=1 then
     Is_JS=true
else
     Is_JS=false
end if
end function
**************************************************
函数ID：0040[生成验证码图像BMP]
函数名：GrapCode
作用：生成验证码图像
参数：MZYGCstr ---- 要生成的图像的字符
参数：Noisy     ---- 噪点率(大于0的整数)
参数：BkColor   ---- 图案背景色(格式：R|G|B)
参数：FnColor   ---- 字符颜色(格式：R|G|B)
参数：NoColor   ---- 噪点颜色(格式：R|G|B)
返回值：验证码图像
示例：Response.Write "<img src="http://www.knowsky.com/ &GrapCode(Request("n"),6,"10|40|100","255|255|255","100|100|100")&">"
**************************************************
Public Function GrapCode(ByVal MZYGCstr,ByVal Noisy,ByVal BkColor,ByVal FnColor,ByVal NoColor)
If Len(Trim(MZYGCstr))>1 Then
Dim imgsize,pimgsize
Const cAmount = 36
Const cCode = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Dim ColorV(2)
tmp=""
tmp=Split(BkColor,"|")
ColorV(0) =""
For i = LBound(tmp) To UBound(tmp)
      ColorV(0) = ColorV(0) & ChrB(CInt(tmp(i)))
Next
tmp=""
tmp=Split(FnColor,"|")
ColorV(1) =""
For i = LBound(tmp) To UBound(tmp)
      ColorV(1) = ColorV(1) & ChrB(CInt(tmp(i)))
Next
tmp=""
tmp=Split(NoColor,"|")
ColorV(2) =""
For i = LBound(tmp) To UBound(tmp)
      ColorV(2) = ColorV(2) & ChrB(CInt(tmp(i)))
Next
imgsize=10*Len(MZYGCstr)*10*24/8
pimgsize=10*Len(MZYGCstr)*10*24/8
If Is_JS(Len(MZYGCstr)) Then
     imgsize=imgsize+74
     pimgsize=pimgsize+20
Else
     imgsize=imgsize+54
End If
imgsize =Hex(imgsize)
pimgsize=Hex(pimgsize)
imgsize =Cstr(imgsize)
pimgsize=Cstr(pimgsize)
dword对齐处理
Dim length, byteCount,BytePatch
length = Len(MZYGCstr)
byteCount=((length*10*3) mod 4)
If byteCount>0 Then
     byteCount= 4 - ((length*10*3) Mod 4)
     For i=1 To byteCount : BytePatch = BytePatch & chrB(00) : Next
End If
tmp=""
For i=1 to len(imgsize) step 2
      If (i < len(imgsize)) Then
         tmp=tmp & Mid(imgsize,i,2) & "|"
      Else
         tmp=tmp & Mid(imgsize,i,2)
      End If
Next
imgsize=StrReverse(tmp)
tmp=""
tmp=Split(imgsize,"|")
imgsize=""
For i = 0 To 3
      If (i <= UBound(tmp)) Then
         imgsize=imgsize & ChrB("&H"&tmp(i))
      Else
         imgsize=imgsize & ChrB(0)
      End If
Next
ptmp=""
For i=1 to len(pimgsize) step 2
      If (i < len(pimgsize)) Then
         ptmp=ptmp & Mid(pimgsize,i,2) & "|"
      Else
         ptmp=ptmp & Mid(pimgsize,i,2)
      End If
Next
pimgsize=StrReverse(ptmp)
ptmp=""
ptmp=Split(pimgsize,"|")
pimgsize=""
For i = 0 To 3
      If (i <= UBound(ptmp)) Then
         pimgsize=pimgsize & ChrB("&H"&ptmp(i))
      Else
         pimgsize=pimgsize & ChrB(0)
      End If
Next
MZYGCstr=UCase(MZYGCstr)
tmp=""
For i = 0 To (Len(MZYGCstr)-1)
      If i<>(Len(MZYGCstr)-1) Then
         tmp =tmp & InStr(cCode,Mid(MZYGCstr,i+1,1))-1 &"|"
      Else
         tmp =tmp & InStr(cCode,Mid(MZYGCstr,i+1,1))-1
      End If
Next
Dim vCode
vCode=Split(tmp,"|")
Response.Expires = -9999
Response.AddHeader "pragma", "no-cache"
Response.AddHeader "cache-ctrol", "no-cache"
Response.Buffer = TRUE
Response.ContentType="image/bmp"
Response.Flush
Response.BinaryWrite ChrB(66) & ChrB(77) & imgsize & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(54) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(40) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(10*Len(MZYGCstr)) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(12) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(1) & ChrB(0)
Response.BinaryWrite ChrB(24) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & pimgsize & ChrB(18) & ChrB(11) & ChrB(0) & ChrB(0) & ChrB(18) & ChrB(11) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0) & ChrB(0)
Dim NsD(35)
NsD(0) = "111111111111100001111101111011110111101111010010111101001011110100101111010010111101111011110111101111100001111111111111"
NsD(1) = "111111111111110111111100011111111101111111110111111111011111111101111111110111111111011111111101111111000001111111111111"
NsD(2) = "111111111111100001111101111011110111101111111110111111110111111110111111110111111110111111110111101111000000111111111111"
NsD(3) = "111111111111100001111101111011110111101111111101111111001111111111011111111110111101111011110111101111100001111111111111"
NsD(4) = "111111111111111011111111101111111100111111101011111101101111110110111111000000111111101111111110111111110000111111111111"
NsD(5) = "111111111111000000111101111111110111111111010001111100111011111111101111111110111101111011110111101111100001111111111111"
NsD(6) = "111111111111110001111110111011110111111111011111111101000111110011101111011110111101111011110111101111100001111111111111"
NsD(7) = "111111111111000000111101110111110111011111111011111111101111111101111111110111111111011111111101111111110111111111111111"
NsD(8) = "111111111111100001111101111011110111101111011110111110000111111011011111011110111101111011110111101111100001111111111111"
NsD(9) = "111111111111100011111101110111110111101111011110111101110011111000101111111110111111111011110111011111100011111111111111"
NsD(10) = "111111111111110111111111011111111010111111101011111110101111111010111111000001111101110111110111011110001000111111111111"
NsD(11) = "111111111110000001111101111011110111101111011101111100001111110111011111011110111101111011110111101110000001111111111111"
NsD(12) = "111111111111100000111101111011101111101110111111111011111111101111111110111111111011111011110111011111100011111111111111"
NsD(13) = "111111111110000011111101110111110111101111011110111101111011110111101111011110111101111011110111011110000011111111111111"
NsD(14) = "111111111110000001111101111011110110111111011011111100001111110110111111011011111101111111110111101110000001111111111111"
NsD(15) = "111111111110000001111101111011110110111111011011111100001111110110111111011011111101111111110111111110001111111111111111"
NsD(16) = "111111111111100001111101110111101111011110111111111011111111101111111110111000111011110111110111011111100011111111111111"
NsD(17) = "111111111110001000111101110111110111011111011101111100000111110111011111011101111101110111110111011110001000111111111111"
NsD(18) = "111111111111000001111111011111111101111111110111111111011111111101111111110111111111011111111101111111000001111111111111"
NsD(19) = "111111111111100000111111101111111110111111111011111111101111111110111111111011111111101111101110111110000111111111111111"
NsD(20) = "111111111110001000111101110111110110111111010111111100011111110101111111011011111101101111110111011110001000111111111111"
NsD(21) = "111111111110001111111101111111110111111111011111111101111111110111111111011111111101111111110111101110000000111111111111"
NsD(22) = "111111111110001000111100100111110010011111001001111101010111110101011111010101111101010111110101011110010100111111111111"
NsD(23) = "111111111110001000111100110111110011011111010101111101010111110101011111011001111101100111110110011110001101111111111111"
NsD(24) = "111111111111100011111101110111101111101110111110111011111011101111101110111110111011111011110111011111100011111111111111"
NsD(25) = "111111111110000001111101111011110111101111011110111100000111110111111111011111111101111111110111111110001111111111111111"
NsD(26) = "111111111111100011111101110111101111101110111110111011111011101111101110111110111010011011110110011111100010111111111111"
NsD(27) = "111111111110000011111101110111110111011111011101111100001111110101111111011011111101101111110111011110001100111111111111"
NsD(28) = "111111111111100000111101111011110111101111011111111110011111111110011111111110111101111011110111101111000001111111111111"
NsD(29) = "111