[ Bole89 @ 15.09.2006. 22:12 ] @
HITNO mi je potrebna asp skripta za upload fajla na server. Ako neko zna gdje to mogu naci neka mi pomogne!!! HITNO POTREBNO! |
[ Bole89 @ 15.09.2006. 22:12 ] @
[ Alberto @ 19.09.2006. 03:14 ] @
Ako si mislio na "klasicni" ASP to zavisi od servera na kojem hostujes prezentaciju jer ASP nema ugradjenu tu mogucnost (kao recimo PHP).
Dakle, raspitaj se kod tvog hosting provajdera. [ don-t @ 05.03.2009. 10:53 ] @
Evo koju ja koristim, nadjoh nekad na netu:
Code: <% function AddSlash(Path) if Right(Path, 1) = "\" then AddSlash = Path else AddSlash = Path & "\" end function function RemoveSlash(Path) if Right(Path, 1) = "\" and Mid(Path, len(Path) - 1, 1) <> ":" then RemoveSlash = Left(Path, len(Path) - 1) else RemoveSlash = Path end function function GetParentPath(Path) dim I, J I = InStrRev(Path, "\") J = InStrRev(Path, "\", I - 1) if I - J = 1 or J < 1 then GetParentPath = Left(Path, I) else GetParentPath = Left(Path, I - 1) end function function MapPath(Path) if InStr(Path, ":") > 0 or Left(Path, 2) = "\\" then MapPath = Path else MapPath = Server.MapPath(Path) if Right(Path, 1) = "\" then MapPath = AddSlash(MapPath) end if end function function MakeDir(Path) dim I, J, S, FSO, Paths() set FSO = Server.CreateObject("Scripting.FileSystemObject") I = 0 S = Path do redim preserve Paths(I) Paths(I) = S S = FSO.GetParentFolderName(S) I = I + 1 loop while S <> "" J = 0 do while J < I if FSO.FolderExists(Paths(J)) then exit do J = J + 1 loop J = J - 1 do while J > -1 FSO.CreateFolder Paths(J) J = J - 1 loop end function function GetNextNumberedFilename(Filename, Digits) dim FSO, PathAndBaseName, ExtentionName, Count, S, I set FSO = Server.CreateObject("Scripting.FileSystemObject") ExtentionName = FSO.GetExtensionName(Filename) if ExtentionName <> "" then ExtentionName = "." & ExtentionName PathAndBaseName = Left(Filename, len(Filename) - len(ExtentionName)) Count = 0 do Count = Count + 1 GetNextNumberedFilename = PathAndBaseName & string(Digits - len(cstr(Count)), "0") & Count & ExtentionName loop while FSO.FileExists(GetNextNumberedFilename) end function function DeunixPath(Path) if InStr(Path, "/") > 0 then Path = Replace(Path, "\", "_") Path = Replace(Path, "/", "\") Path = Replace(Path, ":", "_") Path = Replace(Path, "*", "_") Path = Replace(Path, "?", "_") Path = Replace(Path, """", "_") Path = Replace(Path, "<", "_") Path = Replace(Path, ">", "_") Path = Replace(Path, "|", "_") DeunixPath = Path end Function function ByteArrayConcat(byref A1, byref A2) const adTypeBinary = 1 dim S set S = Server.CreateObject("ADODB.Stream") S.Type = adTypeBinary S.Open S.Write A1 S.Write A2 S.Position = 0 ByteArrayConcat = S.Read S.Close end Function function ByteArrayMid(byref A, Start, Size) dim S const adTypeBinary = 1 if IsNull(A) then ByteArrayMid = null else set S = Server.CreateObject("ADODB.Stream") S.Type = adTypeBinary S.Open S.Write A S.Position = Start ByteArrayMid = S.Read(Size) S.Close end if end Function function StrToBin(byref Str) dim I, B B = "" for I = 1 to len(Str) B = B & ChrB(Asc(Mid(Str, I, 1))) next StrToBin = B end function function BinToStr(byref Bin) dim I, S S = "" for I = 1 to lenb(Bin) S = S & Chr(AscB(MidB(Bin, I, 1))) next BinToStr = S end function function BinToStrC(byref Bin, Charset) dim Stream const adTypeText = 2 const adTypeBinary = 1 if IsNull(Bin) then BinToStrC = "" else set Stream = Server.CreateObject("ADODB.Stream") Stream.Type = adTypeBinary Stream.Open Stream.Write Bin Stream.Position = 0 Stream.Type = adTypeText Stream.Charset = Charset BinToStrC = Stream.ReadText Stream.Close end if end Function class BinaryToString private Recordset private FirstTime private sub Class_Initialize const adUseClient = 3 set Recordset = Server.CreateObject("ADODB.Recordset") Recordset.CursorLocation = adUseClient FirstTime = true end sub private sub Class_Terminate const adStateOpen = 1 if not IsEmpty(Recordset) then if Recordset.State and adStateOpen then Recordset.Close end sub public function Convert(byref Binary, Size) const adLongVarChar = 201 Recordset.Fields.Append "A", adLongVarChar, Size Recordset.Open Recordset.AddNew Recordset(0).AppendChunk Binary Recordset.Update Convert = Recordset(0).Value Recordset.Close if FirstTime then if len(Convert) <> Size then Raise("Codepage not supported - see Troubleshooting in Manual") FirstTime = false end if end function end class private sub Raise(Msg) Err.Raise vbObjectError + 1, "ASPUploader", Msg end sub class UploadFile public Owner public UserDefined public DestType public InputName public Name public Size public ContentType public ClientPath public Stream public MaxSize public ValidFileTypes public Overwrite public DeleteIncomplete public Destination private sub Class_Terminate const adStateOpen = 1 if not IsEmpty(Stream) then if Stream.State and adStateOpen then Stream.Close end sub private function FSO set FSO = Server.CreateObject("Scripting.FileSystemObject") end function public sub Delete const dtDirectory = 0 if DestType <> dtDirectory then Owner.Raise "Invalid operation" FSO.DeleteFile AddSlash(Destination) & Name, true Owner.Files.Remove InputName end sub private sub RenameMoveCopy(NewDestination, Copy) dim Path const dtDirectory = 0 if DestType <> dtDirectory then Owner.Raise "Invalid operation" if Right(NewDestination, 1) = "\" then NewDestination = NewDestination & Name NewDestination = MapPath(NewDestination) MakeDir GetParentPath(NewDestination) if FSO.FileExists(NewDestination) then if Overwrite then FSO.DeleteFile NewDestination, true else NewDestination = GetNextNumberedFilename(NewDestination, 3) Path = AddSlash(Destination) & Name if Copy then FSO.CopyFile Path, NewDestination, true else FSO.MoveFile Path, NewDestination Destination = GetParentPath(NewDestination) Name = Right(NewDestination, len(NewDestination) - InStrRev(NewDestination, "\")) end sub public sub Rename(NewName) RenameMoveCopy AddSlash(Destination) & NewName, false end sub public sub Move(NewDestination) RenameMoveCopy NewDestination, false end sub public sub Copy(NewDestination) RenameMoveCopy NewDestination, true end sub end class class ASPUploader private File, FSO, FileStream, Converter, ProgressTable, TotalReadSize, Boundary, BoundaryBegin, Ending private ChunkSize private MaxHeaderSize private MaxInputValueSize public MaxTotalBytes public ValidFileTypes public Destination public Overwrite public DeleteIncomplete public Charset public ID public Files public Form private sub Class_Initialize ChunkSize = 65792 MaxHeaderSize = 4096 MaxInputValueSize = 8388608 MaxTotalBytes = 2147400000 ValidFileTypes = "" Overwrite = false DeleteIncomplete = true Charset = "us-ascii" ID = "" set Files = Server.CreateObject("Scripting.Dictionary") set Form = Server.CreateObject("Scripting.Dictionary") end sub private function IsValidName(File) dim I if File.ValidFileTypes = "" then IsValidName = true else IsValidName = false I = InStrRev(File.Name, ".") if (I > 0) then if InStr(1, "," & File.ValidFileTypes & ",", "," & Right(File.Name, len(File.Name) - I) & ",", vbTextCompare) > 0 then IsValidName = true end if end function private function GetBoundary const BadContentType = "Bad or missing CONTENT_TYPE" const BadEnctype = "Enctype attribute of HTML form must be " const Enctype = "multipart/form-data" dim ConstBegin, RawStr, RawStrSize, I, Obj ConstBegin = "boundary=" set Obj = Request.ServerVariables("CONTENT_TYPE") if Obj.Count > 0 then RawStr = Obj(1) else RawStr = "" if RawStr = "" then Raise BadContentType if InStr(1, RawStr, Enctype, vbTextCompare) < 1 then Raise BadEnctype & Enctype I = InStr(1, RawStr, ConstBegin, vbTextCompare) if I < 1 then Raise BadContentType GetBoundary = Mid(RawStr, I + len(ConstBegin)) end function private function ReadChunk dim Size Size = ChunkSize ReadChunk = Request.BinaryRead(Size) if Size = 0 then Raise "Unexpected end of request" TotalReadSize = TotalReadSize + Size if TotalReadSize > MaxTotalBytes then Raise "Total upload size out of limit" end function private sub WriteChunk(byref BinChunk, Size) const dtDirectory = 0, dtDatabase = 1 if not IsNull(BinChunk) then select case File.DestType case dtDirectory FileStream.Write Converter.Convert(BinChunk, Size) case dtDatabase File.Destination.AppendChunk BinChunk case else File.Stream.Write BinChunk end select File.Size = File.Size + Size if not IsEmpty(File.MaxSize) then if File.Size > File.MaxSize then Raise "Velicina slike nije dozvoljena!" end if end sub private function ProcessChunks(byref OldBinChunk, byref NewBinChunk, byref OldChunk, byref NewChunk) dim I, BinChunk Ending = RightB(OldChunk, lenb(Boundary)) BoundaryBegin = InStrB(Ending & NewChunk, Boundary) if BoundaryBegin < 1 then WriteChunk OldBinChunk, lenb(OldChunk) if ID <> "" then Application.Lock ProgressTable.MoveFirst ProgressTable.Find "ID = " & ID ProgressTable("LastUpdate").Value = Now ProgressTable("UploadedBytes").Value = TotalReadSize ProgressTable("CurrentFileBytes").Value = File.Size ProgressTable.Update Application.UnLock end if OldBinChunk = ReadChunk OldChunk = cstr(OldBinChunk) ProcessChunks = false else I = BoundaryBegin - lenb(Ending) + lenb(OldChunk) - lenb(StrToBin(VbCrLf)) - 1 if I > lenb(OldChunk) then WriteChunk OldBinChunk, lenb(OldChunk) I = I - lenb(OldChunk) BinChunk = ByteArrayMid(NewBinChunk, 0, I) WriteChunk BinChunk, I else BinChunk = ByteArrayMid(OldBinChunk, 0, I) WriteChunk BinChunk, I end if ProcessChunks = true end if end function private sub ParseAndSave const adTypeBinary = 1, adReadAll = -1, adUseClient = 3, adDate = 7, adInteger = 3, adVarChar = 200 const UploadProgressTable = "ASPUploaderProgressTable", dtDirectory = 0, dtDatabase = 1, dtMemory = 2 dim StartTime, TotalBytes dim CrLf, Quote, ConstInputName, ConstFileName, ConstContentType, ConstBoundaryAddon, ConstHeaderEnd dim Header, BinHeader, HeaderBegin, HeaderEnd, WordBegin, WordEnd, InputName, InputValue dim Chunk, Chunk1, Chunk2, BinChunk, BinChunk1, BinChunk2, I, S StartTime = Now TotalBytes = Request.TotalBytes TotalReadSize = 0 if TotalBytes > MaxTotalBytes then Raise("Total upload size out of limit") if ID <> "" then Application.Lock if IsEmpty(Application(UploadProgressTable)) then set ProgressTable = Server.CreateObject("ADODB.Recordset") set Application(UploadProgressTable) = ProgressTable ProgressTable.CursorLocation = adUseClient ProgressTable.Fields.Append "ID", adInteger ProgressTable.Fields.Append "FirstUpdate", adDate ProgressTable.Fields.Append "LastUpdate", adDate ProgressTable.Fields.Append "TotalBytes", adInteger ProgressTable.Fields.Append "UploadedBytes", adInteger ProgressTable.Fields.Append "CurrentFile", adVarChar, 128 ProgressTable.Fields.Append "CurrentFileBytes", adInteger ProgressTable.Open ProgressTable("ID").Properties("Optimize") = true else set ProgressTable = Application(UploadProgressTable) end if ProgressTable.AddNew ProgressTable("ID").Value = clng(ID) ProgressTable("FirstUpdate").Value = StartTime ProgressTable("LastUpdate").Value = StartTime ProgressTable("TotalBytes").Value = TotalBytes ProgressTable("UploadedBytes").Value = 0 ProgressTable("CurrentFile").Value = "" ProgressTable("CurrentFileBytes").Value = 0 ProgressTable.Update Application.UnLock end if Quote = StrToBin(Chr(34)) CrLf = StrToBin(VbCrLf) ConstInputName = StrToBin("name=") ConstFileName = StrToBin("filename=") ConstContentType = StrToBin("Content-Type: ") ConstBoundaryAddon = StrToBin("--") ConstHeaderEnd = CrLf & CrLf Boundary = ConstBoundaryAddon & StrToBin(GetBoundary) BinChunk = ReadChunk Chunk = cstr(BinChunk) BoundaryBegin = InStrB(Chunk, Boundary) if BoundaryBegin < 1 then Raise "Boundary not found" do while true HeaderBegin = BoundaryBegin + lenb(Boundary) + lenb(CrLf) HeaderEnd = InStrB(HeaderBegin, Chunk, ConstHeaderEnd) do while HeaderEnd < 1 if lenb(Chunk) - HeaderBegin > MaxHeaderSize then Raise "End of header not found" BinChunk = ByteArrayConcat(BinChunk, ReadChunk) Chunk = cstr(BinChunk) HeaderEnd = InStrB(HeaderBegin, Chunk, ConstHeaderEnd) loop BinHeader = ByteArrayMid(BinChunk, HeaderBegin - 1, HeaderEnd - HeaderBegin) Header = cstr(BinHeader) I = InStrB(Header, ConstInputName) if I < 1 then Raise "Input name not found" WordBegin = I + lenb(ConstInputName) + lenb(Quote) WordEnd = InStrB(WordBegin, Header, Quote) if WordEnd < 1 then Raise "Unterminated input name" InputName = BinToStrC(ByteArrayMid(BinHeader, WordBegin - 1, WordEnd - WordBegin), Charset) I = InStrB(WordEnd, Header, ConstFileName) if I < 1 then WordBegin = HeaderEnd + lenb(ConstHeaderEnd) BoundaryBegin = InStrB(WordBegin, Chunk, Boundary) do while BoundaryBegin < 1 if lenb(Chunk) - WordBegin > MaxInputValueSize then Raise "Input value size out of limit" BinChunk = ByteArrayConcat(BinChunk, ReadChunk) Chunk = cstr(BinChunk) BoundaryBegin = InStrB(WordBegin, Chunk, Boundary) loop WordEnd = BoundaryBegin - lenb(CrLf) InputValue = BinToStrC(ByteArrayMid(BinChunk, WordBegin - 1, WordEnd - WordBegin), Charset) if Form.Exists(InputName) then Form(InputName) = Form(InputName) & "," & InputValue else Form.Add InputName, InputValue else WordBegin = I + lenb(ConstFileName) + lenb(Quote) WordEnd = InStrB(WordBegin, Header, Quote) if WordEnd < 1 then Raise "Unterminated filename" if WordEnd = WordBegin then BoundaryBegin = HeaderEnd + lenb(ConstHeaderEnd) + lenb(CrLf) else if Files.Exists(InputName) then set File = Files(InputName) if not File.UserDefined then Raise "Duplicate InputName of file" else set File = new UploadFile Files.Add InputName, File set File.Owner = me File.UserDefined = false File.InputName = InputName end if if IsEmpty(File.ValidFileTypes) then File.ValidFileTypes = ValidFileTypes if IsEmpty(File.DeleteIncomplete) then File.DeleteIncomplete = DeleteIncomplete if IsEmpty(File.Overwrite) then File.Overwrite = Overwrite if IsEmpty(File.Destination) then if IsEmpty(Destination) then Raise "Missing Destination" if IsObject(Destination) then set File.Destination = Destination else File.Destination = Destination end if File.ClientPath = BinToStrC(ByteArrayMid(BinHeader, WordBegin - 1, WordEnd - WordBegin), Charset) S = DeunixPath(File.ClientPath) if IsEmpty(File.Name) then File.Name = Right(S, len(S) - InStrRev(S, "\")) if not IsValidName(File) then Raise "Invalid filename: " & File.Name I = InStrB(WordEnd, Header, ConstContentType) if I < 1 then File.ContentType = "" else WordBegin = I + lenb(ConstContentType) WordEnd = InStrB(WordBegin, Header, CrLf) if WordEnd < 1 then WordEnd = HeaderEnd File.ContentType = BinToStr(MidB(Header, WordBegin, WordEnd - WordBegin)) end if if IsObject(File.Destination) then if File.Overwrite then File.Destination.Value = null File.DestType = dtDatabase elseif File.Destination = "" then set File.Stream = Server.CreateObject("ADODB.Stream") File.Stream.Open File.Stream.Type = adTypeBinary File.DestType = dtMemory else set Converter = new BinaryToString set FSO = Server.CreateObject("Scripting.FileSystemObject") File.Destination = MapPath(File.Destination) MakeDir File.Destination S = AddSlash(File.Destination) if not File.Overwrite then if FSO.FileExists(S & File.Name) then File.Name = FSO.GetFileName(GetNextNumberedFilename(S & File.Name, 3)) set FileStream = FSO.CreateTextFile(S & File.Name, true) File.DestType = dtDirectory end if if ID <> "" then Application.Lock ProgressTable.MoveFirst ProgressTable.Find "ID = " & ID ProgressTable("CurrentFile").Value = File.Name ProgressTable.Update Application.UnLock end if File.Size = 0 BinChunk1 = ByteArrayMid(BinChunk, HeaderEnd + lenb(ConstHeaderEnd) - 1, adReadAll) BinChunk = null BinChunk2 = null Chunk1 = cstr(BinChunk1) Chunk = "" Chunk2 = "" do while true if ProcessChunks(BinChunk2, BinChunk1, Chunk2, Chunk1) then BinChunk = BinChunk1 Chunk = Chunk1 exit do end if if ProcessChunks(BinChunk1, BinChunk2, Chunk1, Chunk2) then BinChunk = BinChunk2 Chunk = Chunk2 exit do end if loop BinChunk1 = null Chunk1 = "" BinChunk2 = null Chunk2 = "" BoundaryBegin = BoundaryBegin - lenb(Ending) select case File.DestType case dtDirectory Converter = empty FileStream.Close FileStream = empty case dtMemory File.Stream.Position = 0 end select end if end if if lenb(Chunk) < BoundaryBegin + lenb(Boundary) + lenb(ConstBoundaryAddon) - 1 then BinChunk = ByteArrayConcat(BinChunk, ReadChunk) Chunk = cstr(BinChunk) end if if MidB(Chunk, BoundaryBegin + lenb(Boundary), lenb(ConstBoundaryAddon)) = ConstBoundaryAddon then exit do loop if ID <> "" then Application.Lock ProgressTable.MoveFirst ProgressTable.Find "ID = " & ID ProgressTable.Delete if ProgressTable.RecordCount = 0 then ProgressTable.Close Application.Contents.Remove UploadProgressTable end if Application.UnLock end if end sub public function AddFile(InputName) if Files.Exists(InputName) then Raise "Duplicate InputName of file" set AddFile = new UploadFile Files.Add InputName, AddFile set AddFile.Owner = me AddFile.UserDefined = true AddFile.InputName = InputName end function public sub Upload const adStateClosed = 0, adStateOpen = 1 const UploadProgressTable = "ASPUploaderProgressTable", dtDirectory = 0, dtDatabase = 1 dim ErrNum, ErrSrc, ErrMsg, F, I on error resume next ParseAndSave if Err then ErrNum = Err.Number ErrSrc = Err.Source ErrMsg = Err.Description if not IsEmpty(FileStream) then FileStream.Close Converter = empty if not IsEmpty(Application(UploadProgressTable)) then set ProgressTable = Application(UploadProgressTable) Application.Lock if ProgressTable.State and adStateOpen then if ProgressTable.RecordCount > 0 then ProgressTable.MoveFirst ProgressTable.Find "ID = " & ID if not ProgressTable.EOF then ProgressTable.Delete if ProgressTable.RecordCount > 0 then ProgressTable.MoveFirst do I = ProgressTable("LastUpdate").Value if IsEmpty(I) then ProgressTable.Delete elseif DateDiff("n", I, Now) > 30 then ProgressTable.Delete end if ProgressTable.MoveNext loop until ProgressTable.EOF end if end if if ProgressTable.RecordCount = 0 then ProgressTable.Close end if if ProgressTable.State = adStateClosed then Application.Contents.Remove UploadProgressTable Application.UnLock end if for each F in Files.Items if F.DeleteIncomplete then if not IsEmpty(F.DestType) then select case F.DestType case dtDirectory FSO.DeleteFile AddSlash(F.Destination) & F.Name, true case dtDatabase F.Destination.Value = null case else F.Stream.Close F.Stream = empty end select F.Size = empty end if end if next on error goto 0 Err.Raise ErrNum, ErrSrc, ErrMsg end if end sub end class function GetASPUploader set GetASPUploader = new ASPUploader end function %> Poziva se: Code: <% dim Uploader, File set Uploader = GetASPUploader Uploader.Charset = "windows-1250" Uploader.Destination = "C:\Inetpub\vhosts\" set File = Uploader.AddFile("thumb") ' Naziv forme koja nosi fajl File.ValidFileTypes = "jpg,gif,bmp,jpeg" 'Dozvoljeni fajlovi za upload File.MaxSize = 72 * 77 ' Maximalna velicina fotografije File.Overwrite = false 'Prebrisi ako postoji Server.ScriptTimeout = 900 Uploader.Upload if Err then 'ako ima greski 'Pisi greski Else NazivFajla = File.Name End If %> Copyright (C) 2001-2025 by www.elitesecurity.org. All rights reserved.
|