HITNO Asp skripta za upload!

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
%>

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
%>