返回列表 发帖

主题
0 
积分
0 
贝壳
0 个 
注册时间
2006-11-29 
最后登录
2006-11-29 
楼主 跳转到 » 倒序看帖
打印
tT
chinanic发表于 2007-2-1 23:52 | 只看该作者

[讨论]突破IIS6.0文件上传200KB限制 之 VB版本源代码

[这个贴子最后由chinanic在 2007/02/02 01:27am 第 2 次编辑]
[color=#FF008C] 注意：本程序是参考风声无组件上传类的一些东西做出来D，仅供学习。 属性： MaxSize 每个上传文件的最大字节数 默认值：204800 特征值：0表示文件大小不受限制 FileType 允许上传的文件类型 默认值："gif/jpg" 特征值：""表示文件类型不受限制（空） SavePath 文件存放的路径，可以是相对路径 默认值：""　即当前目录 AutoSave 设置Open方法处理文件的方式，对其他方法无效 默认值：0 可选值： 　　0：取无重复的服务器时间字符串为文件名自动保存文件 　　1：取源文件名自动保存文件 Version 返回类版本说明 Error 返回当前文件保存状态 -1：没有文件上传 0：正常 1：有文件超过大小 2：有文件类型不正确 3：文件保存路径出错，越过安全范围 方法： Sub Upload() 打开对象，获取数据并保存；打开之前可以重定义对象参数属性MaxSize等。 Form(Item) 对于其他表单元素：(假设表单元素名为item) 　　Form(item)　　　　　表单元素对应的Value值 对于file表单元素：(假设表单元素名为item) 　　Form(item)　　　　　文件上传后的文件名 　　Form(item&"_Type")　文件类型，例"image/gif" 　　Form(item&"_Name")　原文件名 　　Form(item&"_Path")　原文件本地上传路径 　　Form(item&"_Size")　文件字节数 　　Form(item&"_Ext") 　文件扩展名 　　Form(item&"_Err") 　该文件上传状态 　　　　-1：没有文件上传 　　　　0：正常 　　　　1：文件超过大小 　　　　2：文件类型不正确 3：文件保存路径出错，越过安全范围 自动建立文件夹功能： 如果您手工设置的SavePath不存在，程序会自动创建路径 在VB中需要添加的引用： Microsoft Scripting Runtime Microsoft ActiveX Data Objects 2.6 Library Microsoft Active Server Page Object Library
  1. Dim myResponse As Response
  2. Dim myRequest As Request
  3. Dim myApplication As Application
  4. Dim myServer As Server
  5. Dim mySession As Session
  6. Public bCrLf As String, ReadBytes As Long, ToRead As Long
  7. Public intSeparator As Integer, strFileData As String, strUpLoadData As String
  8. Public strSeparator As String, strSaveFName As String, strFileSavePath As String
  9. Public File_start As Long, File_end As Long, strDate As String, lngTime As Long
  10. Public strItem As String, strItemName As String, intTemp As Long, strTemp As String
  11. Public strFileType As String, strFileName As String, strFileExt As String, LngFileSize As Long
  12. Public Err_Code As Integer
  13. Dim File_SavePath As String, p_MaxSize As Long, p_FileType As String, p_SavePath As String, p_AutoSave As Integer
  14. ';建立ADODB.Stream对象
  15. Public objStream As New ADODB.Stream
  16. Public binItem As New ADODB.Stream
  17. ';Dictionary对象，用于保存
  18. Public objForm As New Scripting.Dictionary
  19. ';当组件被创建的时候会触发这个事件
  20. Public Sub OnStartPage(myScriptingContent As ScriptingContext)
  21. ';进行对象的实例化
  22. Set myResponse = myScriptingContent.Response
  23. Set myRequest = myScriptingContent.Request
  24. Set myServer = myScriptingContent.Server
  25. Set myApplication = myScriptingContent.Application
  26. Set mySession = myScriptingContent.Session
  27. End Sub
  28. ';当组件被销毁的时候触发这个事件
  29. Public Sub OnEndPage()
  30. ';销毁对象
  31. Set myResponse = Nothing
  32. Set myRequest = Nothing
  33. Set myServer = Nothing
  34. Set myApplication = Nothing
  35. Set mySession = Nothing
  36. End Sub
  37. ';初始化上传参数
  38. Public Sub Class_Initialize()
  39. ';错误代码初始化：-1表示没有文件上传
  40. Err_Code = -1
  41. ';允许的文件大小为150KB
  42. p_MaxSize = 204800
  43. ';允许的文件类型为jpg/gif
  44. p_FileType = "jpg/gif"
  45. ';文件保存路径为空，即当前目录
  46. p_SavePath = ""
  47. ';文件保存方式默认为自动
  48. p_AutoSave = 0
  49. ';取当前日期生成字符串
  50. strDate = Replace(CStr(Date), "-", "")
  51. lngTime = CLng(Timer() * 1000)
  52. ';比较方式为“文本比较”
  53. objForm.CompareMode = 1
  54. End Sub
  55. ';版权属性 Version
  56. Public Property Get Version() As String
  57. Version = "CodeWorld Upload Class V1.0"
  58. End Property
  59. ';错误代码 Error
  60. Public Property Get Error() As Integer
  61. Error = Err_Code
  62. End Property
  63. ';允许的文件大小 MaxSize
  64. Public Property Get MaxSize() As Long
  65. MaxSize = p_MaxSize
  66. End Property
  67. Public Property Let MaxSize(ByVal LngFSize As Long)
  68. If IsNumeric(LngFSize) Then
  69. p_MaxSize = CLng(LngFSize)
  70. End If
  71. End Property
  72. ';允许的文件类型 FileType
  73. Public Property Get FileType() As String
  74. FileType = p_FileType
  75. End Property
  76. Public Property Let FileType(ByVal strType As String)
  77. p_FileType = strType
  78. End Property
  79. ';保存路径
  80. Public Property Get SavePath() As String
  81. SavePath = p_SavePath
  82. End Property
  83. Public Property Let SavePath(ByVal strPath As String)
  84. p_SavePath = Replace(strPath, Chr(0), "")
  85. End Property
  86. ';是否自动保存
  87. Public Property Get AutoSave() As Integer
  88. AutoSave = p_AutoSave
  89. End Property
  90. Public Property Let AutoSave(ByVal Flag As Integer)
  91. Select Case Flag
  92. Case 0: Flag = 0
  93. Case 1: Flag = 1
  94. Case Else: Flag = 0
  95. End Select
  96. p_AutoSave = Flag
  97. End Property
  98. Public Sub Class_Terminate()
  99. binItem.Close
  100. objStream.Close
  101. Set objStream = Nothing
  102. Set binItem = Nothing
  103. End Sub
  104. Public Sub Upload()
  105. If Err_Code = -1 Then
  106. Err_Code = 0
  107. Else
  108. Exit Sub
  109. End If
  110. ';回车换行符的二进制数据
  111. bCrLf = ChrB(13) & ChrB(10)
  112. ReadBytes = 0
  113. ';IIS6.0的限制的大小
  114. ToRead = 200000
  115. ';指定返回数据类型 adTypeBinary=1,adTypeText=2
  116. objStream.Type = 1
  117. ';指定打开模式 adModeRead=1,adModeWrite=2,adModeReadWrite=3
  118. objStream.Mode = 3
  119. objStream.Open
  120. binBytes = myRequest.TotalBytes
  121. If binBytes = 0 Then
  122. ';错误输出：没有上传任何数据
  123. Err_Code = -1
  124. Exit Sub
  125. End If
  126. ';判断提交的数据是否超过限制，如果没有则按原大小读取
  127. Do While ReadBytes < binBytes
  128. ';提交的数据或最后一次所取数据可能不足200K，加个判断即可取得精确数据长度
  129. If ToRead > binBytes - ReadBytes Then
  130. ToRead = binBytes - ReadBytes
  131. End If
  132. objStream.Write myRequest.BinaryRead(ToRead)
  133. ReadBytes = ReadBytes + ToRead
  134. Loop
  135. ';设置对象指针位置
  136. objStream.Position = 0
  137. objStream.Type = 2
  138. strUpLoadData = objStream.ReadText
  139. ';取得分界符的长度
  140. intSeparator = InStrB(1, strUpLoadData, bCrLf) - 1
  141. ';取得分界符
  142. strSeparator = LeftB(strUpLoadData, intSeparator)
  143. ';数据块开始位置=分界符长度加上1个回车符，再加上一个文件块的首字符
  144. File_start = intSeparator + 2
  145. ';在两个回车符处结束，获得数据头部信息
  146. File_end = InStrB(File_start, strUpLoadData, bCrLf & bCrLf) + 3
  147. ';指定binItem对象返回的数据为二进制
  148. binItem.Type = 1
  149. ';打开对象
  150. binItem.Open
  151. ';设置objStream对象当前指针位置
  152. objStream.Position = File_start
  153. ';将objStream中的第一段数据复制入binItem中
  154. objStream.CopyTo binItem, File_end - File_start
  155. binItem.Position = 0
  156. binItem.Type = 2
  157. binItem.Charset = "gb2312"
  158. strItem = binItem.ReadText
  159. binItem.Close
  160. ';下一段数据开始位置
  161. File_start = File_end
  162. ';下一块的结束位置，注意要减去一个分界符位
  163. File_end = InStrB(File_start, strUpLoadData, strSeparator) - 1
  164. binItem.Type = 1
  165. binItem.Open
  166. ';重置objStream指针位置
  167. objStream.Position = File_start
  168. ';数据块长度，即文件大小
  169. LngFileSize = File_end - File_start - 2
  170. If LngFileSize = 0 Then
  171. ';错误输出：没有上传任何数据
  172. Err_Code = -1
  173. Exit Sub
  174. End If
  175. ';将文件数据拷入binItem
  176. objStream.CopyTo binItem, LngFileSize
  177. ';下面进行头部分析工作
  178. ';39是“Content-Disposition: form-data; name="”的长度，在此后面找到的第一个双引号为表单域名结束
  179. intTemp = InStr(39, strItem, """")
  180. ';取得表单域名
  181. strItemName = Mid(strItem, 39, intTemp - 39)
  182. ';从表单域名后开始查找文件名
  183. If InStr(intTemp, strItem, "filename=""") <> 0 Then
  184. intTemp = intTemp + 13
  185. ';获取文件类型即第一块中“Content-Type: ”的位置+14
  186. strFileType = Mid(strItem, InStr(intTemp, strItem, "Content-Type: ") + 14)
  187. ';得到文件完整源路径
  188. strTemp = Mid(strItem, intTemp, InStr(intTemp, strItem, """") - intTemp)
  189. intTemp = InStrRev(strTemp, "\")
  190. ';得到文件名
  191. strFileName = Mid(strTemp, intTemp + 1)
  192. End If
  193. ';取得文件扩展名
  194. If InStr(intTemp, strTemp, ".") <> 0 Then
  195. strFileExt = Mid(strTemp, InStrRev(strTemp, ".") + 1)
  196. Else
  197. strFileExt = ""
  198. End If
  199. If Not objForm.Exists(strItem & "_From") Then
  200. ';将文件类型、文件名、文件本地路径、文件大小保存到对象
  201. objForm.Add strItemName & "_Type", strFileType
  202. objForm.Add strItemName & "_Name", strFileName
  203. objForm.Add strItemName & "_Path", Left(strTemp, intTemp)
  204. objForm.Add strItemName & "_Size", LngFileSize
  205. objForm.Add strItemName & "_Ext", strFileExt
  206. objForm.Add strItemName & "_Err", -1
  207. End If
  208. If InStr(1, LCase("/" & p_FileType & "/"), LCase("/" & strFileExt & "/")) = 0 And p_FileType <> "" Then
  209. ';错误输出：文件类型不正确
  210. Err_Code = 2
  211. Exit Sub
  212. End If
  213. ';文件大小检查
  214. If LngFileSize > p_MaxSize And p_MaxSize <> 0 Then
  215. ';错误输出：文件大小超过限制
  216. Err_Code = 1
  217. Exit Sub
  218. End If
  219. ';取文件名
  220. If p_AutoSave = 0 Then
  221. strSaveFName = GetTimeStr()
  222. strSaveFName = strSaveFName & "." & strFileExt
  223. Else
  224. strSaveFName = strFileName
  225. End If
  226. ';去除头尾斜杠
  227. p_SavePath = ReMoveBias(p_SavePath)
  228. ';过滤不安全字符
  229. p_SavePath = ReplaceFileName(p_SavePath)
  230. ';保证保存路径完整性
  231. Call CreateSavePath(p_SavePath)
  232. ';安全边界检查，是否越过网站根路径
  233. If Not CheckSavePath(p_SavePath) Then
  234. ';错误输出：保存路径出错，越过安全范围
  235. Err_Code = 3
  236. Exit Sub
  237. End If
  238. strFileSavePath = ""
  239. strFileSavePath = "./" & p_SavePath & "/" & strSaveFName
  240. ';储存文件
  241. binItem.SaveToFile myServer.MapPath(strFileSavePath)
  242. objForm.Add strItemName & "_SavePath", Right(strFileSavePath, Len(strFileSavePath) - 2)
  243. End Sub
  244. ';根据当前日期时间生成文件名
  245. Public Function GetTimeStr()
  246. lngTime = lngTime + 1
  247. GetTimeStr = strDate & lngTime
  248. End Function
  249. ';获取对象中保存的数据
  250. Public Function Form(ByVal Item As String)
  251. If objForm.Exists(Item) Then
  252. Form = objForm(Item)
  253. Else
  254. Form = ""
  255. End If
  256. End Function
  257. ';保证保存路径完整性
  258. Private Sub CreateSavePath(ByVal strPath As String)
  259. ';创建FSO对象
  260. Dim fsoPath As New Scripting.FileSystemObject
  261. Dim strCheckPath As String
  262. strCheckPath = myServer.MapPath("./")
  263. ';利用数组保存文件夹
  264. Arr_strPath = Split(strPath, "/")
  265. ';从上到下循环建立
  266. For i = 0 To UBound(Arr_strPath)
  267. If Arr_strPath(i) <> "" Then
  268. strCheckPath = strCheckPath & "\" & Arr_strPath(i)
  269. If Not fsoPath.FolderExists(strCheckPath) Then
  270. ';如果不存在就创建
  271. fsoPath.CreateFolder (strCheckPath)
  272. End If
  273. End If
  274. Next i
  275. End Sub
  276. ';过滤不安全字符
  277. Private Function ReplaceFileName(ByVal strPath As String)
  278. strPath = Replace(strPath, ":", "")
  279. strPath = Replace(strPath, "\", "")
  280. strPath = Replace(strPath, "*", "")
  281. strPath = Replace(strPath, """", "")
  282. strPath = Replace(strPath, "<", "")
  283. strPath = Replace(strPath, ">", "")
  284. strPath = Replace(strPath, "|", "")
  285. ReplaceFileName = strPath
  286. End Function
  287. ';去掉头尾“/”或“./”
  288. Private Function ReMoveBias(ByVal strPath As String)
  289. If Asc(Mid(strPath, Len(strPath), 1)) = 47 Then
  290. strPath = Left(strPath, Len(strPath) - 1)
  291. End If
  292. If Asc(Mid(strPath, 1, 1)) = 47 Then
  293. strPath = Right(strPath, Len(strPath) - 1)
  294. End If
  295. If Asc(Mid(strPath, 1, 1)) = 46 And Asc(Mid(strPath, 2, 1)) = 47 Then
  296. strPath = Right(strPath, Len(strPath) - 2)
  297. End If
  298. ReMoveBias = strPath
  299. End Function
  300. ';安全边界检查，是否越过网站根路径
  301. Function CheckSavePath(ByVal strSavePath As String) As Boolean
  302. Dim strPath As String, intSplit As Integer, intLayer As Integer
  303. intSplit = 0
  304. ';取得当前文件所在路径
  305. strPath = myRequest.ServerVariables("SCRIPT_NAME")
  306. If Asc(Mid(strPath, 1, 1)) = 47 Then
  307. strPath = Right(strPath, Len(strPath) - 1)
  308. End If
  309. arrPath = Split(strPath, "/")
  310. ';得到当前文件层次
  311. intLayer = UBound(arrPath)
  312. arrSavePath = Split(strSavePath, "/")
  313. ';得到允许层次
  314. For i = 0 To UBound(arrSavePath)
  315. If arrSavePath(i) = ".." Then
  316. intSplit = intSplit + 1
  317. End If
  318. Next
  319. If intSplit > intLayer Then
  320. CheckSavePath = False
  321. Else
  322. CheckSavePath = True
  323. End If
  324. End Function
复制代码
[color=#FF0059]ASP版本的文件夹创建
  1. <%
  2. Public Sub CheckPath(strPath)
  3. ';创建FSO对象
  4. set fsoPath=Server.CreateObject("Scripting.FileSystemObject")
  5. Dim strCheckPath
  6. ';去掉头尾“/”
  7. If Asc(Mid(strPath, Len(strPath), 1)) = 47 Then
  8. strPath = Left(strPath, Len(strPath) - 1)
  9. End If
  10. If Asc(Mid(strPath, 1, 1)) = 47 Then
  11. strPath = Right(strPath, Len(strPath) - 1)
  12. End If
  13. ';利用数组保存文件夹
  14. Arr_strPath = Split(strPath, "/")
  15. strCheckPath = Server.MapPath("/")
  16. For i = 0 To UBound(Arr_strPath)
  17. If Arr_strPath(i) <> "" Then
  18. strCheckPath = strCheckPath & "\" & Arr_strPath(i)
  19. If Not fsoPath.FolderExists(strCheckPath) Then
  20. ';如果不存在就创建
  21. fsoPath.CreateFolder (strCheckPath)
  22. End If
  23. End If
  24. Next
  25. End Sub
  26. Call CheckPath("/UploadFiles/aaa/bbb/add/aaaadsa/asdfaaa/aaasdwa/adfaa/afaa//")
  27. %>
复制代码
收藏 分享

返回列表 回复 发帖