<%
'當表單裡既有文本域又有文件域的時候,我們必須把表單的編碼類型設置成"multipart/form-data"類型
'這時候上傳上來的編碼文件並不能直接取出文本域的值和文件域的二進制數據,這就需要拆分表單域
'在上傳上來的數據流中在每個表單域間都有一個隨機的分隔符,這個分隔符是在同一個流中不變的,不同的流分隔符不變,
'這個分隔符在流的最開頭,並且以一個chrb(13) + chrb(10)結束,知道這個後我們就可以用這個分隔符來遍歷拆分表單域了.
'對於文件域,我們要解析字段名,文件名,文件類型和文件內容,域名是以"name="為前導,並包含在一對雙引號中,文件名的值是以"filename="為前導,也包含在雙引號裡,其中包含文件的全路徑和文件名,緊跟著後面又是一對回車換行府(chrb(13) +chrb(10)),字符串"content-type:"和兩對回車換行之間的內容為文件類型字符串,兩對回車換行後到一對回車換行之間的數據為文件內容
'對於文本域,我們只要解析他的值就可以了,域的名稱是以"name="之後,用雙引號包著,兩對回車換行後到以一對回車換行開始的域分隔符之間為該文本域的值
'當然上傳上來的流是二進制格式,在操作的時候需要用一些操作二進制的函數,而不是平時用的操作字符串的函數,比如說leftB,midB,instrB等,下面就是算法的實現
Class GetPost
 private BdataStr,SeparationStr,wawa_stream '提交的信息,表單域間分隔字符
 '類初始化
 Private Sub Class_Initialize
  set wawa_stream=CreateObject("Adodb.Stream") '創建全局流
  wawa_stream.mode=3 '讀寫模式
  wawa_stream.type=1 '二進制讀取模式 
  wawa_stream.open '打開流
  BdataStr=Request.BinaryRead(Request.TotalBytes)'獲取上傳的所有數據
  wawa_stream.write BdataStr '讀取數據   
  SeparationStr=LeftB(BdataStr,Clng(inStrb(BdataStr,ChrB(13) + ChrB(10)))-1) '分隔字符串
 End Sub
 '類的析構函數,卸載全局流對像
 Private Sub Class_Terminate         
  wawa_stream.close
     set wawa_5xSoft_Stream=nothing
 End Sub
 '返回file型表單域的值(二進制)
 Public Function GetFile (FieldName)
  Dim L1,DataStart,DataLng
  L1 = InStrB(BdataStr,GetBinary("name=" + Chr(34) +FieldName +Chr(34)))
  DataStart = InStrB(L1,BdataStr,ChrB(13) + ChrB(10) + ChrB(13) + ChrB(10)) +4
  DataLng = InStrB(DataStart,BdataStr,SeparationStr) - DataStart -2
  GetFile =MidB(BdataStr,DataStart,DataLng)
 End Function
 '返回文件的類型
 Public Function GetFileType (FieldName)
  Dim L1,DataStart,DataLng
  L1 = InStrB(BdataStr,GetBinary("name=" + Chr(34) +FieldName +Chr(34)))
  DataStart = InStrB(L1,BdataStr,GetBinary("Content-Type:")) + 13
  DataLng = InStrB(DataStart,BdataStr,ChrB(13) + ChrB(10) + ChrB(13) + ChrB(10)) - DataStart
  GetFileType =GetText(MidB(BdataStr,DataStart,DataLng))
 End Function
 '返回文件的原始路徑
 Public Function GetFilePath (FieldName)
  Dim L1,DataStart,DataLng
  L1 = InStrB(BdataStr,GetBinary("name=" + Chr(34) +FieldName +Chr(34)))
  DataStart = InStrB(L1,BdataStr,GetBinary("filename=")) + 9
  DataLng = InStrB(DataStart,BdataStr,ChrB(13) + ChrB(10)) - DataStart
  GetFilePath = GetText(MidB(BdataStr,DataStart+1,DataLng-2)) '去掉最左邊和最右邊的雙引號,不知道為什麼右邊的雙引號要減去2
 End Function
 '返回原始文件的後綴名
 Function GetExtendName(FieldName)
  FileName = GetFilePath(FieldName)
  If isNull(FileName) or FileName="" Then
   GetExtendName=""
   Exit Function
  End If
  GetExtendName = Mid(FileName,InStrRev(FileName, "."))
 End Function
 '返回file型表單域的值(二進制)
 Public Function GetFileSize (FieldName)
  Dim L1,DataStart,DataLng
  L1 = InStrB(BdataStr,GetBinary("name=" + Chr(34) +FieldName +Chr(34)))
  DataStart = InStrB(L1,BdataStr,ChrB(13) + ChrB(10) + ChrB(13) + ChrB(10)) +4
  DataLng = InStrB(DataStart,BdataStr,SeparationStr) - DataStart -2
  GetFileSize = DataLng
 End Function
 '從二進制字符串裡取出表單域的值(字符串)
 Public Function RetFieldText (FieldName)
  Dim L1,DataStart,DataLng
  L1 = InStrB(BdataStr,GetBinary("name=" + Chr(34) +FieldName +Chr(34)))
  DataStart = InStrB(L1,BdataStr,ChrB(13) + ChrB(10) + ChrB(13) + ChrB(10)) +4
  DataLng = InStrB(DataStart,BdataStr,SeparationStr) - DataStart -2
  RetFieldText =GetText(MidB(BdataStr,DataStart,DataLng))
 End Function
 '返回一個時間和隨機數連接後的字符串,用於構建文件名
 Function getrandStr()
  Dim RanNum
  Randomize
  RanNum = Int(90000*rnd)+10000
  getrandStr = Year(now)&Month(now)&Day(now)&Hour(now)&Minute(now)&Second(now)&RanNum
 End Function

 '將二進制外碼系列轉換成vb字符串
 Private Function GetText (Str1r)
  Dim s,t,t1,i
  s = "":t="":t1=""
  For i =1 To LenB(str1r)
   t= AscB(MidB(Str1r,i,1)) '按字節取出外碼
   if not(t > 127) Then '字節高位為0,表示英文字符
    s = s + Chr(t)
   Else
    i = i +1 '當為漢字時,取第二個字節
    t1 = AscB(MidB(Str1r,i,1))
    s = s + Chr(t * 256 + t1) '將漢字兩字節外碼組合成ANSI碼
   End If
  Next
  GetText = s
 End Function
 '將字符串轉換為二進制系列
 Private Function GetBinary(str1)
  Dim T2,t1
  For i = 1 To Len(Str1)
   t1 = CStr(Hex(Asc(Mid(Str1,i,1))))
   If Len(t1)=2 Then
    T2 = T2 + ChrB(Clng("&h" + Trim(t1)))
   Else
    T2 = T2 + ChrB(Clng("&H") + Mid(Trim(t1),1,2))
    T2 = T2 + ChrB(Clng("&H") + Mid(Trim(t1),3,2))
   End If
  Next
  GetBinary = T2
 End Function
 '將上傳的文件保存在服務器的硬盤上
 Public Function SaveToFile (FieldName,fullpath)
  dim dr '定義創建一個流
  SaveToFile=""
  if trim(fullpath)="" or FileName="" then exit function '檢測參數是否有真實數據
  if right(fullpath,1)="/" then exit function '檢測路徑的正確性
  set dr=CreateObject("Adodb.Stream")
  dr.Mode=3 '讀寫模式
  dr.Type=1 '二進制模式
  dr.Open '打開
  Dim L1,DataStart,DataLng
  L1 = InStrB(BdataStr,GetBinary("name=" + Chr(34) +FieldName +Chr(34))) '獲取file域的位置
  DataStart = InStrB(L1,BdataStr,ChrB(13) + ChrB(10) + ChrB(13) + ChrB(10)) +4 '實體數據的開始位置
  DataLng = InStrB(DataStart,BdataStr,ChrB(13) + ChrB(10) + ChrB(13) + ChrB(10)) - DataStart '實體數據的大小
  wawa_stream.position=DataStart-1 '設置全局流的游標,因為全局流和全局數據BdataStr對應的
  wawa_stream.copyto dr,DataLng '從全局流裡獲取數據
  dr.SaveToFile FullPath,2 '保存在指定位置
  dr.Close '關閉流
  set dr=nothing  '析構流
  SaveToFile=Mid(FileName,InStrRev(FileName, "\")+1) '返回上傳文件的文件名
 End Function 
End Class
%>

<!-- conn.asp文件裡有數據庫連接字符串並打開數據庫 -->
<!--#include file="conn.asp" -->
<!-- getpost.asp文件包含上面的GetPost類 -->
<!--#include file="getpost.asp" -->
<%
'為了測試這個類,我們寫個html表單(在index.asp文件裡),裡面有兩個文本域txt1,txt2,兩個文件域file1,file2,我們再建立一個數據庫,裡面有4個字段,id,txt1,txt2,file1,file2,類型分別為文本,文本,文本,OLE格式,表名為mytable
Set o = new GetPost
Response.Write("file1的原始路徑是:" & o.GetFilePath ("file1") & "<br>")
Response.Write("file1的文件類型是:" & o.GetFileType ("file1") & "<br>")
Response.Write("file1的原始文件擴展文件名:" & o.GetExtendName ("file1") & "<br>")
Response.Write("file1的原始文件大小:" & o.GetFileSize ("file1") & "字節<br>")
filename=server.mappath("upload")& "\" & o.getrandStr()& o.GetExtendName("file1")
Response.Write("file1上傳後的位置:" & filename & "<br>")
dim file1name
file1name=o.SaveToFile ("file1",filename)
Response.Write (filename & "上傳成功<br>")
Dim rs,sql
set rs = server.CreateObject("adodb.recordset")
sql = "select txt1,txt2,file1,file2 from mytable"
rs.open sql,conn,1,3
rs.addnew
rs("txt1")= o.RetFieldText("txt1")
rs("txt2")= o.RetFieldText("txt2")
rs("file1") = file1name
rs("file2").appendchunk o.GetFile("file2") '把file2上傳的文件直接寫到數據庫裡
rs.update
rs.close
set rs=nothing
call closedata()  '關閉數據庫
Response.Redirect("index.asp")
%>