ASP函数库(全部可以直接调用，非常方便) 4

最新推荐文章于 2021-06-30 14:36:43 发布

weixin_30699235

最新推荐文章于 2021-06-30 14:36:43 发布

阅读量200

点赞数

文章标签：数据库 javascript ViewUI

原文链接：http://www.cnblogs.com/leevane/archive/2008/03/11/1100435.html

版权

'**************************************************
'函数名：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
'**************************************************''''

转载于:https://www.cnblogs.com/leevane/archive/2008/03/11/1100435.html

weixin_30699235

关注

0
点赞
踩
1

收藏

觉得还不错? 一键收藏
0
评论
ASP函数库(全部可以直接调用，非常方便) 4

'**************************************************'函数名：ListObjInfo'作用：列出组件安装信息'参数： ---- '返回值：列出组件安装信息'示例：ListObjInfo()'**************************************************Public Function ListObjInfo...
复制链接

扫一扫