<%@ Language=VBScript %>
<%


'Fields("xxx").Name取得Form中xxx(FormObject)的名字 
'Fields("xxx").FilePath如果是fileObject取得文件的完整路径 
'Fields("xxx").FileName如果是fileObject取得文件名 
'Fields("xxx").ContentType如果是fileObject取得文件的类型 
'Fields("xxx").Length取得Form中xxx(FormObject)的数据长度 
'Fields("xxx").Value取得Form中xxx(FormObject)的数据内容 
Dim FormData,FormSize 
FormSize=Request.TotalBytes 
FormData=Request.BinaryRead(FormSize) 
Set Form=GetUpload(FormData) 

If session("admau")="" Then
	ef=True
	ec="授权非法，有可能是超时造成的。"
elseIf session("canmoneyK")="" Then
	ef=True
	ec="您没有此操作的权限。"
ElseIf Form("id").Value<>"" And not IsNumeric(Form("id").Value)  Then
	ef=True
	ec="id号应该是数字！"
end If

if not ef Then
For   each   item   in   Form   
If InStr(Form(item).value,"'") Then
'	ef=True
'	ec="输入的内容中不能有'号"
End If
If Form(item).Length>102400 Then
	ef=True
	ec="文件大小不能超过100K"
End if
Next
End If

if not ef then
Set conn=Server.CreateObject("ADODB.Connection")
	conn.Open Application("FreeHostDBlink")
	Set dsICPDB = Server.CreateObject("ADODB.Recordset")	
	Sql="Select * from FreeHost.FreeHost_ICPDB where id ='"&Form("id").Value&"'"
	dsICPDB.Open Sql,conn,1,3
if dsICPDB.Eof then
	ef=True
	ec="不存在的ID!"
end if
end if


if not ef Then
dsICPDB("idimg").appendchunk Form("freehostfile").value
dsICPDB.update
end If

if not ef Then
Response.Redirect "admicpdbupimg.asp?id="&Form("id").Value
end if
if ef then
Response.Redirect "e.asp?e="&ec
end If%>





     
<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>