ASP函数库

减小字体 增大字体 作者:佚名  来源:本站整理  发布时间:2008-8-28 3:38:24 我要发布文章
************************************************
'函数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
Functio

上一页  [1] [2] [3] [4] [5] [6] [7] [8] [9] [10] [11] [12] [13] [14] [15] [16] [17]  下一页