ASP函數庫(全部可以直接調用，非常方便) 4

'**************************************************
'函數名：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="&nbsp;"
Else
TempObjType="<font color='#800000'>"&tmpObjs(i)&"</font>"
TempBs="<font color='#800000'>×</font>"
TempBsXX="&nbsp;"
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();'>&nbsp;&nbsp;<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
'**************************************************''''