ATB ソース・コード

南西農業情報ネットワーク 表示する fupload.incソースコード

戻る ダウンロード南西農業情報ネットワーク: 個別にダウンロードfupload.incソースコード - 全体をダウンロード南西農業情報ネットワークソースコード - タイプ:.inc
  1. <SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT>
  2. '限制上传图片大小
  3. Dim UploadSizeLimit
  4.  
  5. '********************************** 得到上传数据 **********************************
  6. Function GetUpload()
  7. Dim Result
  8. Set Result = Nothing
  9. If Request.ServerVariables("REQUEST_METHOD") = "POST" Then 'Request method must be "POST"
  10. Dim CT, PosB, Boundary, Length, PosE
  11. CT = Request.ServerVariables("HTTP_Content_Type") 'reads Content-Type header
  12. If LCase(Left(CT, 19)) = "multipart/form-data" Then 'Content-Type header must be "multipart/form-data"
  13. 'This is upload request.
  14. 'Get the boundary and length from Content-Type header
  15. PosB = InStr(LCase(CT), "boundary=") 'Finds boundary
  16. If PosB > 0 Then Boundary = Mid(CT, PosB + 9) 'Separetes boundary
  17. Length = CLng(Request.ServerVariables("HTTP_Content_Length")) 'Get Content-Length header
  18. if "" & UploadSizeLimit<>"" then
  19. UploadSizeLimit = clng(UploadSizeLimit)
  20. if Length > UploadSizeLimit then
  21. ' on error resume next 'Clears the input buffer
  22. ' response.AddHeader "dsconnection", "Close"
  23. ' on error goto 0
  24. Request.BinaryRead(Length)
  25. Err.Raise 2, "GetUpload", "Upload size " & FormatNumber(Length,0) & "B exceeds limit of " & FormatNumber(UploadSizeLimit,0) & "B"
  26. exit function
  27. end if
  28. end if
  29.  
  30. If Length > 0 And Boundary <> "" Then 'Are there required informations about upload ?
  31. Boundary = "--" & Boundary
  32. Dim Head, Binary
  33. Binary = Request.BinaryRead(Length) 'Reads binary data from client
  34.  
  35. 'Retrieves the upload fields from binary data
  36. Set Result = SeparateFields(Binary, Boundary)
  37. Binary = Empty 'Clear variables
  38. Else
  39. Err.Raise 10, "GetUpload", "Zero length request ."
  40. End If
  41. Else
  42. Err.Raise 11, "GetUpload", "No file sent."
  43. End If
  44. Else
  45. Err.Raise 1, "GetUpload", "Bad request method."
  46. End If
  47. Set GetUpload = Result
  48. End Function
  49.  
  50.  
  51. Function SeparateFields(Binary, Boundary)
  52. Dim PosOpenBoundary, PosCloseBoundary, PosEndOfHeader, isLastBoundary
  53. Dim Fields
  54. Boundary = StringToBinary(Boundary)
  55.  
  56. PosOpenBoundary = InstrB(Binary, Boundary)
  57. PosCloseBoundary = InstrB(PosOpenBoundary + LenB(Boundary), Binary, Boundary, 0)
  58.  
  59. Set Fields = CreateObject("Scripting.Dictionary")
  60.  
  61. Do While (PosOpenBoundary > 0 And PosCloseBoundary > 0 And Not isLastBoundary)
  62. 'Header and file/source field data
  63. Dim HeaderContent, FieldContent
  64. 'Header fields
  65. Dim Content_Disposition, FormFieldName, SourceFileName, Content_Type
  66. 'Helping variables
  67. Dim Field, TwoCharsAfterEndBoundary
  68. 'Get end of header
  69. PosEndOfHeader = InstrB(PosOpenBoundary + Len(Boundary), Binary, StringToBinary(vbCrLf + vbCrLf))
  70.  
  71. 'Separates field header
  72. HeaderContent = MidB(Binary, PosOpenBoundary + LenB(Boundary) + 2, PosEndOfHeader - PosOpenBoundary - LenB(Boundary) - 2)
  73.  
  74. 'Separates field content
  75. FieldContent = MidB(Binary, (PosEndOfHeader + 4), PosCloseBoundary - (PosEndOfHeader + 4) - 2)
  76.  
  77. 'Separates header fields from header
  78. GetHeadFields BinaryToString(HeaderContent), Content_Disposition, FormFieldName, SourceFileName, Content_Type
  79.  
  80. 'Create one field and assign parameters
  81. Set Field = CreateUploadField()
  82. Field.Name = FormFieldName
  83. Field.ContentDisposition = Content_Disposition
  84. Field.FilePath = SourceFileName
  85. Field.FileName = GetFileName(SourceFileName)
  86. Field.ContentType = Content_Type
  87. Field.Value = FieldContent
  88. Field.Length = LenB(FieldContent)
  89.  
  90.  
  91. Fields.Add FormFieldName, Field
  92.  
  93. 'Is this ending boundary ?
  94. TwoCharsAfterEndBoundary = BinaryToString(MidB(Binary, PosCloseBoundary + LenB(Boundary), 2))
  95. 'Binary.Mid(PosCloseBoundary + Len(Boundary), 2).String
  96. isLastBoundary = TwoCharsAfterEndBoundary = "--"
  97. If Not isLastBoundary Then 'This is not ending boundary - go to next form field.
  98. PosOpenBoundary = PosCloseBoundary
  99. PosCloseBoundary = InStrB(PosOpenBoundary + LenB(Boundary), Binary, Boundary )
  100. End If
  101. Loop
  102. Set SeparateFields = Fields
  103. End Function
  104.  
  105. '********************************** Utilities **********************************
  106. Function BinaryToString(str)
  107. strto = ""
  108. for i=1 to lenb(str)
  109. if AscB(MidB(str, i, 1)) > 127 then
  110. strto = strto & chr(Ascb(MidB(str, i, 1))*256+Ascb(MidB(str, i+1, 1)))
  111. i = i + 1
  112. else
  113. strto = strto & Chr(AscB(MidB(str, i, 1)))
  114. end if
  115. next
  116. BinaryToString=strto
  117. End Function
  118.  
  119. Function StringToBinary(String)
  120. Dim I, B
  121. For I=1 to len(String)
  122. B = B & ChrB(Asc(Mid(String,I,1)))
  123. Next
  124. StringToBinary = B
  125. End Function
  126.  
  127. 'Separates header fields from upload header
  128. Function GetHeadFields(ByVal Head, Content_Disposition, Name, FileName, Content_Type)
  129. Content_Disposition = LTrim(SeparateField(Head, "content-disposition:", ";"))
  130. Name = (SeparateField(Head, "name=", ";")) 'ltrim
  131. If Left(Name, 1) = """" Then Name = Mid(Name, 2, Len(Name) - 2)
  132. FileName = (SeparateField(Head, "filename=", ";")) 'ltrim
  133. If Left(FileName, 1) = """" Then FileName = Mid(FileName, 2, Len(FileName) - 2)
  134. Content_Type = LTrim(SeparateField(Head, "content-type:", ";"))
  135. End Function
  136.  
  137. 'Separets one filed between sStart and sEnd
  138. Function SeparateField(From, ByVal sStart, ByVal sEnd)
  139. Dim PosB, PosE, sFrom
  140. sFrom = LCase(From)
  141. PosB = InStr(sFrom, sStart)
  142. If PosB > 0 Then
  143. PosB = PosB + Len(sStart)
  144. PosE = InStr(PosB, sFrom, sEnd)
  145. If PosE = 0 Then PosE = InStr(PosB, sFrom, vbCrLf)
  146. If PosE = 0 Then PosE = Len(sFrom) + 1
  147. SeparateField = Mid(From, PosB, PosE - PosB)
  148. Else
  149. SeparateField = Empty
  150. End If
  151. End Function
  152.  
  153. 'Separetes file name from the full path of file
  154. Function GetFileName(FullPath)
  155. Dim Pos, PosF
  156. PosF = 0
  157. For Pos = Len(FullPath) To 1 Step -1
  158. Select Case Mid(FullPath, Pos, 1)
  159. Case "/", "\": PosF = Pos + 1: Pos = 0
  160. End Select
  161. Next
  162. If PosF = 0 Then PosF = 1
  163. GetFileName = Mid(FullPath, PosF)
  164. End Function
  165. </SCRIPT>
  166. <SCRIPT RUNAT=SERVER LANGUAGE=JSCRIPT>
  167. //The function creates Field object.
  168. function CreateUploadField(){ return new uf_Init() }
  169. function uf_Init(){
  170. this.Name = null
  171. this.ContentDisposition = null
  172. this.FileName = null
  173. this.FilePath = null
  174. this.ContentType = null
  175. this.Value = null
  176. this.Length = null
  177. }
  178. </SCRIPT>
  179.  
