<%
'           Class to get data of a form with ENCTYPE="multipart/form-data"	
'Usage:
'			Set variable = New BinForm		
'Methods:							
'			Read()					
'				Reads the input of the multipart encoded form		
'				NOTE All other methods are only available after you	call this method
'			Save(Inputname)
'				Saves the file input in File field labeled Inputname
'				Inputname should be a string equal to the label of a formfield of type
'				"FILE".	NOTE: Only to be used after .Read
'				Example: .Save("UploadFile")
'			Form(Inputname)
'				Returns the value entered in the specified formfield. Use this method	'
'				the same as Request.Form. NOTE: Only to be used after .Read				'
'				Example: .Form("inputtext")												'
'Properties:																			'
'	Read / Write																		'
'			Extensions																	'
'				Array of strings with extensions allowed. Seperator included. If Only	'
'				"*" is specified all datatypes are allowed								'
'				Default: .txt, .gif, .jpg, .mp3, .wma									'
'				Example .Extensions = Array(".txt", ".gif", ".jpg", ".mp3", ".wma")
'			Directory	
'				String with the absolute path for download.NOTE: Inetuser should have	'
'				correct rights on folder.
'				Default: Server.Mappath(\upload)
'			Create
'				Boolean which states wether or not non exsisting folders should be		'
'				created.
'				Default: FALSE	
'			OverWrite
'				Boolean which states wether or not exsisting files should be
'				overwritten.
'				Default: FALSE	
'			MaxSize
'				Double with the maximum size in bytes of the files selected in the post '
'				form.
'				Default: 100,000 (97.7 k)
'			SaveAs
'				String which holds the name on how the file should be saved. Do not		'
'				include extension. SaveAs is reset to Empty after Save is called		'
'				Default: Empty (No rename)
'	Read-only
'			Success
'				Boolean stating wether or not the last Save, SaveAs or SaveToDb Method	'
'				was successfull. NOTE: Only contains valid data after one of the Methods'
'				is called
'			Version
'				String with software version of the class.
'			Log	
'				String with the result log. On success it holds the data of all
'				read-only Properties on failure it holds one or more error messages	
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
Class BinForm
'Class Declarations (used througout this class)
Private aExtensions, sDirectory, bCreate, bOverWrite, bSuccess, sLog, dicUpload, bReadSuccess
Private bNoInput, nTotalBytes, sFilePathExt, sNewFile, nMaxSize, z, sSaveAs, sWhere, svnm
'Properties setting
	Public Property LET Extensions(byVal arrayInput)
		aExtensions = arrayInput
	End Property
	Public Property LET Directory(byVal strInput)
		sDirectory = strInput
	End Property
	Public Property LET Create(byVal boolInput)
		bCreate = boolInput
	End Property
	Public Property LET OverWrite(byVal boolInput)
		bOverWrite = boolInput
	End Property
	Public Property LET MaxSize(byVal lngInput)
		nMaxSize = lngInput
	End Property
	Public Property LET SaveAs(byVal strInput)
		sSaveAs = "" & strInput
	End Property
'Properties reading
	Public Property GET Extensions()
		'The following lines are commented by johnson so that all the files can be uploaded
		'If IsArray( aExtensions ) then
			'Extensions = aExtensions
		'Else
			'If Len(arrExt) = 1 AND aExtensions = "*" Then
				'Extensions = "*"
			'Else
				' default extensions
				'Extensions = Array(".txt", ".jpg", ".gif")
				Extensions = "*"
			'End If
		'End If
	End Property
	Public Property GET flName()
	  flName=svnm
	end Property
	Public Property GET Directory()
		Directory = sDirectory
	End Property
	Public Property GET Create()
		Create = CBool(bCreate)
	End Property
	Public Property GET OverWrite()
		OverWrite = CBool(bOverWrite)
	End Property
	Public Property GET MaxSize()
		If nMaxSize = 0 Then
'			nMaxSize = 100000
			nMaxSize = 10000000000000000000000000000000000000000000000
		End If	
		MaxSize = nMaxSize
	End Property
	Public Property GET SaveAs()
		SaveAs = sSaveAs
	End Property
	Public Property	GET Success()
		Success = bSuccess
	End Property
	Public Property	GET Version()
		Version = "Copyrights Bob Coppens 2001 Version 1.0."
	End Property
	Public Property	GET Log()
		Log = sLog
	End Property
'Events (automatically invoked)
	Private Sub Class_Initialize()
		Call ClearVariables()
		Call ClearDictionary()
	End Sub
	Private Sub Class_Terminate()
		Call ClearVariables()
		Call ClearDictionary()
	End Sub
