?? ixs_clsupload.asp
字號:
FormNames = FormNames & ", " & FormNames
Next
UploadForms.Add FormName , FormNames
Else
UploadForms.Add FormName , UploadObj.Form(FormName)
End If
End If
Next
If Not IsEmpty(SessionName) Then Session(SessionName) = Empty
End Sub
' ============================================
' DvFile.Upload V1.0組件上傳
' ============================================
Private Sub SaveFile_3()
Dim FormName, Item, File
Dim FileExt, FileName, FileType, FileToBinary
UploadObj.InceptFileType = InceptFile
UploadObj.MaxSize = FileMaxSize
UploadObj.Install
FileToBinary = Null
If Not IsEmpty(SessionName) Then
If Session(SessionName) <> UploadObj.Form(SessionName) Or Session(SessionName) = Empty Then
ErrCodes = 7
Exit Sub
End If
End If
If UploadObj.Err > 0 then
Select Case UploadObj.Err
Case 1 : ErrCodes = 3
Case 2 : ErrCodes = 4
Case 3 : ErrCodes = 5
Case 4 : ErrCodes = 5
Case 5 : ErrCodes = -1
End Select
Exit Sub
Else
For Each FormName In UploadObj.File ''列出所有上傳了的文件
If Count>MaxFile Then
ErrCodes = 6
Exit Sub
End If
Set File = UploadObj.File(FormName)
FileExt = FixName(File.FileExt)
If CheckFileExt(FileExt) = False then
ErrCodes = 5
Exit Sub
End If
FileName = FormatName(FileExt)
OldFileName = File.FileName ' 原文件名
FileType = CheckFiletype(FileExt)
If IsBinary Then
FileToBinary = File.FileData
End If
If File.FileSize>0 Then
UploadObj.SaveToFile Server.mappath(FilePath & FileName), FormName
AddData FormName , _
FileName , _
FilePath , _
File.FileSize , _
File.FileType , _
FileType , _
FileToBinary , _
FileExt , _
File.FileWidth , _
File.FileHeight
Count = Count + 1
CountSize = CountSize + File.FileSize
End If
Set File=Nothing
Next
For Each Item in UploadObj.Form
UploadForms.Add Item.Name , Item.Value
Next
If Not IsEmpty(SessionName) Then Session(SessionName) = Empty
End If
End Sub
Private Sub AddData( Form_Name, File_Name, File_Path, File_Size, File_ContentType, File_Type, File_Data, File_Ext, File_Width, File_Height )
Set FileInfo = New FileInfo_Cls
FileInfo.FormName = Form_Name
FileInfo.FileName = File_Name
FileInfo.FilePath = File_Path
FileInfo.FileSize = File_Size
FileInfo.FileType = File_Type
FileInfo.FileContentType = File_ContentType
FileInfo.FileExt = File_Ext
FileInfo.FileData = File_Data
FileInfo.FileHeight = File_Height
FileInfo.FileWidth = File_Width
UploadFiles.Add Form_Name , FileInfo
Set FileInfo = Nothing
End Sub
'創建預覽圖片:Call CreateView(原始文件的路徑,預覽文件名及路徑,原文件后綴)
Public Sub CreateView(Imagename, TempFilename, FileExt)
If ErrCodes <>0 Then Exit Sub
Select Case Preview_Type
Case 0
Image_Obj_0 Imagename, TempFilename, FileExt
Case 1
Image_Obj_1 Imagename, TempFilename, FileExt
Case 2
Image_Obj_2 Imagename, TempFilename, FileExt
Case Else
Preview_Type = 999
End Select
End Sub
Sub Image_Obj_0(Imagename,TempFilename,FileExt)
ImageObj.SetSavePreviewImagePath = Server.MapPath(TempFilename) '預覽圖存放路徑
ImageObj.SetPreviewImageSize = SetPreviewImageSize '預覽圖寬度
ImageObj.SetImageFile = Trim(Server.MapPath(Imagename)) 'Imagename原始文件的物理路徑
'創建預覽圖的文件
If ImageObj.DoImageProcess = False Then
ErrCodes = -1
Response.Write "生成預覽圖錯誤: " & ImageObj.GetErrString
End If
End Sub
'---------------------AspJpegV1.2---------------
Sub Image_Obj_1(Imagename,TempFilename,FileExt)
' 讀取要處理的原文件
Dim Draw_X,Draw_Y,Logobox
Draw_X = 0
Draw_Y = 0
FileExt = LCase(FileExt)
ImageObj.Open Trim(Server.MapPath(Imagename))
If ImageObj.OriginalWidth<View_ImageWidth or ImageObj.Originalheight<View_ImageHeight Then
TempFilename = ""
Exit Sub
Else
If FileExt<>"gif" and ImageObj.OriginalWidth > Draw_ImageWidth * 2 and Draw_Type >0 Then
Draw_X = DrawImage_X(ImageObj.OriginalWidth,Draw_ImageWidth,2)
Draw_Y = DrawImage_y(ImageObj.Originalheight,Draw_ImageHeight,2)
If Draw_Type=2 Then
Set Logobox = Server.CreateObject(ServerObject_016)
'*添加水印圖片 添加時請關閉水印字體*
'//讀取添加的圖片
Logobox.Open Server.MapPath(Draw_Info)
Logobox.Width = Draw_ImageWidth '// 加入圖片的原寬度
Logobox.Height = Draw_ImageHeight '// 加入圖片的原高度
ImageObj.DrawImage Draw_X, Draw_Y, Logobox, Draw_Graph,Transition_Color,90 '// 加入圖片的位置價坐標（添加水印圖片）
'ImageObj.Sharpen 1, 130
ImageObj.Save Server.MapPath(Imagename)
Set Logobox=Nothing
Else
'//關于修改字體及文字顏色的
ImageObj.Canvas.Font.Color = Draw_FontColor '// 文字的顏色
ImageObj.Canvas.Font.Family = Draw_FontFamily '// 文字的字體
ImageObj.Canvas.Font.Bold = Draw_FontBold
ImageObj.Canvas.Font.Size = Draw_FontSize '//字體大小
' Draw frame: black, 2-pixel width
ImageObj.Canvas.Print Draw_X, Draw_Y, Draw_Info '// 加入文字的位置坐標
ImageObj.Canvas.Pen.Color = &H000000 '// 邊框的顏色
ImageObj.Canvas.Pen.Width = 1 '// 邊框的粗細
ImageObj.Canvas.Brush.Solid = False '// 圖片邊框內是否填充顏色
'ImageObj.Canvas.Bar 0, 0, ImageObj.Width, ImageObj.Height '// 圖片邊框線的位置坐標
ImageObj.Save Server.MapPath(Imagename)
End If
End If
If ImageObj.Width > ImageObj.height Then
ImageObj.Width = View_ImageWidth
ImageObj.Height = ViewImage_Height(ImageObj.OriginalWidth,ImageObj.Originalheight,View_ImageWidth,View_ImageHeight)
Else
ImageObj.Width = ViewImage_Width(ImageObj.OriginalWidth,ImageObj.Originalheight,View_ImageWidth,View_ImageHeight)
ImageObj.Height = View_ImageHeight
End If
ImageObj.Sharpen 1, 120
ImageObj.Save Server.MapPath(TempFilename) '// 生成預覽文件
End If
End Sub
'SoftArtisans ImgWriter V1.21
Public Sub Image_Obj_2(Imagename,TempFilename,FileExt)
'定義變量
Dim Draw_X,Draw_Y
FileExt = LCase(FileExt)
Draw_X = 0
Draw_Y = 0
' 讀取要處理的原文件
ImageObj.LoadImage Trim(Server.MapPath(Imagename))
If ImageObj.ErrorDescription <> "" Then
TempFilename = ""
ErrCodes = -1
Response.Write "生成預覽圖錯誤: " &ImageObj.ErrorDescription
Exit Sub
End If
If ImageObj.Width<Cint(View_ImageWidth) or ImageObj.Height<Cint(View_ImageHeight) Then
TempFilename=""
Exit Sub
Else
IF FileExt<>"gif" and ImageObj.Width > Draw_ImageWidth * 2 and Draw_Type>0 Then
Draw_X = DrawImage_X(ImageObj.Width,Draw_ImageWidth,2)
Draw_Y = DrawImage_y(ImageObj.Height,Draw_ImageHeight,2)
Dim saiTopMiddle
Select Case Draw_XYType
Case "0" '左上
saiTopMiddle = 3
Case "1" '左下
saiTopMiddle = 5
Case "2" '居中
saiTopMiddle = 1
Case "3" '右上
saiTopMiddle = 6
Case "4" '右下
saiTopMiddle = 8
Case Else '不顯示
saiTopMiddle = 0
End Select
If Draw_Type=2 Then
ImageObj.AddWatermark Server.MapPath(Draw_Info), saiTopMiddle, Draw_Graph,Transition_Color,True
'ImageObj.AddWatermark Server.MapPath(Request.QueryString("mimg")), 0, 0.3
Else
ImageObj.Font.Italic = False '斜體
ImageObj.Font.height = Draw_FontSize
ImageObj.Font.name = Draw_FontFamily
ImageObj.Font.Color = Draw_FontColor
ImageObj.Text = Draw_Info
ImageObj.DrawTextOnImage Draw_X, Draw_Y, ImageObj.TextWidth, ImageObj.TextHeight
End If
ImageObj.SaveImage 0, ImageObj.ImageFormat, Server.MapPath(Imagename)
End If
'ImageObj.SharpenImage 100
ImageObj.ColorResolution = 24 '24色保存
ImageObj.ResizeImage View_ImageWidth,View_ImageHeight,0,0
'0=saiFile,1=saiMemory,2=saiBrowser,4=saiDatabaseBlob
'saiBMP=1,saiGIF=2,saiJPG=3,saiPNG=4,saiPCX=5,saiTIFF=6,saiWMF=7,saiEMF=8,saiPSD=9
ImageObj.SaveImage 0, 3, Server.MapPath(TempFilename)
End If
End Sub
'比例或固定縮小
Private Function ViewImage_Width(Image_W,Image_H,xView_W,xView_H)
If Draw_SizeType = "1" Then
ViewImage_Width = Image_W * xView_H / Image_H
Else
ViewImage_Width = xView_W
End If
End Function
Private Function ViewImage_Height(Image_W,Image_H,xView_W,xView_H)
If Draw_SizeType = "1" Then
ViewImage_Height = xView_W * Image_H / Image_W
Else
ViewImage_Height = xView_H
End If
End Function
'SpaceVal X軸坐標邊緣距離
Private Function DrawImage_X(xImage_W,xLogo_W,SpaceVal)
Select Case Draw_XYType
Case "0" '左上
DrawImage_X = SpaceVal
Case "1" '左下
DrawImage_X = SpaceVal
Case "2" '居中
DrawImage_X = (xImage_W + xLogo_W) / 2 - xLogo_W ' By:Guidy
Case "3" '右上
DrawImage_X = xImage_W - xLogo_W - SpaceVal
Case "4" '右下
DrawImage_X = xImage_W - xLogo_W - SpaceVal
Case Else '不顯示
DrawImage_X = 0
End Select
End Function
'SpaceVal Y軸坐標邊緣距離
Private Function DrawImage_Y(yImage_H,yLogo_H,SpaceVal)
Select Case Draw_XYType
Case "0" '左上
DrawImage_Y = SpaceVal
Case "1" '左下
DrawImage_Y = yImage_H - yLogo_H - SpaceVal
Case "2" '居中
DrawImage_Y = (yImage_H + yLogo_H) / 2 - yLogo_H ' By:Guidy
Case "3" '右上
DrawImage_Y = SpaceVal
Case "4" '右下
DrawImage_Y = yImage_H - yLogo_H - SpaceVal
Case Else '不顯示
DrawImage_Y = 0
End Select
End Function
' ============================================
' 檢測文件夾是否存在 如果不存在就自動創建
' ============================================
Function CreatePath(StrPath)
Dim ObjFSO, Fsofolder, UpLoadPath
UpLoadPath = FormatTime(Now(), AutoDir)
On Error Resume Next
If Right(StrPath, 1) <> "/" Then StrPath = StrPath & "/"
Set ObjFSO = Server.CreateObject(ServerObject_005)
If ObjFSO.FolderExists(Server.MapPath(StrPath & UpLoadPath)) = False Then
ObjFSO.CreateFolder Server.MapPath(StrPath & UpLoadPath)
End If
If Err.Number = 0 Then
CreatePath = StrPath & UpLoadPath & "/"
Else
Err.Clear
CreatePath = StrPath
End If
Set ObjFSO = Nothing
End Function
End Class
Class FileInfo_Cls
Public FormName, FileName, FilePath, FileSize, FileContentType, FileType, FileData, FileExt, FileWidth, FileHeight
Private Sub Class_Initialize
FileWidth = -1
FileHeight = -1
End Sub
End Class
' ============================================
' 刪除指定文件夾下的所有文件
' 這里用來刪除"UpLoadData/"文件夾下面的文件
' ============================================
Function DeleteUpDateFile(FilePath)
On Error Resume Next
If Right(FilePath, 1) <> "/" Then FilePath = FilePath & "/"
DeleteUpDateFile = False
Dim Fso, F, F1, Fc, S
Set Fso = CreateObject(ServerObject_005)
If Err Then Err.Clear : Exit Function
Set F = Fso.GetFolder(Server.MapPath(FilePath))
Set Fc = F.Files
For Each F1 In Fc
Fso.DeleteFile(Server.MapPath(FilePath & F1.Name))
Next
Set Fc = Nothing
Set Fso = Nothing
DeleteUpDateFile = True
End Function
' ============================================
' 格式化時間(用于顯示)
' ============================================
Public Function FormatTime(s_Time, n_Flag)
If Not IsDate(s_Time) Then Exit Function
Dim y, m, d, h, mi, s, w
FormatTime = ""
y = CStr(Year(s_Time))
m = CStr(Month(s_Time))
If Len(m) = 1 Then m = "0" & m
d = CStr(Day(s_Time))
If Len(d) = 1 Then d = "0" & d
h = CStr(Hour(s_Time))
If Len(h) = 1 Then h = "0" & h
mi = CStr(Minute(s_Time))
If Len(mi) = 1 Then mi = "0" & mi
s = CStr(Second(s_Time))
If Len(s) = 1 Then s = "0" & s
Select Case n_Flag
Case 1 ' yyyymmddhhmmss
FormatTime = y & m & d & h & mi & s
Case 2 ' yyyy-mm-dd
FormatTime = y & "-" & m & "-" & d
Case 3 ' YYYY-mm
FormatTime = Y & "-" & m
Case Else ' YYYY-mm
FormatTime = Y & "-" & m
End Select
End Function
%>?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -