nc_uploadcls.asp

大型黄页系统,精美黄页flash演示,10m

<%
Class Upload_Cls
	Private NC_FileSize, NC_FileType, NC_SavePath, NC_AutoSave, NC_Error
	Private objForm, binForm, binItem, strDate, lngTime, binFormStream
	Public FormItem, FileItem

	Public Property Get Version()
		Version = "DownloadClass UpLoadClass Version 1.0"
	End Property

	Public Property Get Error()
		Error = NC_Error
	End Property

	Public Property Get FileSize()
		FileSize = NC_FileSize
	End Property


	Public Property Let FileSize(lngSize)
		If IsNumeric(lngSize) Then
			NC_FileSize = CLng(lngSize)
		End If
	End Property

	Public Property Get FileType()
		FileType = NC_FileType
	End Property


	Public Property Let FileType(strType)
		NC_FileType = strType
	End Property

	Public Property Get SavePath()
		SavePath = NC_SavePath
	End Property


	Public Property Let SavePath(strPath)
		NC_SavePath = Replace(strPath, Chr(0), "")
	End Property

	Public Property Get FileArray(iIndex)
		FileArray = FileItem(iIndex)
	End Property

	Public Property Get AutoSave()
		AutoSave = NC_AutoSave
	End Property

	Public Property Let AutoSave(ByVal Flag)
		Select Case Flag
			Case 0:
			Case 1:
			Case 2:
			Case False
				Flag = 2
			Case Else
				Flag = 0
		End Select
		NC_AutoSave = Flag
	End Property

	Private Sub Class_Initialize()
		On Error Resume Next
		NC_Error = -1
		NC_FileSize = 153600
		NC_FileType = "jpg|gif"
		NC_SavePath = ""
		NC_AutoSave = 0
		strDate = Replace(CStr(Date), "-", "")
		lngTime = CLng(Timer() * 1000)
		Set binForm = Server.CreateObject("ADODB.Stream")
		Set binItem = Server.CreateObject("ADODB.Stream")
		Set objForm = Server.CreateObject("Scripting.Dictionary")
		objForm.CompareMode = 1
	End Sub

	Private Sub Class_Terminate()
		objForm.RemoveAll
		Set objForm = Nothing
		Set binItem = Nothing
		binForm.Close
		Set binForm = Nothing
	End Sub

	Public Sub UploadOpen()
		If NC_Error = -1 Then
			NC_Error = 0
		Else
			Exit Sub
		End If
		Dim lngRequestSize, binRequestData, strFormItem, strFileItem
		Const strSplit = "'"">"
		lngRequestSize = Request.TotalBytes
		If lngRequestSize < 1 Then
			NC_Error = 4
			Exit Sub
		End If
		binRequestData = Request.BinaryRead(lngRequestSize)
		binForm.Type = 1
		binForm.Open
		binForm.Write binRequestData

		Dim bCrLf, strSeparator, intSeparator
		bCrLf = ChrB(13) & ChrB(10)

		intSeparator = InStrB(1, binRequestData, bCrLf) - 1
		strSeparator = LeftB(binRequestData, intSeparator)

		Dim NC_start, NC_end, strItem, strInam, intTemp, strTemp
		Dim strFtyp, strFnam, strFext, lngFsiz
		NC_start = intSeparator + 2
		Do
			NC_end = InStrB(NC_start, binRequestData, bCrLf & bCrLf) + 3
			binItem.Type = 1
			binItem.Open
			binForm.Position = NC_start
			binForm.CopyTo binItem, NC_end - NC_start
			binItem.Position = 0
			binItem.Type = 2
			binItem.CharSet = "gb2312"
			strItem = binItem.ReadText
			binItem.Close

			NC_start = NC_end
			NC_end = InStrB(NC_start, binRequestData, strSeparator) - 1
			binItem.Type = 1
			binItem.Open
			binForm.Position = NC_start
			lngFsiz = NC_end - NC_start - 2
			binForm.CopyTo binItem, lngFsiz

			intTemp = InStr(39, strItem, """")
			strInam = Mid(strItem, 39, intTemp - 39)

			If InStr(intTemp, strItem, "filename=""") <> 0 Then
				If Not objForm.Exists(strInam & "_From") Then
					strFileItem = strFileItem & strSplit & strInam
					If binItem.Size <> 0 Then
						intTemp = intTemp + 13
						strFtyp = Mid(strItem, InStr(intTemp, strItem, "Content-Type: ") + 14)
						strTemp = Mid(strItem, intTemp, InStr(intTemp, strItem, """") - intTemp)
						intTemp = InStrRev(strTemp, "\")
						strFnam = Mid(strTemp, intTemp + 1)
						objForm.Add strInam & "_Type", strFtyp
						objForm.Add strInam & "_Name", strFnam
						objForm.Add strInam & "_Path", Left(strTemp, intTemp)
						objForm.Add strInam & "_Size", lngFsiz
						If InStr(intTemp, strTemp, ".") <> 0 Then
							strFext = Mid(strTemp, InStrRev(strTemp, ".") + 1)
						Else
							strFext = ""
						End If
						If Left(strFtyp, 6) = "image/" Then
							binItem.Position = 0
							binItem.Type = 1
							strTemp = binItem.Read(10)
							If StrComp(strTemp, ChrB(255) & ChrB(216) & ChrB(255) & ChrB(224) & ChrB(0) & ChrB(16) & ChrB(74) & ChrB(70) & ChrB(73) & ChrB(70), 0) = 0 Then
								If LCase(strFext) <> "jpg" Then strFext = "jpg"
								binItem.Position = 3
								Do While Not binItem.EOS
									Do
										intTemp = AscB(binItem.Read(1))
									Loop While intTemp = 255 And Not binItem.EOS
									If intTemp < 192 Or intTemp > 195 Then
										binItem.Read (Bin2Val(binItem.Read(2)) - 2)
									Else
										Exit Do
									End If
									Do
										intTemp = AscB(binItem.Read(1))
									Loop While intTemp < 255 And Not binItem.EOS
								Loop
								binItem.Read (3)
								objForm.Add strInam & "_Height", Bin2Val(binItem.Read(2))
								objForm.Add strInam & "_Width", Bin2Val(binItem.Read(2))
							ElseIf StrComp(LeftB(strTemp, 8), ChrB(137) & ChrB(80) & ChrB(78) & ChrB(71) & ChrB(13) & ChrB(10) & ChrB(26) & ChrB(10), 0) = 0 Then
								If LCase(strFext) <> "png" Then strFext = "png"
								binItem.Position = 18
								objForm.Add strInam & "_Width", Bin2Val(binItem.Read(2))
								binItem.Read (2)
								objForm.Add strInam & "_Height", Bin2Val(binItem.Read(2))
							ElseIf StrComp(LeftB(strTemp, 6), ChrB(71) & ChrB(73) & ChrB(70) & ChrB(56) & ChrB(57) & ChrB(97), 0) = 0 Or StrComp(LeftB(strTemp, 6), ChrB(71) & ChrB(73) & ChrB(70) & ChrB(56) & ChrB(55) & ChrB(97), 0) = 0 Then
								If LCase(strFext) <> "gif" Then strFext = "gif"
								binItem.Position = 6
								objForm.Add strInam & "_Width", BinVal2(binItem.Read(2))
								objForm.Add strInam & "_Height", BinVal2(binItem.Read(2))
							ElseIf StrComp(LeftB(strTemp, 2), ChrB(66) & ChrB(77), 0) = 0 Then
								If LCase(strFext) <> "bmp" Then strFext = "bmp"
								binItem.Position = 18
								objForm.Add strInam & "_Width", BinVal2(binItem.Read(4))
								objForm.Add strInam & "_Height", BinVal2(binItem.Read(4))
							End If
						End If
						objForm.Add strInam & "_Ext", strFext
						objForm.Add strInam & "_From", NC_start
						intTemp = GetFerr(lngFsiz, strFext)
						If NC_AutoSave <> 2 Then
							objForm.Add strInam & "_Err", intTemp
							If intTemp = 0 Then
								If NC_AutoSave = 0 Then
									strFnam = GetTimeStr()
									If strFext <> "" Then strFnam = strFnam & "." & strFext
								End If
								binItem.SaveToFile Server.MapPath(NC_SavePath & strFnam), 2
								objForm.Add strInam, strFnam
							End If
						End If
					Else
						objForm.Add strInam & "_Err", -1
					End If
				End If
			Else
				binItem.Position = 0
				binItem.Type = 2
				binItem.CharSet = "gb2312"
				strTemp = binItem.ReadText
				If objForm.Exists(strInam) Then
					objForm(strInam) = objForm(strInam) & "," & strTemp
				Else
					strFormItem = strFormItem & strSplit & strInam
					objForm.Add strInam, strTemp
				End If
			End If

			binItem.Close
			NC_start = NC_end + intSeparator + 2
		Loop Until NC_start + 3 > lngRequestSize
		FormItem = Split(strFormItem, strSplit)
		FileItem = Split(strFileItem, strSplit)
	End Sub

	Private Function GetTimeStr()
		lngTime = lngTime + 1
		GetTimeStr = strDate & lngTime
	End Function

	Private Function GetFerr(lngFsiz, strFext)
		Dim intFerr
		intFerr = 0
		If lngFsiz > NC_FileSize And NC_FileSize > 0 Then
			If NC_Error = 0 Or NC_Error = 2 Then NC_Error = NC_Error + 1
			intFerr = intFerr + 1
		End If
		If InStr(1, LCase("|" & NC_FileType & "|"), LCase("|" & strFext & "|")) = 0 And NC_FileType <> "" Then
			If NC_Error < 2 Then NC_Error = NC_Error + 2
			intFerr = intFerr + 2
		End If
		GetFerr = intFerr
	End Function

	Public Function Save(Item, strFnam)
		Save = False
		If objForm.Exists(Item & "_From") Then
			Dim intFerr, strFext
			strFext = objForm(Item & "_Ext")
			intFerr = GetFerr(objForm(Item & "_Size"), strFext)
			If objForm.Exists(Item & "_Err") Then
				If intFerr = 0 Then
					objForm(Item & "_Err") = 0
				End If
			Else
				objForm.Add Item & "_Err", intFerr
			End If
			If intFerr <> 0 Then Exit Function
			If VarType(strFnam) = 2 Then
				Select Case strFnam
					Case 0
						strFnam = GetTimeStr()
						If strFext <> "" Then strFnam = strFnam & "." & strFext
					Case 1
						strFnam = objForm(Item & "_Name")
				End Select
			End If
			binItem.Type = 1
			binItem.Open
			binForm.Position = objForm(Item & "_From")
			binForm.CopyTo binItem, objForm(Item & "_Size")
			binItem.SaveToFile Server.MapPath(NC_SavePath & strFnam), 2
			binItem.Close
			If objForm.Exists(Item) Then
				objForm(Item) = strFnam
			Else
				objForm.Add Item, strFnam
			End If
			Save = True
		End If
	End Function

	Public Function GetData(Item)
		GetData = ""
		If objForm.Exists(Item & "_From") Then
			If GetFerr(objForm(Item & "_Size"), objForm(Item & "_Ext")) <> 0 Then Exit Function
			binForm.Position = objForm(Item & "_From")
			GetData = binFormStream.Read(objForm(Item & "_Size"))
		End If
	End Function

	Public Function Form(Item)
		If objForm.Exists(Item) Then
			Form = objForm(Item)
		Else
			Form = ""
		End If
	End Function

	Private Function BinVal2(bin)
		Dim lngValue, i
		lngValue = 0
		For i = LenB(bin) To 1 Step -1
			lngValue = lngValue * 256 + AscB(MidB(bin, i, 1))
		Next
		BinVal2 = lngValue
	End Function

	Private Function Bin2Val(bin)
		Dim lngValue, i
		lngValue = 0
		For i = 1 To LenB(bin)
			lngValue = lngValue * 256 + AscB(MidB(bin, i, 1))
		Next
		Bin2Val = lngValue
	End Function

	Public Function CreatePath(formPath)
		Dim objFSO, Fsofolder, uploadpath
		uploadpath = Year(Now) & "-" & Month(Now) '以年月创建上传文件夹，格式：2003－8
		On Error Resume Next
		Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
		If objFSO.FolderExists(Server.MapPath(formPath & uploadpath)) = False Then
			objFSO.CreateFolder Server.MapPath(formPath & uploadpath)
		End If
		If Err.Number = 0 Then
			CreatePath = uploadpath & "/"
		Else
			CreatePath = ""
		End If
		Set objFSO = Nothing
	End Function

End Class
%>