'Methods to be called by programmer always call Read first
	Public Default Sub Read()
		' Checks for input (error 3), filesize (error 4) 
		' and extensions (error 5) and initializes the 
		' reading of all the binary data
		nTotalBytes = Request.TotalBytes
		If nTotalBytes <= 0 Then
			'Log the error of no data input
			Call BinForm_Log(3)
			bSuccess = False
		ElseIf nTotalBytes > 0 And nTotalBytes <= MaxSize Then
			'Goto Readbinary sub
			Call ReadBinary(nTotalBytes)
		Else
			'Log the error of too much data and stop
			Call BinForm_Log(4)
			bSuccess = False
		End If
	End Sub
	Public Sub Save(byVal sFormInput)
		If bReadSuccess Then
			Dim nFileLength, sFilePathName, sSaveName, sContentType
			Dim spStr

			sContentType = dicUpload.Item(sFormInput).Item("ContentType")
			sFilePathName = dicUpload.Item(sFormInput).Item("FileName")

'			spStr=split(Replace(sFilePathName,"\","*",1),"*")
			spStr=split(sFilePathName,"\")

'			sSaveName = Right(sFilePathName,Len(sFilePathName)-InStrRev(sFilePathName,"\"))
			sSaveName = spStr(ubound(spStr))

			sFilePathExt = Right(sFilePathName, 4)
			nFileLength = LenB(dicUpload.Item(sFormInput).Item("Value")) 
			If IsArray(Extensions) Then
				'check the extension
				bSuccess = ExtensionCheck( sFilePathExt )
			Else
				If Extensions = "*" Then 
					bSuccess = True
				End If
			End If

			If not bSuccess Then
				'Illigal extension posted
				Call BinForm_Log(5)
			End If
			'Response.write "Directory="&Directory&"<br>"
			If sSaveAs <> ""  Then
				sSaveName = Directory & "\" & sSaveAs & Right(sSaveName, 4)
				svnm=sSaveAs&right(sSaveName,4)  'added by miks
			Else
				sSaveName = Directory & "\" & sSaveName
				svnm=sSaveName 'added by miks
			End If
			' create the new file on the server
			Call WriteFile( sSaveName, dicUpload.Item(sFormInput).Item("Value") )
			sSaveAs = ""
		End If
	End Sub
	Public Function Form(sFormInput)
		If not bReadSuccess Then
			Form = ""
		Else
			Form = dicUpload.Item(sFormInput).Item("Value")
		End If
	End Function
'Routines (for internal class use)
	Private Sub ClearVariables()
		aExtensions = Array(".txt", ".jpg", ".gif", ".wma", ".mp3")
		sDirectory = Server.MapPath("/upload")
		bReadSuccess = False
		sSaveAs = ""
		bCreate = False
		bOverWrite = False
		'nMaxSize = 100000
		bSuccess = True
		sLog = ""
		bNoInput = True
	End Sub
	Private Sub ClearDictionary()
		 ' clear dictionary
		Set dicUpload = Server.CreateObject("Scripting.Dictionary")
		dicUpload.RemoveAll
		Set dicUpload = Nothing
	End Sub
	Private Sub ReadBinary(byVal MaxBytes)
		Dim nByteCount, sAllBinary
		nByteCount = MaxBytes
		sAllBinary = Request.BinaryRead (nByteCount)
		Set dicUpload = Server.CreateObject("Scripting.Dictionary")
		On Error Resume Next
			BuildUpload sAllBinary
			If not bSuccess Then
				Call BinForm_Log(9)
			End If
		On Error Goto 0
	End Sub
	Private Function ExtensionCheck(byVal Ext)
		Dim Item
		For each Item in Extensions
			If LCase( Ext ) = LCase( Item ) Then 
				ExtensionCheck = True
				Exit Function
			End if
		Next
		ExtensionCheck = False
	End Function
	Private Sub BinForm_Log(nMessage)
		'First line in Logs with any error
		Select Case nMessage
			Case 0
				sLog = "The posted data was succesfully read." &vbCrLf
			Case 1
				sLog = sLog & "File " & sNewFile & " was saved succesfully." &vbCrLf
			Case 2
				sLog = sLog & "File " & sNewFile & " was succesfully uploaded to database." &vbCrLf
			Case 3
				sLog = "The posted data was not read." &vbCrLf
				sLog = sLog & "No data has been posted." &vbCrLf
			Case 4
				sLog = "The posted data was not read." &vbCrLf
				sLog = sLog & "The total bytes of the post (" & CStr(nTotalBytes) & " bytes) is larger than set maximum of " & CStr(nMaxSize) & "." &vbCrLf
			Case 5
				sLog = sLog & "Upload failed. Illegal Extension posted." &vbCrLf
			Case 6
				sLog = sLog & "Upload failed. " & Directory & " directory not found. Unable to create directory. Check the rights of Internet User." &vbCrLf
			Case 7
				sLog = sLog & "Upload failed. " & Directory & " directory not found. Set Create to True if directory should be created." &vbCrLf
			Case 8
				sLog = sLog & "Upload failed. File already exsists and OverWrite is set to False" &vbCrLf
			Case 9
				bSuccess = False
				sLog = sLog & "Upload failed. Error parsing file failed. Probably due to filesize" &vbCrLf
				Exit Sub
		End Select
	End Sub
	Private Sub BuildUpload(RequestBin)
		dim PosBeg,PosEnd,boundary,boundaryPos,Pos,Name,PosFile
		dim PosBound,FileName,ContentType,Value
		bSuccess = False
		PosBeg = 1
		PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(13)))
		boundary = MidB(RequestBin,PosBeg,PosEnd-PosBeg)
		boundaryPos = InstrB(1,RequestBin,boundary)
		Do until (boundaryPos=InstrB(RequestBin,boundary & getByteString("--")))
			Dim UploadControl
			Set UploadControl = Server.CreateObject("Scripting.Dictionary")
			Pos = InstrB(BoundaryPos,RequestBin,getByteString("Content-Disposition"))
			Pos = InstrB(Pos,RequestBin,getByteString("name="))
			PosBeg = Pos+6
			PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(34)))
			Name = getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
			PosFile = InstrB(BoundaryPos,RequestBin,getByteString("filename="))
			PosBound = InstrB(PosEnd,RequestBin,boundary)
			If  PosFile<>0 AND (PosFile<PosBound) Then
				PosBeg = PosFile + 10
				PosEnd =  InstrB(PosBeg,RequestBin,getByteString(chr(34)))
				FileName = getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
				UploadControl.Add "FileName", FileName
				Pos = InstrB(PosEnd,RequestBin,getByteString("Content-Type:"))
				PosBeg = Pos+14
				PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(13)))
				ContentType = getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
				UploadControl.Add "ContentType",ContentType
				PosBeg = PosEnd+4
				PosEnd = InstrB(PosBeg,RequestBin,boundary)-2
				Value = MidB(RequestBin,PosBeg,PosEnd-PosBeg)
			Else
				Pos = InstrB(Pos,RequestBin,getByteString(chr(13)))
				PosBeg = Pos+4
				PosEnd = InstrB(PosBeg,RequestBin,boundary)-2
				Value = getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
			End If
			UploadControl.Add "Value" , Value	
			dicUpload.Add name, UploadControl	
			BoundaryPos=InstrB(BoundaryPos+LenB(boundary),RequestBin,boundary)
		Loop
		bSuccess = True
		bReadSuccess = True
		Call BinForm_Log(0)
		Exit Sub
	End Sub	
	Private Sub WriteFile(byVal NAME, byVal CONTENTS)
		 ' create the file on the server
		dim soWriteFile, sTmpDir
		Set soWriteFile = Server.CreateObject("Scripting.FileSystemObject")
		If Not soWriteFile.FolderExists( Directory ) Then
			'If create new directories is allowed
			If bCreate Then
				' start from root and work your way down
				sTmpDir = Left( Directory, 3)
				Do While sTmpDir <> Directory
					' if arrived at final subdirectory
					If InStr( Mid( Directory, ( Len( sTmpDir ) + 2 ), (Len(Directory) - ( Len( sTmpDir ) + 2 ))), "\" ) = 0 Then
						sTmpDir = Directory
					Else
						'volume to subdirectory below
						sTmpDir = Left( Directory,( Len( sTmpDir ) + InStr(Mid( Directory, ( Len( sTmpDir ) + 2 ), (Len(Directory) - ( Len( sTmpDir ) + 2 ))), "\")) )
					End If
					If Not soWriteFile.FolderExists( sTmpDir ) Then
						'create subdirectory with internal error creation
						On Error Resume Next
						soWriteFile.CreateFolder( sTmpDir )
						If Not soWriteFile.FolderExists( sTmpDir ) Then
							' error creating directory (probably rights on server)
							Call BinForm_Log(6)
							bSuccess = False
						End If
						On Error Goto 0
					End If
				Loop
			Else
				' error creating directory since no rights in Class
				Call BinForm_Log(7)
				bSuccess = False
			End If
		End If
		If NOT OverWrite AND soWriteFile.FileExists( NAME ) Then
			 ' don't allow file overwrite
			Call BinForm_Log(8)
			bSuccess = False
		End If
		If bSuccess Then
			Set sNewFile = soWriteFile.CreateTextFile( NAME )
			For z = 1 to LenB( CONTENTS )
				 ' translate binary data into ASCII characters and write them into the file.
				sNewFile.Write chr( AscB( MidB( CONTENTS, z, 1) ) )
			Next
			 ' clean up and inform the user of successful upload
			sNewFile.Close
			Set sNewFile = Nothing
			sNewFile = NAME
			Call BinForm_Log(1)
		End If
		Set soWriteFile = Nothing
	End Sub
	Private Function getByteString(StringStr)
		dim char, i
		For i = 1 to Len(StringStr)
			char = Mid(StringStr,i,1)
			getByteString = getByteString & chrB(AscB(char))
		Next
	End Function
	Private Function getString(StringBin)
		dim intCount
		getString =""
		For intCount = 1 to LenB(StringBin)
			getString = getString & chr(AscB(MidB(StringBin,intCount,1))) 
		Next
	End Function
End Class
%>