<%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%>
<%
server.ScriptTimeout=999999
Dim Upload,path,tempCls,newName
'---------------------------------------------------------------------------------------------
'組件設置a.MD5File為2，3時 的實例代碼
if Trim(Request.QueryString("access2008_cmd"))="2" then '服務器提交MD5驗證後的文件信息進行驗證
'Trim(Request.QueryString("access2008_File_name")) '文件名
'Trim(Request.QueryString("access2008_File_size")) '文件大小，單位字節
'Trim(Request.QueryString("access2008_File_type")) '文件類型 例如.gif .png
'Trim(Request.QueryString("access2008_File_md5")) '文件的MD5簽名
Response.Write(0) '返回命令 0 = 開始上傳文件， 2 = 不上傳文件，前臺直接顯示上傳完成
Response.End()
elseif Trim(Request.QueryString("access2008_cmd"))="3" then '服務器提交文件信息進行驗證
'Trim(Request.QueryString("access2008_File_name")) '文件名
'Trim(Request.QueryString("access2008_File_size")) '文件大小，單位字節
'Trim(Request.QueryString("access2008_File_type")) '文件類型 例如.gif .png
Response.Write(1)'返回命令 0 = 開始上傳文件,1 = 提交MD5驗證後的文件信息進行驗證, 2 = 不上傳文件，前臺直接顯示上傳完成
Response.End()
end if
'---------------------------------------------------------------------------------------------
'===============================================================================
set Upload=new AnUpLoad '創建類實例
Upload.SingleSize=100*1024*1024*1024 '設置單個文件最大上傳限制,按字節計；默認為不限制
Upload.MaxSize=200*1024*1024*1024 '設置最大上傳限制,按字節計；默認為不限制
Upload.Exe="bmp|png|jpeg|jpg|gif|mp3" '設置合法擴展名,以|分割,忽略大小寫
Upload.Charset="utf-8" '設置文本編碼，默認為utf-8
Upload.openProcesser=false '禁止進度條功能，如果啟用，需配合客戶端程序
Upload.GetData() '獲取並保存數據,必須調用本方法
newName = 0 '是否已新文件名保存文件,0 = 重新命名,1 = 原文件名
lujing="/upload/img/" '新文件路徑
'===============================================================================
if Upload.ErrorID>0 then '判斷錯誤號,如果myupload.Err<=0表示正常
' response.write Upload.Description '如果出現錯誤,獲取錯誤描述
else
if Upload.files(-1).count>0 then '這裏判斷你是否選擇了文件他
path=server.mappath(lujing) '文件保存路徑(這裏是當前文件夾) '保存第一個文件(以新文件名保存)
set tempCls=Upload.files("Filedata")
tempCls.SaveToFile path,newName
'response.write "![](\upload\img\"&tempCls.FileName&")
"
'response.write "文件:" & tempCls.FileName & "上傳完畢,大小為" & Upload.getsize(tempCls.Size) & ";原文件名" & tempCls.LocalName & "!
"
'response.Write("MD5效驗:"&Trim(Request.QueryString("access2008_File_MD5")))
'Response.Write("
上傳成功！你選擇的是"&Upload.forms("select")&"--"&Upload.forms("select2")&"")
'response.Write(Upload.forms("access2008_box_info_max")&Upload.forms("access2008_box_info_over"))
'response.Write("
旋轉角度："&Trim(Upload.forms("access2008_image_rotation")))
'輸出MP3信息
if (Upload.forms("access2008_box_info_upload")-1)=0 then
response.Write (lujing&tempCls.FileName)
else
response.Write (lujing&tempCls.FileName&"|")
end if
outMP3Info()
else
response.Write "您沒有上傳任何文件！"
end if
end if
set Upload=nothing '銷毀類實例
sub outMP3Info()
dim info
dim infoArr
info = Trim(Upload.forms("access2008_mp3_info"))&""
if len(info)>0 then
infoArr = split(info,"|")
if ubound(infoArr) = 7 then
response.Write("
MP3文件信息:
")
response.Write("版本:"&infoArr(0)&"
")
response.Write("層:"&infoArr(1)&"
")
if infoArr(2) = 0 then
response.Write("CRC校驗:校驗
")
else
response.Write("CRC校驗:不校驗
")
end if
response.Write("位率:"&infoArr(3)&"Kbps
")
response.Write("采樣頻率:"&infoArr(4)&"Hz
")
if infoArr(5) = 0then
response.Write("聲道模式:立體聲Stereo
")
elseif infoArr(5) = 1then
response.Write("聲道模式:Joint Stereo
")
elseif infoArr(5) = 2then
response.Write("聲道模式:雙聲道
")
else
response.Write("聲道模式:單聲道
")
end if
if infoArr(6) = 0 then
response.Write("版權:不合法
")
else
response.Write("版權:合法
")
end if
if infoArr(7) = 0 then
response.Write("原版標誌:非原版
")
else
response.Write("原版標誌:原版
")
end if
end if
end if
end sub
'=========================================================
'類名: AnUpLoad(艾恩無組件上傳類)
'作者: Anlige
'版本: 艾恩無組件上傳類V9.9.9
'開發日期: 2008-4-12
'修改日期: 2009-9-9
'作者主頁: http://www.ii-home.cn
'Email: aiener@139.com
'QQ: 1034555083
'=========================================================
Dim StreamT
Class AnUpLoad
Private Form, Fils
Private vCharSet, vMaxSize, vSingleSize, vErr, vVersion, vTotalSize, vExe, pID,vOP
'==============================
'設置和讀取屬性開始
'==============================
Public Property Let MaxSize(ByVal value)
vMaxSize = value
End Property
Public Property Let SingleSize(ByVal value)
vSingleSize = value
End Property
Public Property Let Exe(ByVal value)
vExe = LCase(value)
End Property
Public Property Let CharSet(ByVal value)
vCharSet = value
End Property
Public Property Get ErrorID()
ErrorID = vErr
End Property
Public Property Get Description()
Description = GetErr(vErr)
End Property
Public Property Get Version()
Version = vVersion
End Property
Public Property Get TotalSize()
TotalSize = vTotalSize
End Property
Public Property Get ProcessID()
ProcessID = pID
End Property
Public Property Let openProcesser(ByVal value)
vOP = value
End Property
'==============================
'設置和讀取屬性結束，初始化類
'==============================
Private Sub Class_Initialize()
set StreamT=server.createobject("ADODB.STREAM")
set Form = server.createobject("Scripting.Dictionary")
set Fils = server.createobject("Scripting.Dictionary")
vVersion = "艾恩無組件上傳類V9.9.9"
vMaxSize = -1
vSingleSize = -1
vErr = -1
vExe = ""
vTotalSize = 0
vCharSet = "utf-8"
vOP=false
pID="AnUpload"
setApp "",0,0,""
End Sub
Private Sub Class_Terminate()
Form.RemoveAll()
Fils.RemoveAll()
Set Form = Nothing
Set Fils = Nothing
Set StreamT = Nothing
End Sub
'==============================
'函數名:GetData
'作用:處理客戶端提交來的所有數據
'==============================
Public Sub GetData()
If vMaxSize > 0 And Request.TotalBytes > vMaxSize Then '判斷上傳數據總大小
vErr = 1
Exit Sub
End If
if vOP then pID=request.querystring("processid")
Dim value, str, bcrlf, fpos, sSplit, slen, istart
Dim TotalBytes,BytesRead,ChunkReadSize,PartSize,DataPart,tempdata,formend, formhead, startpos, endpos, formname, FileName, fileExe, valueend, NewName,localname,type_1,contentType
If checkEntryType = True Then
vTotalSize = 0
StreamT.Type = 1
StreamT.Mode = 3
StreamT.Open
TotalBytes = Request.TotalBytes
BytesRead = 0
ChunkReadSize = 1024 * 36
'循環分塊讀取
Do While BytesRead < TotalBytes
'分塊讀取
PartSize = ChunkReadSize
If PartSize + BytesRead > TotalBytes Then PartSize = TotalBytes - BytesRead
DataPart = Request.BinaryRead(PartSize)
StreamT.Write DataPart
BytesRead = BytesRead + PartSize
setApp "uploading",TotalBytes,BytesRead,""
Loop
setApp "uploaded",TotalBytes,BytesRead,""
StreamT.Position = 0
tempdata = StreamT.Read
bcrlf = ChrB(13) & ChrB(10)
fpos = InStrB(1, tempdata, bcrlf)
sSplit = MidB(tempdata, 1, fpos - 1)
slen = LenB(sSplit)
istart = slen + 2
Do
formend = InStrB(istart, tempdata, bcrlf & bcrlf)
formhead = MidB(tempdata, istart, formend - istart)
str = Bytes2Str(formhead)
startpos = InStr(str, "name=""") + 6
endpos = InStr(startpos, str, """")
formname = LCase(Mid(str, startpos, endpos - startpos))
valueend = InStrB(formend + 3, tempdata, sSplit)
If InStr(str, "filename=""") > 0 Then
startpos = InStr(str, "filename=""") + 10
endpos = InStr(startpos, str, """")
type_1=instr(endpos,lcase(str),"content-type")
contentType=trim(mid(str,type_1+13))
FileName = Mid(str, startpos, endpos - startpos)
If Trim(FileName) <> "" Then
LocalName = FileName
FileName = Replace(FileName, "/", "\")
FileName = Mid(FileName, InStrRev(FileName, "\") + 1)
setApp "processing",TotalBytes,BytesRead,FileName
If instr(FileName,".")>0 Then
fileExe = Split(FileName, ".")(UBound(Split(FileName, ".")))
else
fileExe = ""
End If
If vExe <> "" Then '判斷擴展名
If checkExe(fileExe) = True Then
vErr = 3
Exit Sub
End If
End If
NewName = Getname()
NewName = NewName & "." & fileExe
vTotalSize = vTotalSize + valueend - formend - 6
If vSingleSize > 0 And (valueend - formend - 6) > vSingleSize Then '判斷上傳單個文件大小
vErr = 5
Exit Sub
End If
If vMaxSize > 0 And vTotalSize > vMaxSize Then '判斷上傳數據總大小
vErr = 1
Exit Sub
End If
If Fils.Exists(formname) Then
vErr = 4
Exit Sub
Else
Dim fileCls:set fileCls=New fileAction
fileCls.ContentType=contentType
fileCls.Size = (valueend - formend - 6)
fileCls.Position = (formend + 3)
fileCls.NewName = NewName
fileCls.LocalName = FileName
Fils.Add formname, fileCls
Form.Add formname, LocalName
Set fileCls = Nothing
End If
End If
Else
value = MidB(tempdata, formend + 4, valueend - formend - 6)
If Form.Exists(formname) Then
Form(formname) = Form(formname) & "," & Bytes2Str(value)
Else
Form.Add formname, Bytes2Str(value)
End If
End If
istart = valueend + 2 + slen
Loop Until (istart + 2) >= LenB(tempdata)
vErr = 0
Else
vErr = 2
End If
setApp "processed",TotalBytes,BytesRead,""
if err then setApp "faild",1,0,err.description
End Sub
Public sub setApp(stp,total,current,desc)
Application.lock()
Application(pID)="{ID:""" & pID & """,step:""" & stp & """,total:" & total & ",now:" & current & ",description:""" & desc & """,dt:""" & now() & """}"
Application.unlock()
end sub
'==============================
'判斷擴展名
'==============================
Private Function checkExe(ByVal ex)
Dim notIn: notIn = True
If vExe="*" then
notIn=false
elseIf InStr(1, vExe, "|") > 0 Then
Dim tempExe: tempExe = Split(vExe, "|")
Dim I: I = 0
For I = 0 To UBound(tempExe)
If LCase(ex) = tempExe(I) Then
notIn = False
Exit For
End If
Next
Else
If vExe = LCase(ex) Then
notIn = False
End If
End If
checkExe = notIn
End Function
'==============================
'把數字轉換為文件大小顯示方式
'==============================
Public Function GetSize(ByVal Size)
If Size < 1024 Then
GetSize = FormatNumber(Size, 2) & "B"
ElseIf Size >= 1024 And Size < 1048576 Then
GetSize = FormatNumber(Size / 1024, 2) & "KB"
ElseIf Size >= 1048576 Then
GetSize = FormatNumber((Size / 1024) / 1024, 2) & "MB"
End If
End Function
'==============================
'二進制數據轉換為字符
'==============================
Private Function Bytes2Str(ByVal byt)
If LenB(byt) = 0 Then
Bytes2Str = ""
Exit Function
End If
Dim mystream, bstr
Set mystream =server.createobject("ADODB.Stream")
mystream.Type = 2
mystream.Mode = 3
mystream.Open
mystream.WriteText byt
mystream.Position = 0
mystream.CharSet = vCharSet
mystream.Position = 2
bstr = mystream.ReadText()
mystream.Close
Set mystream = Nothing
Bytes2Str = bstr
End Function
'==============================
'獲取錯誤描述
'==============================
Private Function GetErr(ByVal Num)
Select Case Num
Case 0
GetErr = "數據處理完畢!"
Case 1
GetErr = "上傳數據超過" & GetSize(vMaxSize) & "限制!可設置MaxSize屬性來改變限制!"
Case 2
GetErr = "未設置上傳表單enctype屬性為multipart/form-data或者未設置method屬性為Post,上傳無效!"
Case 3
GetErr = "含有非法擴展名文件!只能上傳擴展名為" & Replace(vExe, "|", ",") & "的文件"
Case 4
GetErr = "對不起,程序不允許使用相同name屬性的文件域!"
Case 5
GetErr = "單個文件大小超出" & GetSize(vSingleSize) & "的上傳限制!"
End Select
End Function
'==============================
'根據日期生成隨機文件名
'==============================
Private Function Getname()
Dim y, m, d, h, mm, S, r
Randomize
y = Year(Now)
m = Month(Now): If m < 10 Then m = "0" & m
d = Day(Now): If d < 10 Then d = "0" & d
h = Hour(Now): If h < 10 Then h = "0" & h
mm = Minute(Now): If mm < 10 Then mm = "0" & mm
S = Second(Now): If S < 10 Then S = "0" & S
r = 0
r = CInt(Rnd() * 1000)
If r < 10 Then r = "00" & r
If r < 100 And r >= 10 Then r = "0" & r
Getname = y & m & d & h & mm & S & r
End Function
'==============================
'檢測上傳類型是否為multipart/form-data
'==============================
Private Function checkEntryType()
Dim ContentType, ctArray, bArray,RequestMethod
RequestMethod=trim(LCase(Request.ServerVariables("REQUEST_METHOD")))
if RequestMethod="" or RequestMethod<>"post" then
checkEntryType = False
exit function
end if
ContentType = LCase(Request.ServerVariables("HTTP_CONTENT_TYPE"))
ctArray = Split(ContentType, ";")
if ubound(ctarray)>=0 then
If Trim(ctArray(0)) = "multipart/form-data" Then
checkEntryType = True
Else
checkEntryType = False
End If
else
checkEntryType = False
end if
End Function
'==============================
'獲取上傳表單值,參數可選,如果為-1則返回一個包含所有表單項的一個dictionary對象
'==============================
Public Function Forms(ByVal formname)
If trim(formname) = "-1" Then
Set Forms = Form
Else
If Form.Exists(LCase(formname)) Then
Forms = Form(LCase(formname))
Else
Forms = ""
End If
End If
End Function
'==============================
'獲取上傳的文件類,參數可選,如果為-1則返回一個包含所有上傳文件類的一個dictionary對象
'==============================
Public Function Files(ByVal formname)
If trim(formname) = "-1" Then
Set Files = Fils
Else
If Fils.Exists(LCase(formname)) Then
Set Files = Fils(LCase(formname))
Else
Set Files = Nothing
End If
End If
End Function
'==============================
'簡便文件保存函數
'==============================
Public Function SaveAs(ByVal formname,ByVal path, ByVal saveType )
dim vfileAction
set vfileAction=Files(formname)
if vfileAction.FileName<>"" then
if vfileAction.SaveToFile(path,saveType) then
SaveAs=vfileAction.FileName
else
SaveAs="Has Error!"
end if
end if
set vfileAction=nothing
end function
End Class
'==============================
'文件類,存儲文件的詳細信息
'==============================
Class fileAction
Private vSize, vPosition, vName, vNewName, vLocalName, vPath, saveName,vContentType
'==============================
'設置屬性
'==============================
Public Property Let NewName(ByVal value)
vNewName = value
End Property
Public Property Get NewName()
NewName = vNewName
End Property
Public Property Let ContentType(vData)
vContentType = vData
End Property
Public Property Get ContentType()
ContentType = vContentType
End Property
Public Property Let LocalName(ByVal value)
vLocalName = value
vName = value
End Property
Public Property Get LocalName()
LocalName = vLocalName
End Property
Public Property Get FileName()
FileName = vName
End Property
Public Property Let Position(ByVal value)
vPosition = value
End Property
Public Property Let Size(ByVal value)
vSize = value
End Property
Public Property Get Size()
Size = vSize
End Property
'==============================
'函數名:SaveToFile
'作用:根據參數保存文件到服務器
'參數:參數1--文件保存的路徑
' 參數2--文件保存的方式,有兩個可選項0表示以新名字(時間+隨機數)為文件名保存,1表示以原文件名保存文件
'==============================
Public Function SaveToFile(ByVal path, ByVal saveType)
On Error Resume Next
Err.Clear
vPath = Replace(path, "/", "\")
If Right(vPath, 1) <> "\" Then vPath = vPath & "\"
CreateFolder vPath
Dim mystream
Set mystream =server.createobject("ADODB.Stream")
mystream.Type = 1
mystream.Mode = 3
mystream.Open
StreamT.Position = vPosition
StreamT.CopyTo mystream, vSize
vName = vNewName
If saveType = 1 Then vName = vLocalName
mystream.SaveToFile vPath & vName, 2
mystream.Close
Set mystream = Nothing
If Err Then
SaveToFile = False
Else
SaveToFile = True
End If
End Function
'==============================
'函數名:GetBytes
'作用:獲取文件的二進制形式
'參數:無
'==============================
Public Function GetBytes()
StreamT.Position = vPosition
GetBytes = StreamT.Read(vSize)
End Function
'==============================
'函數名:CreateFolder
'作用:自動創建文件夾
'參數:要創建文件夾的路徑
'==============================
Private Function CreateFolder(ByVal FolderPath)
on error resume next
Dim FolderArray
Dim i
Dim DiskName
Dim Created
Dim FSO : Set FSO = Server.CreateObject("Scripting.FileSystemObject")
If FSO.FolderExists(FolderPath) Then
Set Fso = Nothing
Exit Function
End If
FolderPath = Replace(FolderPath, "/", "\")
If Mid(FolderPath, Len(FolderPath), 1) = "\" Then FolderPath = Mid(FolderPath, 1, Len(FolderPath) - 1)
FolderArray = Split(FolderPath, "\")
DiskName = FolderArray(0)
Created = DiskName
For i = 1 To UBound(FolderArray)
Created = Created & "\" & FolderArray(i)
If Not FSO.FolderExists(Created) Then FSO.CreateFolder Created
Next
Set FSO = Nothing
err.clear
End Function
End Class
%>