個別にダウンロードfupload.incソースコード - 全体をダウンロード南西農業情報ネットワークソースコード
関連するソース/ソフトウェア:
ZWMOBI 3 G ウェブサイト システムの構築 - モバイル B2C のモバイル ショッピングを含む、強力なビジネス モジュール ダウンロード機能モジュ... 3.89KB
キャンパス サイト システム v2.0 として - ほとんどの学校には、キャンパスのウェブサイトの便利なメンテナンスの強力な機能を構築する私は、簡単な物... 44.88KB
シーティング システム 7 夜学生 - シーティング システム夜学生が促進クラスのすべての教師は、もはやように「こんにちはこんにちはこんにち... 26.4KB
94KK には消極的ネットワーク コミュニティ美化 bate3 (新しい年版) - カーネル KB 94kkBBS フォーラム、新しい造園、速度と機能がさらに強化 !新しいスタ... 24.82KB
QQ のフラッシュの言葉 - 1。 今計り知れないほど、ネットワーク上の他のプログラムでは、強力な DIY の機能ほど厳密ではどの... 67KB
系統のひずみの美しい個人の家の Build20061004 をページします。 - -----------修正部分-------------1: PPsTREAM 映画オンライ... 7.7KB
梅 Windows ネットワーク - 機能をについて説明します。Windows のホーム | 垂直方向と水平方向のニュース | 電... 34.61KB
中国のソースをダウンロード システム v1.0 - この 3-イノベーション システムでダウンロードしたプログラムを美化するには、独立した管理の背景を広... 5.26KB
南西農業情報ネットワーク - 南西農業情報ネットワーク、農業システム 98.89KB
Zoomla ! Eall CMS v2.0 - Eall CMS のウェブ マスターが最適なカーネルを開いている、無料で強力な Web サイト管理サ... 11.31KB

 トップへ戻る