ByteArray - accept very large data in POST/PUT request, ASP, VBScript | ||
Sample for ScriptUtils.ByteArray.SaveAs |
ByteArray - accept very large data in POST/PUT request, ASP, VBScript | |
---|---|
<% 'This sample demonstrates store of large binary data. 'It accepts up to 2GB of a source data a PUT or POST SaveLargePostData "C:\temp\uploaddata.dat" Sub SaveLargePostData(DestFile) Const BlockSize = 4096 Dim TotalBytes, DataReaded, ReadBlockSize, BinaryData TotalBytes = Request.TotalBytes If TotalBytes > 0 Then Dim ByteArray: Set ByteArray = GetByteArray() For DataReaded = 0 To TotalBytes Step BlockSize If BlockSize + DataReaded > TotalBytes Then 'Last block, IIS6 does not accept to read more data ReadBlockSize = TotalBytes - DataReaded Else ReadBlockSize = BlockSize End If ByteArray.ByteArray = Request.BinaryRead(ReadBlockSize ) 'Save the block of a source data. If DataReaded = 0 Then 'The first block will overwrite existing file (if one) ByteArray.SaveAs DestFile Else 'Position of SaveAs (second parameter) is based to 1 ByteArray.SaveAs DestFile, 1 + DataReaded End If Next ' DataReaded Response.Write "<br>Source data (" & TotalBytes & _ "B) was saved to '" & DestFile & "'" End If ' TotalBytes>0 then End Sub 'Returns ByteArray object. Solves problem with registration and installation Function GetByteArray() On Error Resume Next Dim Binary Set Binary = CreateObject("ScriptUtils.ByteArray") 'Creates ByteArray object 'response.write hex(Err) If Err = &h46 Then On Error Goto 0 Err.Raise 5, "ScriptUtils.ByteArray", "Insufficient permissions to the scptult.ocx file. User: '" & GetUserName & "' must have read permission to the file." ElseIf Err = &h1ad Then On Error Goto 0 Err.Raise 6, "ScriptUtils.ByteArray", "Script Utilities is not correctly installed. Please, install Script Utilities on this server or copy and register scptutl.ocx file on this server." ElseIf Err = &h8007045A Then On Error Goto 0 Err.Raise 6, "ScriptUtils.ByteArray", "The evaluation version of Script Utilities was expired. Please install full version." ElseIf Err = &h8007007E Then On Error Goto 0 Err.Raise 6, "ScriptUtils.ByteArray", "The ScriptUtilities library (scptutl.ocx) is missing. Please copy the library or reinstall the software." ElseIf Err <> 0 Then Dim E, N N = Hex(Err) E = Err.Description On Error Goto 0 Err.Raise 6, "ScriptUtils.ByteArray", "Cannot create ScriptUtils.ByteArray object, Error: '" & N & " " & E & "'" End If Set GetByteArray = Binary End Function %> |