無組件上傳執行個體教程

<%
'當表單裡既有文本域又有檔案域的時候,我們必須把表單的編碼類別型設定成"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")
%>