<%
'+--------------------------------+
'|Class: FileUpload |
'|Date: 11:01 PM 7/23/2002|
'|By: M.Meijer |
'|Version: 1.0 |
'+--------------------------------+
'
'To upload and save a file submitted within a html form
'
'**Remarks:
'Uploading files with this class is not recommended for huge files,
'it takes alot of time saving the file to a textstream (as it the function 'save' does).
'It takes 7.812ms to upload a file from 'localhost', with a size of 40,000 bytes.
'Saving this file however costs 1078.125ms, and it takes 145828.1ms to save a file of 5.5Mb.
'Conclusion don't save big files, use the maxfilesize property to limit the filesize.
'The class can only handly one file on a submission.
'The file will be saved in the specified 'Path', if there is no 'path' set, it can't save the file. (doh!)
'
'Properties:
'-----------
'
' ContentType string read Content-Type of the file
' Filename string read/write Name of the file
' Path string read/write A path to a directory with permissions to write the file
' Size long read The size of the file in bytes
' AllowedFiles string read/write Allowed file extension(s), multiple seperated with a comma
' Maxfilesize long read/write Maximum allowed size of the file
' Error string read The explenation of an error if occured
'
'Methods
'-------
'
' Upload() = Status
' Copies the result of Request.Binaryread to a file
'
' Status integer 0 Upload success
' 1 A file has not been posted
' 2 File exceeds the maximum allowed filesize
' 3 Type is not allowed
'
' Save(Overwrite) = Satus
' Slaat de bytearray op in een bestand met de in Filename gedefineerde bestandsnaam,
' in de in Path gedefineerde diretorie.
'
' Overwrite boolean true If the file exists it will be overwritten
' false If the file exists it will not be overwritten
'
' Status integer 0 The file has been saved
' 1 The binary value could not be written to a file
' 2 There is no binary value
' 3 The filename is empty
' 4 An error already occured, can't continue
'
'
'
'Code:
'-----------------------------------------------------------------------------------
Class FileUpload
Private strContentType
Private bytData
Private strFilename
Private strPath
Private lngTotalbytes
Private strAllowedFiles
Private lngMaxFileSize
Private strError
Private Sub Class_initialize()
strContentType = ""
bytData = chrB(10)
strFilename = ""
strPath = ""
lngTotalbytes = 0
strAllowedFiles = ""
lngMaxFileSize = 0
strError = ""
End Sub
Private Sub CLass_Terminate()
bytData = Null
End Sub
Public Property Get Size
Size = lngTotalbytes
End Property
Public Property Let MaxFileSize(byval vData)
If isNumeric(vData) > 0 Then
lngMaxFileSize = vData
End If
End Property
Public Property Get MaxFilesize
MaxFilesize = lngMaxFileSize
End Property
Public Property Let AllowedFiles(byval vData)
If Len(vData) > 0 Then
strAllowedFiles = vData
End If
End Property
Public Property Get AllowedFiles
AllowedFiles = strAllowedFiles
End Property
Public Property Get Error
Error = strError
End Property
Public Property Get ContentType
ContentType = strContentType
End Property
Public Property Let Path(byval vData)
If Len(vData) > 0 Then
strPath = vData
End If
End Property
Public Property Get Path
Path = strPath
End Property
Public Property Let Filename(byval vData)
If Len(vData) > 0 Then
strFilename = vData
End If
End Property
Public Property Get Filename
Filename = strFilename
End Property
Public Function Upload()' as integer
Dim bytAllData
lngTotalbytes = Request.Totalbytes
If lngTotalbytes > 0 Then
If lngMaxFilesize <> 0 Then
If lngTotalBytes > lngMaxFileSize Then
strError = "The file exceeds the allowed capacity."
Upload = 2
Exit Function
End If
End If
bytAllData = Request.BinaryRead(lngTotalbytes)
strContentType = GetContentType(bytAllData)
strFilename = GetFilename(bytAllData)
If strAllowedFiles <> "" Then
If Not AllowedFile(strFilename) Then
strError = "Filetype is not allowed."
Upload = 3
Exit Function
End If
End If
bytData = GetData(bytAllData)
Upload = 0
Else
Upload = 1
strError = "No data recieved."
End If
End Function
Public Function Save(byval bOverwrite)
If strError <> "" Then
Save = 4
Exit Function
End If
If strPath <> "" Then
If Mid(strPath,Len(strPath)-1,1) <> "\" Then strPath = strPath & "\"
If strFilename <> "" Then
If LenB(bytData) > 1 Then
If SaveBinaryData(bytData,strPath & strFilename,bOverwrite) Then
Save = 0
Else
Save = 1
End If
Else
Save = 2
strError = "No data."
End If
Else
Save = 3
strError = "Not a valid filename specified."
End If
Else
Save = 4
strError = "No path specified."
End If
End Function
Private Function AllowedFile(byval sFilename)'as boolean
Dim arrAllowedFiles, intCount
Dim strExtension
If Len(sFilename) > 0 Then
If inStr(sFilename,".") > 0 Then
strExtension = Mid(sFilename,Len(sFilename) - inStr(strReverse(sFilename),".")+2)
arrAllowedFiles = Split(strAllowedFiles,",")
AllowedFile = False
For intCount = 0 To Ubound(arrAllowedFiles)
If arrAllowedFiles(intCount) <> "" Then
If Lcase(strExtension) = Lcase(Trim(arrAllowedFiles(intCount))) Then
AllowedFile = True
Exit For
End If
End If
Next
Else
AllowedFile = False
End If
Else
AllowedFile = False
End If
End Function
Private Function SaveBinaryData(byval bData, byval sFilename, byval bOverwrite) 'as boolean
Dim objFs, objTextFile
Dim intCount, strFile
If LenB(bData) < 2 Then
strError = "No data."
SaveBinaryData = False
Exit Function
End If
Set objFs = Server.CreateObject("scripting.filesystemobject")
If Not objFs.FolderExists(strPath) Then
strError = "Directory does not exists."
SaveBinaryData = False
Exit Function
End If
If Not bOverwrite And objFs.FileExists(sFilename) Then
strError = "File already exists."
SaveBinaryData = False
Exit Function
End If
Set objTextFile = objFs.CreateTextFile(sFilename,True,False)
For intCount = 1 To LenB(bData)
objTextFile.Write Chr(AscB(MidB(bData,intCount,1)))
Next
objTextFile.Close
Set objTextFile = Nothing
Set objFs = Nothing
Session("file") = Null
SaveBinaryData = True
End Function
Private Function GetData(byval bFile)'as bytearray
Dim intStart, intEnd
If LenB(bFile) < 1 Then
GetData = ChrB(10)
Exit Function
End If
intStart = inStrB(bFile,ChrB(13) & ChrB(10) & ChrB(13) & ChrB(10)) + 4
intEnd = inStrB(bFile,ChrB(13) & ChrB(10) & ChrB(45) & ChrB(45)& ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45))
If intStart > 0 Then
If intStart < intEnd Then
GetData = MidB(bFile, intStart, intEnd - intStart)
Else
GetData = ChrB(10)
End If
Else
GetData = ChrB(10)
End If
End Function
Private Function GetFilename(byval bFile)' as string
Dim bytFilename, bytChar, strFilename
Dim intStart, intCount
If LenB(bFile) < 1 Then
GetFilename = ""
Exit Function
End If
If LenB(bFile) > 0 Then
If inStrB(bFile,ChrB(102) & ChrB(105) & ChrB(108) & ChrB(101) & ChrB(110) & ChrB(97) & ChrB(109) & ChrB(101) & ChrB(61)) Then
intStart = inStrB(bFile, ChrB(102) & ChrB(105) & ChrB(108) & ChrB(101) & ChrB(110) & ChrB(97) & ChrB(109) & ChrB(101) & ChrB(61)) + 10
For intCount = intStart To LenB(bFile)
bytChar = MidB(bFile, intCount,1)
If bytChar = ChrB(34) Then
Exit For
End If
bytFilename = bytFilename & bytChar
Next
End If
End If
For intCount = 1 To LenB(bytFilename)
strFilename = strFilename & Chr(AscB(MidB(bytFilename,intCount,1)))
Next
strFilename = Mid(strFilename,Len(strFilename) - inStr(strReverse(strFilename),"\")+2)
GetFilename = strFilename
End Function
Private Function GetContentType(byval bFile)
Dim bytContentType, strContentType, bytChar
Dim intStart, intCount
If LenB(bFile) < 1 Then
GetContentType = ""
Exit Function
End If
If inStrB(bFile,ChrB(67) & ChrB(111) & ChrB(110) & ChrB(116) & ChrB(101) & ChrB(110) & ChrB(116) & ChrB(45) & ChrB(84) & ChrB(121) & ChrB(112) & ChrB(101) & ChrB(58)) > 0 Then
intStart = inStrB(bFile,ChrB(67) & ChrB(111) & ChrB(110) & ChrB(116) & ChrB(101) & ChrB(110) & ChrB(116) & ChrB(45) & ChrB(84) & ChrB(121) & ChrB(112) & ChrB(101) & ChrB(58)) + 14
For intCount = intStart To LenB(bFile)
bytChar = MidB(bFile, intCount,1)
If bytChar = ChrB(13) Then
Exit For
End If
bytContentType = bytContentType & bytChar
Next
End If
For intCount = 1 To LenB(bytContentType)
strContentType = strContentType & Chr(AscB(MidB(bytContentType,intCount,1)))
Next
GetContentType = strContentType
End Function
End Class
'-----------------------------------------------------------------------------------
%>
