<% 
Class PGDDownload
	Public FileName
	Public FileExt
	Public FileSize
	Public ContentType
	Public ByteArray
	Private objStream
	
	Private Sub Class_Initialize
		Set objStream = Server.CreateObject("ADODB.Stream")
		objStream.Open
	End Sub
	
	Private Sub Class_Terminate
		if objStream.state <> 0 then objStream.close 'adStateClosed
		Set objStream = nothing
	End Sub
	
	Public Sub ReadFrom(byVal str)
		
		objStream.Type = 1 'adTypeBinary
		objStream.LoadFromFile str
		
		FileSize = objStream.size
		
		ByteArray = objStream.read
		
		FileName = Mid(str, InStrRev(str, "\")+1)
		
		FileExt = lcase(Mid(FileName, InStrRev(FileName, ".")))
		
'		SELECT CASE FileExt
'	        Case ".bmp"
'	            ContentType = "image/bmp"
'	        Case ".png"
'	            ContentType = "image/png"
'	        Case ".pdf"
'	            ContentType = "application/pdf"
'	        Case ".asf"
'	            ContentType = "video/x-ms-asf"
'	        Case ".avi"
'	            ContentType = "video/avi"
'	        Case ".doc"
'	            ContentType = "application/msword"
'	        Case ".zip"
'	            ContentType = "application/zip"
'	        Case ".xls"
'	            ContentType = "application/vnd.ms-excel"
'	        Case ".gif"
'	            ContentType = "image/gif"
'	        Case ".jpg", ".jpeg"
'	            ContentType = "image/jpeg"
'	        Case ".wav"
'	            ContentType = "audio/wav"
'	        Case ".mp3"
'	            ContentType = "audio/mpeg3"
'	        Case ".mpg", ".mpeg"
'	            ContentType = "video/mpeg"
'	        Case ".rtf"
'	            ContentType = "application/rtf"
'			Case ".htm", ".html"
'	            ContentType = "text/html"
'			Case ".asp"
'	            ContentType = "text/asp"
'	        Case Else
	            'Handle All Other Files
'	            ContentType = "application/octet-stream"
'		END SELECT
		ContentType = "application/octet-stream"
	End Sub
End Class


Class PGDUpload 'Version 3.0 - Super Fast Upload Routine - Faster than any ASP File Upload and Almost as fast as
				'Commercial Components - SA-FileUp or ASPUpload. Supports multiple fields upload as well as non-
				'binary fields reading.
	
	Private parentDict
	Private subDict
	Private count_
	Private sizeLimit_
	Private extLimit_
	Private subOrinalDict
	Private enableOrdinal_
	
	Private Sub Class_Initialize
		Set parentDict = Server.CreateObject("Scripting.Dictionary")
		Set subOrinalDict = Server.CreateObject("Scripting.Dictionary")
		'subOrinalDict.comparemode = vbtextcompare
		parentDict.comparemode = vbtextcompare
		sizeLimit_ = 0
		extLimit_ = ""
		count_ = -1
		enableOrdinal_ = true
	End Sub
	
	Private Sub Class_Terminate
		If IsObject(subDict) Then
			subDict.RemoveAll
			Set subDict = Nothing
		End If
		
		If IsObject(subOrinalDict) Then
			subOrinalDict.RemoveAll
			Set subOrinalDict = Nothing
		End If
		
		If IsObject(parentDict) Then
			parentDict.RemoveAll
			Set parentDict = Nothing
		End If
	End Sub
	
	Public Property Let sizelimit(val)
		if isNumeric(val) then sizeLimit_ = val
	End Property
	
	Public Property Let enableOrdinal(val)
		enableOrdinal_ = iff(val,true,false)
	End Property	
	
	Public Property Let extLimit(val)
		if len(val) then extLimit_ = val
	End Property
	
	Public Property Get extLimit
		extLimit = extLimit_
	end Property
	
	Public Function getForm
		dim rawdata, totalBytes
		totalBytes = Request.TotalBytes
		if totalBytes > sizeLimit_ or totalBytes=0 then
			getForm = false
			exit function
		else
			getForm = true
		end if
		if getForm then
			rawData = Request.BinaryRead(totalBytes)
			Dim wholeBinaryDataInString, lengthOfBinary
				lengthOfBinary = LenB(rawData)
			Dim objRS
			Set objRS = Server.CreateObject("ADODB.Recordset")
			    if lengthOfBinary > 0 Then
		    		objRS.Fields.Append "uploaded", 201, lengthOfBinary 'adLongVarChar
		    		objRS.Open
		   			objRS.AddNew
		   			objRS.Fields("uploaded").AppendChunk rawData
		   			objRS.Update
    				wholeBinaryDataInString = objRS.Fields("uploaded")
					objRS.Close
				end if
			Set objRS = nothing	
	'		response.write wholeBinaryDataInString
	'		response.end
			call getBinary(wholeBinaryDataInString)
		end if
	End Function
	
	Private Sub getBinary(rawData)
		dim Separator
		Separator = Mid(rawData, 1, Instr(1, rawData, Chr(13))-1)
		dim wholecontent, formname, filename, binary, contentType
		dim firstByteOfWholeContent, lengthOfWholeContent
		dim firstByteOfFileName, firstByteOfFormName, endByteOfFileName, endByteOfFormName
		dim firstByteOfContentType, lengthOfContentType, endByteOfContentType
		dim lengthOfFormName, lengthOfFileName, firstByteOfBinary, lengthOfBinary
		dim isBinary, nonBinaryData,firstByteOfNonBinary
		
		Dim arrAllFields, item
		arrAllFields = split(rawData,Separator)
		count_ = ubound(arrAllFields)-2
		for item = 1 to count_+1
		
			wholecontent = arrAllFields(item) 'mid(rawData,firstByteOfWholeContent,lengthOfWholeContent)
			firstByteOfWholeContent = instr(1,wholecontent,"Content-Disposition")
			lengthOfWholeContent = len(wholecontent) 'instr(firstByteOfWholeContent,rawData,Separator)-len(Separator)-2 'chop off end
			
			firstByteOfFormName = instr(1,wholecontent,"name=")+6
			endByteOfFormName = instr(firstByteOfFormName,wholecontent,chr(34))
			lengthOfFormName = endByteOfFormName-firstByteOfFormName
			'===================
			formname = mid(wholecontent,firstByteOfFormName,lengthOfFormName)
			'response.write formname&"<br>"
			'===================
			
			isBinary = true
			
			firstByteOfFileName = instr(endByteOfFormName,wholecontent,"filename=")+10
			
			if firstByteOfFileName = 10 then isBinary = false
			
			if isBinary then
				endByteOfFileName = instr(firstByteOfFileName,wholecontent,chr(34))
				lengthOfFileName = endByteOfFileName-firstByteOfFileName
				'===================
				filename = mid(wholecontent,firstByteOfFileName,lengthOfFileName)
				'response.write filename&"<br>"
				'===================
				
				firstByteOfContentType = instr(endByteOfFileName,wholecontent,"Content-Type:")+14
				endByteOfContentType = instr(firstByteOfContentType,wholecontent,chr(13))
				lengthOfContentType = endByteOfContentType - firstByteOfContentType
				'===================
				contentType = mid(wholecontent,firstByteOfContentType,lengthOfContentType)
				'response.write contentType&"<br>"
				'===================
				
				firstByteOfBinary = endByteOfContentType+4 'LF+CR+LF+1
				lengthOfBinary = lengthOfWholeContent-firstByteOfBinary-1 '-1 = -2+1
				'===================
				binary = mid(wholecontent,firstByteOfBinary,lengthOfBinary)
				if len(binary) = 0 then 
					isBinary = false
					nonBinaryData = ""
				end if
				'===================
			else
				firstByteOfNonBinary = endByteOfFormName+5
				nonBinaryData = mid(wholecontent,firstByteOfNonBinary,lengthOfWholeContent-firstByteOfNonBinary-1)
			end if
			
			Set subDict = Server.CreateObject("Scripting.Dictionary")
			subDict.comparemode = vbtextcompare
			
			
			if isBinary then
				subDict.Add ("FileName"), filename
				subDict.Add ("FileExt"), fileExt(filename)
				subDict.Add ("ContentType"), contentType
				subDict.Add ("Value"), "Binary: "&filename
				subDict.Add ("Binary"), binary
			else
				subDict.Add ("Value"), nonBinaryData
			end if
			
			subDict.Add ("isBinary"), isBinary
			subDict.Add ("name"), formname
			parentDict.Add formname, subDict
			if enableOrdinal_ then subOrinalDict.Add (item-1), formname
		next
	End Sub

	Public Default Property Get form (formnameInput)
		
		Dim finalFormNameOutPut
		
		if varType(formnameInput) = vbLong and enableOrdinal_ then
			if formnameInput <= count_ then finalFormNameOutPut = subOrinalDict.item(formnameInput)
		else
			finalFormNameOutPut = formnameInput
		end if
		
		if not parentDict.exists(finalFormNameOutPut) then 
			Set subDict = Server.CreateObject("Scripting.Dictionary")	
			subDict.Add ("isBinary"), false
			subDict.Add ("name"), finalFormNameOutPut
			parentDict.Add finalFormNameOutPut, subDict
		end if
		set form = parentDict (finalFormNameOutPut)
	End Property

	Public Property Get forms
		forms = parentDict.items
	End Property

	Public Property Get Count
		Count = count_
	end Property

	Public Function getFileName(formnameInput)
		if parentDict.exists(formnameInput) then
			if parentDict(formnameInput).Item("isBinary") then
				Dim temp
				temp = parentDict(formnameInput).Item("FileName")
				getFileName = Mid(temp, 1 + InStrRev(temp, "\"))
			else
				getFileName = Null
			end if
		else
			getFileName = null
		end if
	End Function

	Public Function getFileExt(formnameInput)
		if parentDict.exists(formnameInput) then
			if parentDict(formnameInput).Item("isBinary") then
				getFileExt = parentDict(formnameInput).Item("FileExt")
			else
				getFileExt = null
			end if
		else
			getFileExt = null
		end if
	End Function

	Private Function fileExt(byVal str)
		str = ""&str
		fileExt = lcase(Mid(str, InStrRev(str, ".")+1))	
	End Function

	Public Function getContentType(formnameInput)
		if parentDict.exists(formnameInput) then
			if parentDict(formnameInput).Item("isBinary") then
				getContentType = parentDict(formnameInput).Item("ContentType")
			else
				getContentType = null
			end if
		else
			getContentType = null
		end if
	End Function

	Public Function saveToFile(formnameInput, ByVal path)
		If parentDict.Exists(formnameInput) Then
			if parentDict(formnameInput).Item("isBinary") then
				Dim temp
					temp = parentDict(formnameInput).Item("Binary")
				Dim fso, folder
					path = Server.MapPath(path)
					folder = left(path,instrRev(path,"\"))
					Set fso = Server.CreateObject("Scripting.FileSystemObject")
					if not fso.FolderExists(folder) then fso.CreateFolder(folder)
				Dim file, tPoint
					Set file = fso.CreateTextFile(path)
							file.Write temp 
					file.Close
					Set fso = nothing 
				saveToFile = True
			else
				saveToFile = False
			end if
		Else
			saveToFile = False
		End If
	End Function
	
End Class

Class PGDImage
	Private imageWidth
	Private imageHeight
	Private myFileBinary
	
	Private sub Class_Initialize()
		imageWidth = 0
		imageHeight = 0
	End sub

	Public sub ReadDimemsion(location) 'has to pass in a server location by mappath
		Dim objStream, isGif, isJPG, isBMP, isPNG
		
		isGif = ChrB(Asc("G")) & ChrB(Asc("I")) & ChrB(Asc("F"))
		isJPG = ChrB(Asc("J")) & ChrB(Asc("F")) & ChrB(Asc("I")) & ChrB(Asc("F"))
		isBMP = ChrB(Asc("B")) & ChrB(Asc("M"))
		isPNG = ChrB(&h89) & ChrB(Asc("P")) & ChrB(Asc("N")) & ChrB(Asc("G"))
		
		Set objStream = Server.CreateObject("ADODB.Stream")
		With objStream
		
		.Type = 1 'adTypeBinary
		.Open
		.LoadFromFile location
			myFileBinary =  .Read
		.Close
		
		End with
		Set objStream = Nothing
		
		If InStrB(1, myFileBinary, isGif) = 1 Then
			
			imageWidth = CLng("&h" & b2hex(8) & b2hex(7))
			imageHeight = CLng("&h" & b2hex(10) & b2hex(9))
			
		ElseIf InStrB(1, myFileBinary, isJPG) = 7 Then
			
			Dim jpgPrefix, i
			jpgPrefix = ChrB(&h00) & ChrB(&h11) & ChrB(&h08)
			i = 1
			Do
				If InStrB(i, myFileBinary, jpgPrefix) + 3 = 3 Then Exit Do
				i = InStrB(i, myFileBinary, jpgPrefix) + 3
			Loop
			If Not i = 1 Then
				imageWidth = CLng("&h" & b2hex(i+2) & b2hex(i+3))
				imageHeight = CLng("&h" & b2hex(i) & b2hex(i+1))
			End If
			
		ElseIf InStrB(1, myFileBinary, isBMP) = 1 Then
			
			imageWidth = CLng("&h" & b2hex(22) & b2hex(21) & b2hex(20) & b2hex(19))
			imageHeight = CLng("&h" & b2hex(26) & b2hex(25) & b2hex(24) & b2hex(23))
			
		ElseIf InStrB(1, myFileBinary, isPNG) = 1 Then
			
			imageWidth = CLng("&h" & b2hex(17) & b2hex(18) & b2hex(19) & b2hex(20))
			imageHeight = CLng("&h" & b2hex(21) & b2hex(22) & b2hex(23) & b2hex(24))
		End If
		
	End sub

	Public Property Get Width()
		Width = imageWidth
	End Property

	Public Property Get Height()
		Height = imageHeight
	End Property

	Private Function b2hex(ByRef posi)
		If posi > LenB(myFileBinary) Or posi <= 0 Then Exit Function
		b2hex = Right("0" & Hex(AscB(MidB(myFileBinary, posi, 1))), 2)
	End Function	

End Class
%>