用户登录  |  用户注册
首 页商业源码原创产品编程论坛
当前位置:PB创新网文章中心编程技巧Delphi

不使用组件实现多个图片与文本数据同时写入数据库(1)

减小字体 增大字体 作者:佚名  来源:本站整理  发布时间:2009-03-16 20:06:38
''filename: upload.inc
''---------------------------------------------------------------------------
------------------------------------------
<SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT>
Function GetUpload(FormData)
    Dim DataStart,DivStr,DivLen,DataSize,FormFieldData
    ''分隔标志串(+CRLF)
    DivStr = LeftB(FormData,InStrB(FormData,str2bin(VbCrLf)) + 1)
    ''分隔标志串长度
    DivLen = LenB(DivStr)
    PosOpenBoundary = InStrB(FormData,DivStr)
    PosCloseBoundary = InStrB(PosOpenBoundary + 1,FormData,DivStr)
    Set Fields = CreateObject("Scripting.Dictionary")

    While PosOpenBoundary > 0 And PosCloseBoundary > 0
       ''name起始位置(name="xxxxx"),加6是因为[name="]长度为6
       FieldNameStart = InStrB(PosOpenBoundary,FormData,str2bin("name=")) +
6
       FieldNameSize = InStrB(FieldNameStart,FormData,ChrB(34)) -
FieldNameStart ''(")的ASC值=34
       FormFieldName = bin2str(MidB(FormData,FieldNameStart,FieldNameSize))

       ''filename起始位置(filename="xxxxx")
       FieldFileNameStart =
InStrB(PosOpenBoundary,FormData,str2bin("filename=")) + 10
       If FieldFileNameStart < PosCloseBoundary And FieldFileNameStart >
PosopenBoundary Then
          FieldFileNameSize = InStrB(FieldFileNameStart,FormData,ChrB(34)) -
FieldFileNameStart ''(")的ASC值=34
          FormFileName =
bin2str(MidB(FormData,FieldFileNameStart,FieldFileNameSize))
       Else
          FormFileName = ""
       End If

       ''Content-Type起始位置(Content-Type: xxxxx)
       FieldFileCTStart =
InStrB(PosOpenBoundary,FormData,str2bin("Content-Type:")) + 14
       If FieldFileCTStart < PosCloseBoundary  And FieldFileCTStart >
PosOpenBoundary Then
          FieldFileCTSize = InStrB(FieldFileCTStart,FormData,str2bin(VbCrLf
& VbCrLf)) - FieldFileCTStart
          FormFileCT =
bin2str(MidB(FormData,FieldFileCTStart,FieldFileCTSize))
       Else
          FormFileCT = ""
       End If

       ''数据起始位置:2个CRLF开始
       DataStart = InStrB(PosOpenBoundary,FormData,str2bin(VbCrLf & VbCrLf))
+ 4
       If FormFileName <> "" Then
          ''数据长度,减1是因为数据文件的存取字节数问题(可能是AppendChunk方法
的问题):
          ''由于字节数为奇数的图象存到数据库时会去掉最后一个字符导致图象不能
正确显示,
          ''字节数为偶数的数据文件就不会出现这个问题,因此必须保持字节数为偶
数。
          DataSize = InStrB(DataStart,FormData,DivStr) - DataStart - 1
          FormFieldData = MidB(FormData,DataStart,DataSize)
       Else
          ''数据长度,减2是因为分隔标志串前有一个CRLF
          DataSize = InStrB(DataStart,FormData,DivStr) - DataStart - 2
          FormFieldData = bin2str(MidB(FormData,DataStart,DataSize))
       End If

       ''建立一个Dictionary集存储Form中各个Field的相关数据
       Set Field = CreateUploadField()
       Field.Name = FormFieldName
       Field.FilePath = FormFileName
       Field.FileName = GetFileName(FormFileName)
       Field.ContentType = FormFileCT
       Field.Length = LenB(FormFieldData)
       Field.Value = FormFieldData

       Fields.Add FormFieldName, Field

       PosOpenBoundary = PosCloseBoundary
       PosCloseBoundary = InStrB(PosOpenBoundary + 1,FormData,DivStr)
    Wend
    Set GetUpload = Fields
End Function

''把二进制字符串转换成普通字符串函数
Function bin2str(binstr)
   Dim varlen,clow,ccc,skipflag
   ''中文字符Skip标志
   skipflag=0
   ccc = ""
   If Not IsNull(binstr) Then
      varlen=LenB(binstr)
      For i=1 To varlen
          If skipflag=0 Then
             clow = MidB(binstr,i,1)
             ''判断是否中文的字符
             If AscB(clow) > 127 Then
                ''AscW会把二进制的中文双字节字符高位和低位反转,所以要先把中
文的高低位反转
                ccc =ccc & Chr(AscW(MidB(binstr,i+1,1) & clow))
                skipflag=1
             Else
                ccc = ccc & Chr(AscB(clow))
             End If
          Else
             skipflag=0
          End If
      Next
   End If
   bin2str = ccc
End Function


''字符串->二进制字符
Function str2bin(varstr)
   str2bin=""
   For i=1 To Len(varstr)
       varchar=mid(varstr,i,1)
       varasc = Asc(varchar)
       '' asc对中文字符求出来的值可能为负数,
       '' 加上65536就可求出它的无符号数值
       '' -1在机器内是用补码表示的0xffff,
       '' 其无符号值为65535,65535=-1+65536
       '' 其他负数依次类推。
       If varasc<0 Then
          varasc = varasc + 65535
       End If
       ''对中文的处理:把双字节低位和高位分开
       If varasc>255 Then
          varlow = Left(Hex(Asc(varchar)),2)
          varhigh = right(Hex(Asc(varchar)),2)
          str2bin = str2bin & chrB("&H" & varlow) & chrB("&H" & varhigh)
       Else
          str2bin = str2bin & chrB(AscB(varchar))
       End If
   Next
End Function

''取得文件名(去掉Path)
Function GetFileName(FullPath)
   If FullPath <> "" Then
      FullPath = StrReverse(FullPath)
      FullPath = Left(FullPath, InStr(1, FullPath, "\") - 1)
      GetFileName = StrReverse(FullPath)
   Else
      GetFileName = ""
   End If
End Function
</SCRIPT>
<SCRIPT RUNAT=SERVER LANGUAGE=JSCRIPT>
function CreateUploadField(){ return new uf_Init() }
function uf_Init(){
  this.Name = null
  this.FileName = null
  this.FilePath = null
  this.ContentType = null
  this.Value = null
  this.Length = null
}
</SCRIPT>

Tags:

作者:佚名

文章评论评论内容只代表网友观点,与本站立场无关!

   评论摘要(共 0 条,得分 0 分,平均 0 分) 查看完整评论
PB创新网ourmis.com】Copyright © 2000-2009 . All Rights Reserved .
页面执行时间:27,656.25000 毫秒
Email:ourmis@126.com QQ:2322888 蜀ICP备05006790号