<% '***************************************************************************************************** '************************************ xt_upload.asp ****************************************** '***************************************************************************************************** ' HTTP POST acceptor script ' Supports Multiple files of supported Images types (*.jpg, *.jpeg, *.gif, *.png, *.tiff) ' Copyright © 2001-2004 Ephox Pty Ltd. All rights reserved. ' The use of the source code and software is subject to the licence ' conditions included in this source release. See "Ephox Licence V4.doc" ' ' Coder: Craig Vandekamp ' Coder: Jonathan Hall ' ' Last Update: 20/11/2000 ' Last Update: 10/02/2001-2004 '***************************************************************************************************** '***************************************** Code Start ************************************************ '***************************************************************************************************** '********************************************************************************** '*********************************Set ImageUpload Directory Here************************ '********************************************************************************** Dim imageDir imageDir="../../images" server.scripttimeout=10000 '***************************************************************************************************** '*************************************** ReadRawData ************************************************* '***************************************************************************************************** Function ReadRawData(maxLength) Dim ContentType, PosB, Boundary, length, Fields, data, PosE, fieldHeader, fieldName Dim FieldB, FieldE, fileName, fieldValue Dim fieldArray, TotalBytes 'reads Content-Type header ContentType = LCase(Request.ServerVariables("HTTP_Content_Type")) 'Finds boundary PosB = InStr(ContentType, "boundary=") 'Separates boundary If PosB > 0 Then Boundary = Mid(ContentType, PosB + 9) Boundary=Str2Bin(Boundary) 'Read all binary data TotalBytes = Request.TotalBytes data = Request.BinaryRead(TotalBytes) Set Fields = CreateObject("Scripting.Dictionary") PosB=1 do while true PosB=InStrB(Posb, data, Boundary) + lenb(Boundary) 'Check for last boundary If MidB(data, PosB, 2)=Str2Bin("--") then exit do PosB=PosB+2 PosE=InStrB(PosB, data, chrb(13) & chrb(10) & chrb(13) & chrb(10) ) fieldHeader=Bin2Str( MidB(data,posb,pose-posb) ) fieldName="" FieldB=InStr(fieldHeader, "name=""" ) if FieldB>0 then FieldB=FieldB + 6 FieldE=InStr(FieldB, fieldHeader, """" ) fieldName=Mid(fieldHeader, FieldB, FieldE-FieldB) end if fileName="" FieldB=InStr(fieldHeader, "filename=""" ) if FieldB>0 then FieldB=FieldB + 10 FieldE=InStr(FieldB, fieldHeader, """" ) fileName=Mid(fieldHeader, FieldB, FieldE-FieldB) end if PosB=PosE+4 PosE=InStrB(Posb, data, Boundary)-4 fieldValue="" fieldValue=MidB(data,posb,pose-posb) Fields.add fieldName, array(fieldValue, fileName) 'response.write fieldName & " - " & fileName & " value: "& fieldValue &"
" loop set ReadRawData=fields End Function '***************************************************************************************************** '******************************************** SaveFile *********************************************** '***************************************************************************************************** ' save the file(s) on the server Function SaveFile(PathName, FileData) Dim FS, File, i Set FS = Server.CreateObject("Scripting.FileSystemObject") Set File = FS.CreateTextFile(PathName , true) For i = 1 to lenb(FileData) File.Write Chr(AscB(MidB( FileData, i, 1 ))) Next 'Clean up objects File.Close Set File=nothing Set FS=nothing End Function '**************************************************************************************************** '********************************************** Bin2Str ********************************************* '**************************************************************************************************** ' convert binary data to its string equivalent Function Bin2Str(Bin) Dim i, S For i = 1 To LenB(Bin) S = S & Chr(AscB( MidB(Bin, i, 1) )) Next Bin2Str = S End Function '**************************************************************************************************** '******************************************** Str2Bin *********************************************** '**************************************************************************************************** ' convert a string to its binary equivalent Function Str2Bin(Str) Dim i, B For i=1 to len(Str) B = B & ChrB(Asc( Mid(Str,i,1) )) Next Str2Bin = B End Function '*************************************************************************************** '******************************** Save Routine ***************************************** '*************************************************************************************** ' perform the actual save Response.Expires = 0 Response.Buffer = TRUE Dim Fields, FileData, PathName, curDir Dim arrPath Dim i, FieldsKeys ' get the data from the safe array and place in Dictionary Obj set Fields=ReadRawData(0) '************************************** 'The absolute or relative path to point 'to the dir where files will be uploaded to '************************************** curDir = Server.MapPath(imagedir) '*************************************** ' get the data from the Dictonary object ' and save it '*************************************** FieldsKeys = Fields.Keys For i = 0 To Fields.Count -1 'Iterate the array FileData=Fields(FieldsKeys(i))(0) PathName=Fields(FieldsKeys(i))(1) if PathName<>"" then arrPath=split(PathName,"\") OnlyFileName = arrPath(ubound(arrPath) ) OnlyExtention = Right(OnlyFileName, Len(OnlyFileName) - InStrRev(OnlyFileName, ".")) if OnlyExtention="jpeg" or _ OnlyExtention="jpg" or _ OnlyExtention="tiff" or _ OnlyExtention="png" or _ OnlyExtention="gif" then call SaveFile(curDir & "\" & OnlyFileName, FileData) end if end if Next '*************************************************************************************** '*********************************** Code End ****************************************** '*************************************************************************************** %>