asp制作中常用到的函数库集合第5/8页

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

最新评论