<!--#include file="../../inc/AspCms_MainClass.asp" -->
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gbk" />
<title>文件上傳</title>
<style type="text/css">
td,div,input,select,textarea,body {font-family:Verdana, 宋體, fantasy;font-size:12px;}
body {margin:0 3px;padding:0;background-color:transparent;}
form {margin:0;padding:0;}
</style>
<LINK href="../images/style.css" type=text/css rel=stylesheet>
</head>
<body>
<%
CheckLogin()
dim action,sortType,saveFilePath,stype
action = getForm("action", "get")
stype = getForm("stype","get")
sortType = getForm("sortType","get")
Dim Tobj : Tobj =getForm("Tobj", "get")
if action="save" then
response.write uploadfile()
else
%>
<form name="form" enctype="multipart/form-data" action="?action=save&sortType=<%=sortType%>&stype=<%=stype%>&Tobj=<%=Tobj%>" method="post">
<input type="file" style=" width:260px;" class="input" name="filedata"/>
<input type="submit"class="button" name="submit" value="上傳" >
</form>
<%
end if
%>
</body>
</html>
<%
function uploadfile()
dim immediate,attachdir,dirtype,maxattachsize,upext,saveFilePath,fType,fs
'上傳文件保存路徑，結尾不要帶/
select case sortType
case "2"
attachdir=sitePath&"/"&upLoadPath &"/news"
case "3"
attachdir=sitePath&"/"&upLoadPath &"/product"
case "4"
attachdir=sitePath&"/"&upLoadPath &"/down"
case "5"
attachdir=sitePath&"/"&upLoadPath &"/job"
case "6"
attachdir=sitePath&"/"&upLoadPath &"/album"
case "10"
attachdir=sitePath&"/"&upLoadPath &"/sort"
case "11"
attachdir=sitePath&"/"&upLoadPath &"/links"
case "12"
attachdir=sitePath&"/"&upLoadPath &"/slide"
case "13"
attachdir=sitePath&"/"&upLoadPath &"/Logo"
case "14"
attachdir=sitePath&"/"&upLoadPath &"/ad"
case else
attachdir=sitePath&"/"&upLoadPath &"/other"
end select
'die attachdir
'createFolder attachdir,"folderdir"
Set fs=Server.CreateObject("Scri"&"pting.File"&"Sys"&"temObject")
'判斷文件夾是否存在,如果不存在則創建文件夾
If not fs.FolderExists(Server.MapPath(attachdir)) then
fs.CreateFolder Server.MapPath(attachdir)
End if
set fs =nothing
saveFilePath = sitePath&"/"&upLoadPath & saveFilePath
'attachdir=sitePath+"/upload"'上傳文件保存路徑，結尾不要帶/
dirtype=2'1:按天存入目錄 2:按月存入目錄 3:按擴展名存目錄 建議使用按天存
maxattachsize=20971520'最大上傳大小，默認是2M
upext="txt,rar,zip,jpg,jpeg,gif,png,swf,wmv,avi,wma,mp3,mid"'上傳擴展名
server.ScriptTimeout=600
dim err,msg,upfile
err = ""
msg = ""
set upfile=new upfile_class
upfile.AllowExt=replace(upext,",",";")+";"
upfile.GetData(maxattachsize)
if upfile.isErr then
select case upfile.isErr
case 1
err="無數據提交"
case 2
err="文件大小超過 "+cstr(maxattachsize)+"字節"
case else
err="就是這裏出錯了:"
end select
alertMsgAndGo err,"-1"
else
dim attach_dir,attach_subdir,filename,extension,target,tmpfile,formName,oFile,fsize
for each formName in upfile.file '列出所有上傳了的文件
set oFile=upfile.file(formname)
if oFile.FileExt="" then alertMsgAndGo "無數據提交","-1"
extension=oFile.FileExt
fType=extension
select case dirtype
case 1
attach_subdir="day_"+DateFormat(now,"yymmdd")
case 2
attach_subdir="month_"+DateFormat(now,"yymm")
case 3
attach_subdir="ext_"+extension
end select
attach_dir=attachdir+"/"+attach_subdir+"/"
'建文件夾
CreateFolder attach_dir,"folderdir"
tmpfile=upfile.AutoSave(formName,Server.mappath(attach_dir)+"\")
if upfile.isErr then
if upfile.isErr=3 then
err="上傳文件擴展名必需爲："+upext
else
err=upfile.ErrMessage
end if
alertMsgAndGo err,"-1"
else
'生成隨機文件名並改名
Randomize timer
filename=DateFormat(now,"yyyymmddhhnnss")+cstr(cint(9999*Rnd))+"."+extension
target=attach_dir+filename
Set fs=Server.CreateObject("Scri"&"pting.File"&"Sys"&"temObject")
'判斷文件夾是否存在,如果不存在則創建文件夾
If not fs.FolderExists(Server.MapPath(attach_dir)) then
fs.CreateFolder Server.MapPath(attach_dir)
End if
set fs =nothing
moveFile attach_dir+tmpfile,target
if waterMark=1 then waterMarkImg target,waterMarkLocation
msg=target
if immediate="1" then msg="!"+msg
end if
fsize=oFile.filesize
set oFile=nothing
%>
<input type="text" name="file1" size="70" style="width:300px;" class="input" value="<%=target%>"> <input type="button" onClick="javascript:history.go(-1)" value="繼續上傳" class="button"><br>
<font color="blue">恭喜你！文件上傳成功。<a href="<%=Request.ServerVariables("HTTP_REFERER")%>">點擊此處繼續上傳</a></font>
<%
if stype="image" or stype="sort" then
dim inEditorStr
Select Case fType
Case "gif","jpg","png","bmp","jpeg","tif","iff"
if stype="sort" then inEditorStr="oEditor.InsertHtml(""<img src=""+""'""+ContentStr+""'""+""/>"");" & vbCrLf
'inEditorStr="oEditor.InsertHtml(""<img src=""+""'""+ContentStr+""'""+""/>"");" & vbCrLf
%>
<script type="text/javascript">
//parent.parent.FCKeditorAPI.GetInstance('content')
// 設置編輯器中內容
/*function SetEditorContents(EditorName, ContentStr) {
var oEditor = parent.FCKeditorAPI.GetInstance(EditorName) ;
oEditor.Focus();
//setTimeout(function() { oEditor.Focus(); }, 100);
//oEditor.InsertHtml("<img src="+"'"+ContentStr+"'"+"/>");
<%=inEditorStr%>
}
SetEditorContents('Content','<%=target%>')*/
// 文件上傳成功接口操作
function doInterfaceUpload(strValue){
if (strValue=="") return;
var objLinkUpload = parent.document.getElementsByName("ImagePath")[0];
if (objLinkUpload){
if (objLinkUpload.value!=""){
objLinkUpload.value = objLinkUpload.value + "|";
}
objLinkUpload.value = objLinkUpload.value + strValue;
// objLinkUpload.fireEvent("onchange");
}
}
doInterfaceUpload('<%=target%>');
doChange(parent.document.getElementById("ImagePath"),parent.document.getElementById("ImageFileList"))
function doChange(objText, objDrop){
if (!objDrop) return;
var str = objText.value;
var arr = str.split("|");
var nIndex = objDrop.selectedIndex;
objDrop.length=1;
for (var i=0; i<arr.length; i++){
objDrop.options[objDrop.length] = new Option(arr[i], arr[i]);
}
objDrop.selectedIndex = nIndex;
}
</script>
<script type="text/javascript">
function divMsg(t){
//alert(parent.document.getElementById("pw").innerHTML);
var pstr=parent.document.getElementById("pw").innerHTML;
var imgvalue=parent.document.getElementById("ImagePath").value;
if(t.indexOf("err:")==-1)
{
var ids=t
ids=ids.substr(ids.lastIndexOf("/")+1,ids.lastIndexOf("."))
ids=ids.replace(".","")
var itml = pstr + '<div class="imgDiv" id="'+ids+'"><a href="javascript:SetEditorContents(\'Content\',\'<%=target%>\')" ><img src="'+ t + '" border="0" /></a><br><input type="radio" name="IndexImageradio" οnclick="setIndexImage(\''+t+'\')" value="'+t+'" />設爲縮略圖 <a href="javascript:dropThisDiv(\''+ids+'\',\''+t+'\')">刪除</a></div> ';
imgvalue=imgvalue+t+'|';
}
else
{
var itml = pstr + '<div class="imgDiv" id="'+t+'">"'+t+'"<br/>圖片上傳失敗</div> ';
}
//document.getElementById("ImagePath").value=imgvalue;
parent.document.getElementById("pw").innerHTML=itml;
}
divMsg('<%=target%>')
</script>
<%
Case "swf"
inEditorStr="oEditor.InsertHtml('<object codebase=""http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=7,0,0,0"" classid=""clsid:D27CDB6E-AE6D-11cf-96B8-444553540000"" width=""400"" height=""300""><param name=""movie"" value=""" & target & """ /><param name=""quality"" value=""high"" /><param name=""AllowScriptAccess"" value=""never"" /><embed src=""" & target & """ quality=""high"" pluginspage=""http://www.macromedia.com/go/getflashplayer"" type=""application/x-shockwave-flash"" width=""400"" height=""300"" /></object>')" & vbCrLf
Case "mp3","wma"
inEditorStr="oEditor.InsertHtml('<object classid=""CLSID:22d6f312-b0f6-11d0-94ab-0080c74c7e95"" id=""MediaPlayer"" width=""450"" height=""70""><param name=""howStatusBar"" value=""-1""><param name=""AutoStart"" value=""False""><param name=""Filename"" value=""" & target & """></object>')" & vbCrLf
Case "rm","rmvb"
inEditorStr="oEditor.InsertHtml('<object classid=""clsid:CFCDAA03-8BE4-11cf-B84B-0020AFBBCCFA"" width=""400"" height=""300""><param name=""SRC"" value=""" & target & """ /><param name=""CONTROLS"" VALUE=""ImageWindow"" />"& vbCrLf&_
"<param name=""CONSOLE"" value=""one"" /><param name=""AUTOSTART"" value=""true"" /><embed src=""" & target & """ nojava=""true"" controls=""ImageWindow"" console=""one"" width=""400"" height=""300""></object><br/>"& vbCrLf&_
"<object classid=""clsid:CFCDAA03-8BE4-11cf-B84B-0020AFBBCCFA"" width=""400"" height=""32"" /><param name=""CONTROLS"" value=""StatusBar"" /><param name=""AUTOSTART"" value=""true"" /><param name=""CONSOLE"" value=""one"" />"& vbCrLf&_
"<embed src=""" & target & """ nojava=""true"" controls=""StatusBar"" console=""one"" width=""400"" height=""24"" /></object><br/><object classid=""clsid:CFCDAA03-8BE4-11cf-B84B-0020AFBBCCFA"" width=""400"" height=""32"" />"& vbCrLf&_
"<param name=""CONTROLS"" value=""ControlPanel"" /><param name=""AUTOSTART"" value=""true"" /><param name=""CONSOLE"" value=""one"" /><embed src=""" & target & """ nojava=""true"" controls=""ControlPanel"" console=""one"" width=""400"" height=""24"" autostart=""true"" loop=""false"" /></object>')}" & vbCrLf
Case "ra"
inEditorStr="oEditor.InsertHtml('<object classid=""clsid:CFCDAA03-8BE4-11CF-B84B-0020AFBBCCFA"" id=""RAOCX"" width=""450"" height=""60""><param name=""_ExtentX"" value=""6694""><param name=""_ExtentY"" value=""1588""><param name=""AUTOSTART"" value=""true""><param name=""SHUFFLE"" value=""0""><param name=""PREFETCH"" value=""0"">"& vbCrLf&_
"<param name=""NOLABELS"" value=""0""><param name=""SRC"" value=""" & target & """><param name=""CONTROLS"" value=""StatusBar,ControlPanel""><param name=""LOOP"" value=""0""><param name=""NUMLOOP"" value=""0""><param name=""CENTER"" value=""0""><param name=""MAINTAINASPECT"" value=""0""><param name=""BACKGROUNDCOLOR"" value=""#000000""><embed src=""" & target & """ width=""450"" autostart=""true"" height=""60""></embed></object>')" & vbCrLf
Case "asf","avi","wmv"
inEditorStr="oEditor.InsertHtml('<object classid=""clsid:22D6F312-B0F6-11D0-94AB-0080C74C7E95"" codebase=""http://activex.microsoft.com/activex/controls/mplayer/en/nsmp2inf.cab#Version=6,0,02,902"" type=""application/x-oleobject"" standby=""Loading..."" width=""400"" height=""300"">"& vbCrLf&_
"<param name=""FileName"" VALUE=""" & target & """ /><param name=""ShowStatusBar"" value=""-1"" /><param name=""AutoStart"" value=""true"" /><embed type=""application/x-mplayer2"" pluginspage=""http://www.microsoft.com/Windows/MediaPlayer/"" src=""" & target & """ autostart=""true"" width=""400"" height=""300"" /></object>')" & vbCrLf
Case Else
inEditorStr="oEditor.InsertHtml('<a href=""" & target & """>點擊下載此文件</a>')" & vbCrLf
End Select
%>
<script type="text/javascript">
//parent.parent.FCKeditorAPI.GetInstance('content')
// 設置編輯器中內容
function SetEditorContents(EditorName, ContentStr) {
var oEditor = parent.FCKeditorAPI.GetInstance(EditorName) ;
oEditor.Focus();
//setTimeout(function() { oEditor.Focus(); }, 100);
//oEditor.InsertHtml("<img src="+"'"+ContentStr+"'"+"/>");
<%=inEditorStr%>
}
SetEditorContents('Content','<%=target%>')
</script>
<%
elseif stype="file" then
echo "<script language=""javascript"">parent.document.getElementById("""&Tobj&""").value='"&target&"'</script>"
'echo "<table><tr><td bgcolor=#FFFFFF style=""font-size:12px;""><font color=red>"&filename&"上傳成功![ <span οnclick=history.go(-1)>重新上傳</span> ]</font></td></tr></table>"
end if
next
end if
set upfile=nothing
end function
function jsonString(str)
str=replace(str,"\","\\")
str=replace(str,"/","\/")
str=replace(str,"'","\'")
jsonString=str
end function
Function Iif(expression,returntrue,returnfalse)
If expression=true Then
iif=returntrue
Else
iif=returnfalse
End If
End Function
function DateFormat(strDate,fstr)
if isdate(strDate) then
dim i,temp
temp=replace(fstr,"yyyy",DatePart("yyyy",strDate))
temp=replace(temp,"yy",mid(DatePart("yyyy",strDate),3))
temp=replace(temp,"y",DatePart("y",strDate))
temp=replace(temp,"w",DatePart("w",strDate))
temp=replace(temp,"ww",DatePart("ww",strDate))
temp=replace(temp,"q",DatePart("q",strDate))
temp=replace(temp,"mm",iif(len(DatePart("m",strDate))>1,DatePart("m",strDate),"0"&DatePart("m",strDate)))
temp=replace(temp,"dd",iif(len(DatePart("d",strDate))>1,DatePart("d",strDate),"0"&DatePart("d",strDate)))
temp=replace(temp,"hh",iif(len(DatePart("h",strDate))>1,DatePart("h",strDate),"0"&DatePart("h",strDate)))
temp=replace(temp,"nn",iif(len(DatePart("n",strDate))>1,DatePart("n",strDate),"0"&DatePart("n",strDate)))
temp=replace(temp,"ss",iif(len(DatePart("s",strDate))>1,DatePart("s",strDate),"0"&DatePart("s",strDate)))
DateFormat=temp
else
DateFormat=false
end if
end function
Function moveFile(oldfile,newfile)
dim fs
Set fs=Server.CreateObject("Scri"&"pting.File"&"Sys"&"temObject")
fs.movefile Server.MapPath(oldfile),Server.MapPath(newfile)
Set fs=Nothing
End Function
'----------------------------------------------------------------------
'文件上傳類
Class UpFile_Class
Dim Form,File
Dim AllowExt_
Dim NoAllowExt_
Dim IsDebug_
Private oUpFileStream
Private isErr_
Private ErrMessage_
Private isGetData_
'------------------------------------------------------------------
'類的屬性
Public Property Get Version
Version="無懼上傳類 Version V2.0"
End Property
Public Property Get isErr
isErr=isErr_
End Property
Public Property Get ErrMessage
ErrMessage=ErrMessage_
End Property
Public Property Get AllowExt
AllowExt=AllowExt_
End Property
Public Property Let AllowExt(Value)
AllowExt_=LCase(Value)
End Property
Public Property Get NoAllowExt
NoAllowExt=NoAllowExt_
End Property
Public Property Let NoAllowExt(Value)
NoAllowExt_=LCase(Value)
End Property
Public Property Let IsDebug(Value)
IsDebug_=Value
End Property
'----------------------------------------------------------------
'類實現代碼
'初始化類
Private Sub Class_Initialize
isErr_ = 0
NoAllowExt="asp;asa;cer;aspx;php;"
NoAllowExt=LCase(NoAllowExt)
AllowExt=""
AllowExt=LCase(AllowExt)
isGetData_=false
End Sub
'類結束
Private Sub Class_Terminate
on error Resume Next
'清除變量及對像
Form.RemoveAll
Set Form = Nothing
File.RemoveAll
Set File = Nothing
oUpFileStream.Close
Set oUpFileStream = Nothing
if Err.number<>0 then OutErr("清除類時發生錯誤!")
End Sub
'分析上傳的數據
Public Sub GetData (MaxSize)
'定義變量
on error Resume Next
if isGetData_=false then
Dim RequestBinDate,sSpace,bCrLf,sInfo,iInfoStart,iInfoEnd,tStream,iStart,oFileInfo
Dim sFormValue,sFileName
Dim iFindStart,iFindEnd
Dim iFormStart,iFormEnd,sFormName
'代碼開始
If Request.TotalBytes < 1 Then '如果沒有數據上傳
isErr_ = 1
ErrMessage_="沒有數據上傳,這是因爲直接提交網址所產生的錯誤!"
OutErr("沒有數據上傳,這是因爲直接提交網址所產生的錯誤!!")
Exit Sub
End If
If MaxSize > 0 Then '如果限制大小
If Request.TotalBytes > MaxSize Then
isErr_ = 2 '如果上傳的數據超出限制大小
ErrMessage_="上傳的數據超出限制大小!"
OutErr("上傳的數據超出限制大小!")
Exit Sub
End If
End If
Set Form = Server.CreateObject ("Scripting.Dictionary")
Form.CompareMode = 1
Set File = Server.CreateObject ("Scripting.Dictionary")
File.CompareMode = 1
Set tStream = Server.CreateObject ("ADODB.Stream")
Set oUpFileStream = Server.CreateObject ("ADODB.Stream")
if Err.number<>0 then OutErr("創建流對象(ADODB.STREAM)時出錯,可能系統不支持或沒有開通該組件")
oUpFileStream.Type = 1
oUpFileStream.Mode = 3
oUpFileStream.Open
oUpFileStream.Write Request.BinaryRead (Request.TotalBytes)
oUpFileStream.Position = 0
RequestBinDate = oUpFileStream.Read
iFormEnd = oUpFileStream.Size
bCrLf = ChrB (13) & ChrB (10)
'取得每個項目之間的分隔符
sSpace = MidB (RequestBinDate,1, InStrB (1,RequestBinDate,bCrLf)-1)
iStart = LenB(sSpace)
iFormStart = iStart+2
'分解項目
Do
iInfoEnd = InStrB (iFormStart,RequestBinDate,bCrLf & bCrLf)+3
tStream.Type = 1
tStream.Mode = 3
tStream.Open
oUpFileStream.Position = iFormStart
oUpFileStream.CopyTo tStream,iInfoEnd-iFormStart
tStream.Position = 0
tStream.Type = 2
tStream.CharSet = "gbk"
sInfo = tStream.ReadText
'取得表單項目名稱
iFormStart = InStrB (iInfoEnd,RequestBinDate,sSpace)-1
iFindStart = InStr (22,sInfo,"name=""",1)+6
iFindEnd = InStr (iFindStart,sInfo,"""",1)
sFormName = Mid(sinfo,iFindStart,iFindEnd-iFindStart)
'如果是文件
If InStr (45,sInfo,"filename=""",1) > 0 Then
Set oFileInfo = new FileInfo_Class
'取得文件屬性
iFindStart = InStr (iFindEnd,sInfo,"filename=""",1)+10
iFindEnd = InStr (iFindStart,sInfo,""""&vbCrLf,1)
sFileName = Trim(Mid(sinfo,iFindStart,iFindEnd-iFindStart))
oFileInfo.FileName = GetFileName(sFileName)
oFileInfo.FilePath = GetFilePath(sFileName)
oFileInfo.FileExt = GetFileExt(sFileName)
iFindStart = InStr (iFindEnd,sInfo,"Content-Type: ",1)+14
iFindEnd = InStr (iFindStart,sInfo,vbCr)
oFileInfo.FileMIME = Mid(sinfo,iFindStart,iFindEnd-iFindStart)
oFileInfo.FileStart = iInfoEnd
oFileInfo.FileSize = iFormStart -iInfoEnd -2
oFileInfo.FormName = sFormName
file.add sFormName,oFileInfo
else
'如果是表單項目
tStream.Close
tStream.Type = 1
tStream.Mode = 3
tStream.Open
oUpFileStream.Position = iInfoEnd
oUpFileStream.CopyTo tStream,iFormStart-iInfoEnd-2
tStream.Position = 0
tStream.Type = 2
tStream.CharSet = "gbk"
sFormValue = tStream.ReadText
If Form.Exists (sFormName) Then
Form (sFormName) = Form (sFormName) & ", " & sFormValue
else
Form.Add sFormName,sFormValue
End If
End If
tStream.Close
iFormStart = iFormStart+iStart+2
'如果到文件尾了就退出
Loop Until (iFormStart+2) >= iFormEnd
if Err.number<>0 then OutErr("分解上傳數據時發生錯誤,可能客戶端的上傳數據不正確或不符合上傳數據規則")
RequestBinDate = ""
Set tStream = Nothing
isGetData_=true
end if
End Sub
'保存到文件,自動覆蓋已存在的同名文件
Public Function SaveToFile(Item,Path)
SaveToFile=SaveToFileEx(Item,Path,True)
End Function
'保存到文件,自動設置文件名
Public Function AutoSave(Item,Path)
AutoSave=SaveToFileEx(Item,Path,false)
End Function
'保存到文件,OVER爲真時,自動覆蓋已存在的同名文件,否則自動把文件改名保存
Private Function SaveToFileEx(Item,Path,Over)
On Error Resume Next
Dim FileExt
if file.Exists(Item) then
Dim oFileStream
Dim tmpPath
isErr_=0
Set oFileStream = CreateObject ("ADODB.Stream")
oFileStream.Type = 1
oFileStream.Mode = 3
oFileStream.CharSet = "gbk"
oFileStream.Open
oUpFileStream.Position = File(Item).FileStart
oUpFileStream.CopyTo oFileStream,File(Item).FileSize
tmpPath=Split(Path,".")(0)
FileExt=GetFileExt(Path)
if Over then
if isAllowExt(FileExt) then
oFileStream.SaveToFile tmpPath & "." & FileExt,2
if Err.number<>0 then OutErr("保存文件時出錯,請檢查路徑,是否存在該上傳目錄!該文件保存路徑爲" & tmpPath & "." & FileExt)
Else
isErr_=3
ErrMessage_="該後綴名的文件不允許上傳!"
OutErr("該後綴名的文件不允許上傳")
End if
Else
Path=GetFilePath(Path)
dim fori
fori=1
if isAllowExt(File(Item).FileExt) then
do
fori=fori+1
Err.Clear()
tmpPath=Path&GetNewFileName()&"."&File(Item).FileExt
oFileStream.SaveToFile tmpPath
loop Until ((Err.number=0) or (fori>50))
if Err.number<>0 then OutErr("自動保存文件出錯,已經測試50次不同的文件名來保存,請檢查目錄是否存在!該文件最後一次保存時全路徑爲"&Path&GetNewFileName()&"."&File(Item).FileExt)
Else
isErr_=3
ErrMessage_="該後綴名的文件不允許上傳!"
OutErr("該後綴名的文件不允許上傳")
End if
End if
oFileStream.Close
Set oFileStream = Nothing
else
ErrMessage_="不存在該對象(如該文件沒有上傳,文件爲空)!"
OutErr("不存在該對象(如該文件沒有上傳,文件爲空)")
end if
if isErr_=3 then SaveToFileEx="" else SaveToFileEx=GetFileName(tmpPath)
End Function
'取得文件數據
Public Function FileData(Item)
isErr_=0
if file.Exists(Item) then
if isAllowExt(File(Item).FileExt) then
oUpFileStream.Position = File(Item).FileStart
FileData = oUpFileStream.Read (File(Item).FileSize)
Else
isErr_=3
ErrMessage_="該後綴名的文件不允許上傳"
OutErr("該後綴名的文件不允許上傳")
FileData=""
End if
else
ErrMessage_="不存在該對象(如該文件沒有上傳,文件爲空)!"
OutErr("不存在該對象(如該文件沒有上傳,文件爲空)")
end if
End Function
'取得文件路徑
Public function GetFilePath(FullPath)
If FullPath <> "" Then
GetFilePath = Left(FullPath,InStrRev(FullPath, "\"))
Else
GetFilePath = ""
End If
End function
'取得文件名
Public Function GetFileName(FullPath)
If FullPath <> "" Then
GetFileName = mid(FullPath,InStrRev(FullPath, "\")+1)
Else
GetFileName = ""
End If
End function
'取得文件的後綴名
Public Function GetFileExt(FullPath)
If FullPath <> "" Then
GetFileExt = LCase(Mid(FullPath,InStrRev(FullPath, ".")+1))
Else
GetFileExt = ""
End If
End function
'取得一個不重複的序號
Public Function GetNewFileName()
dim ranNum
dim dtNow
dtNow=Now()
randomize
ranNum=int(90000*rnd)+10000
'以下這段由webboy提供
GetNewFileName=year(dtNow) & right("0" & month(dtNow),2) & right("0" & day(dtNow),2) & right("0" & hour(dtNow),2) & right("0" & minute(dtNow),2) & right("0" & second(dtNow),2) & ranNum
End Function
Public Function isAllowExt(Ext)
If NoAllowExt = "" Then
isAllowExt=cbool(InStr(1,";"&AllowExt&";",LCase(";"&Ext&";")))
Else
Dim ar, a
ar = Split(NoAllowExt, ";")
For Each a In ar
If a <> "" Then
If InStr(LCase(Ext), LCase(a)) > 0 Then
isAllowExt = False
Exit Function
End If
End If
Next
isAllowExt = True
End If
End Function
End Class
Public Sub OutErr(ErrMsg)
if IsDebug_=true then
Response.Write ErrMsg
Response.End
End if
End Sub
'----------------------------------------------------------------------------------------------------
'文件屬性類
Class FileInfo_Class
Dim FormName,FileName,FilePath,FileSize,FileMIME,FileStart,FileExt
End Class
%>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gbk" />
<title>文件上傳</title>
<style type="text/css">
td,div,input,select,textarea,body {font-family:Verdana, 宋體, fantasy;font-size:12px;}
body {margin:0 3px;padding:0;background-color:transparent;}
form {margin:0;padding:0;}
</style>
<LINK href="../images/style.css" type=text/css rel=stylesheet>
</head>
<body>
<%
CheckLogin()
dim action,sortType,saveFilePath,stype
action = getForm("action", "get")
stype = getForm("stype","get")
sortType = getForm("sortType","get")
Dim Tobj : Tobj =getForm("Tobj", "get")
if action="save" then
response.write uploadfile()
else
%>
<form name="form" enctype="multipart/form-data" action="?action=save&sortType=<%=sortType%>&stype=<%=stype%>&Tobj=<%=Tobj%>" method="post">
<input type="file" style=" width:260px;" class="input" name="filedata"/>
<input type="submit"class="button" name="submit" value="上傳" >
</form>
<%
end if
%>
</body>
</html>
<%
function uploadfile()
dim immediate,attachdir,dirtype,maxattachsize,upext,saveFilePath,fType,fs
'上傳文件保存路徑，結尾不要帶/
select case sortType
case "2"
attachdir=sitePath&"/"&upLoadPath &"/news"
case "3"
attachdir=sitePath&"/"&upLoadPath &"/product"
case "4"
attachdir=sitePath&"/"&upLoadPath &"/down"
case "5"
attachdir=sitePath&"/"&upLoadPath &"/job"
case "6"
attachdir=sitePath&"/"&upLoadPath &"/album"
case "10"
attachdir=sitePath&"/"&upLoadPath &"/sort"
case "11"
attachdir=sitePath&"/"&upLoadPath &"/links"
case "12"
attachdir=sitePath&"/"&upLoadPath &"/slide"
case "13"
attachdir=sitePath&"/"&upLoadPath &"/Logo"
case "14"
attachdir=sitePath&"/"&upLoadPath &"/ad"
case else
attachdir=sitePath&"/"&upLoadPath &"/other"
end select
'die attachdir
'createFolder attachdir,"folderdir"
Set fs=Server.CreateObject("Scri"&"pting.File"&"Sys"&"temObject")
'判斷文件夾是否存在,如果不存在則創建文件夾
If not fs.FolderExists(Server.MapPath(attachdir)) then
fs.CreateFolder Server.MapPath(attachdir)
End if
set fs =nothing
saveFilePath = sitePath&"/"&upLoadPath & saveFilePath
'attachdir=sitePath+"/upload"'上傳文件保存路徑，結尾不要帶/
dirtype=2'1:按天存入目錄 2:按月存入目錄 3:按擴展名存目錄 建議使用按天存
maxattachsize=20971520'最大上傳大小，默認是2M
upext="txt,rar,zip,jpg,jpeg,gif,png,swf,wmv,avi,wma,mp3,mid"'上傳擴展名
server.ScriptTimeout=600
dim err,msg,upfile
err = ""
msg = ""
set upfile=new upfile_class
upfile.AllowExt=replace(upext,",",";")+";"
upfile.GetData(maxattachsize)
if upfile.isErr then
select case upfile.isErr
case 1
err="無數據提交"
case 2
err="文件大小超過 "+cstr(maxattachsize)+"字節"
case else
err="就是這裏出錯了:"
end select
alertMsgAndGo err,"-1"
else
dim attach_dir,attach_subdir,filename,extension,target,tmpfile,formName,oFile,fsize
for each formName in upfile.file '列出所有上傳了的文件
set oFile=upfile.file(formname)
if oFile.FileExt="" then alertMsgAndGo "無數據提交","-1"
extension=oFile.FileExt
fType=extension
select case dirtype
case 1
attach_subdir="day_"+DateFormat(now,"yymmdd")
case 2
attach_subdir="month_"+DateFormat(now,"yymm")
case 3
attach_subdir="ext_"+extension
end select
attach_dir=attachdir+"/"+attach_subdir+"/"
'建文件夾
CreateFolder attach_dir,"folderdir"
tmpfile=upfile.AutoSave(formName,Server.mappath(attach_dir)+"\")
if upfile.isErr then
if upfile.isErr=3 then
err="上傳文件擴展名必需爲："+upext
else
err=upfile.ErrMessage
end if
alertMsgAndGo err,"-1"
else
'生成隨機文件名並改名
Randomize timer
filename=DateFormat(now,"yyyymmddhhnnss")+cstr(cint(9999*Rnd))+"."+extension
target=attach_dir+filename
Set fs=Server.CreateObject("Scri"&"pting.File"&"Sys"&"temObject")
'判斷文件夾是否存在,如果不存在則創建文件夾
If not fs.FolderExists(Server.MapPath(attach_dir)) then
fs.CreateFolder Server.MapPath(attach_dir)
End if
set fs =nothing
moveFile attach_dir+tmpfile,target
if waterMark=1 then waterMarkImg target,waterMarkLocation
msg=target
if immediate="1" then msg="!"+msg
end if
fsize=oFile.filesize
set oFile=nothing
%>
<input type="text" name="file1" size="70" style="width:300px;" class="input" value="<%=target%>"> <input type="button" onClick="javascript:history.go(-1)" value="繼續上傳" class="button"><br>
<font color="blue">恭喜你！文件上傳成功。<a href="<%=Request.ServerVariables("HTTP_REFERER")%>">點擊此處繼續上傳</a></font>
<%
if stype="image" or stype="sort" then
dim inEditorStr
Select Case fType
Case "gif","jpg","png","bmp","jpeg","tif","iff"
if stype="sort" then inEditorStr="oEditor.InsertHtml(""<img src=""+""'""+ContentStr+""'""+""/>"");" & vbCrLf
'inEditorStr="oEditor.InsertHtml(""<img src=""+""'""+ContentStr+""'""+""/>"");" & vbCrLf
%>
<script type="text/javascript">
//parent.parent.FCKeditorAPI.GetInstance('content')
// 設置編輯器中內容
/*function SetEditorContents(EditorName, ContentStr) {
var oEditor = parent.FCKeditorAPI.GetInstance(EditorName) ;
oEditor.Focus();
//setTimeout(function() { oEditor.Focus(); }, 100);
//oEditor.InsertHtml("<img src="+"'"+ContentStr+"'"+"/>");
<%=inEditorStr%>
}
SetEditorContents('Content','<%=target%>')*/
// 文件上傳成功接口操作
function doInterfaceUpload(strValue){
if (strValue=="") return;
var objLinkUpload = parent.document.getElementsByName("ImagePath")[0];
if (objLinkUpload){
if (objLinkUpload.value!=""){
objLinkUpload.value = objLinkUpload.value + "|";
}
objLinkUpload.value = objLinkUpload.value + strValue;
// objLinkUpload.fireEvent("onchange");
}
}
doInterfaceUpload('<%=target%>');
doChange(parent.document.getElementById("ImagePath"),parent.document.getElementById("ImageFileList"))
function doChange(objText, objDrop){
if (!objDrop) return;
var str = objText.value;
var arr = str.split("|");
var nIndex = objDrop.selectedIndex;
objDrop.length=1;
for (var i=0; i<arr.length; i++){
objDrop.options[objDrop.length] = new Option(arr[i], arr[i]);
}
objDrop.selectedIndex = nIndex;
}
</script>
<script type="text/javascript">
function divMsg(t){
//alert(parent.document.getElementById("pw").innerHTML);
var pstr=parent.document.getElementById("pw").innerHTML;
var imgvalue=parent.document.getElementById("ImagePath").value;
if(t.indexOf("err:")==-1)
{
var ids=t
ids=ids.substr(ids.lastIndexOf("/")+1,ids.lastIndexOf("."))
ids=ids.replace(".","")
var itml = pstr + '<div class="imgDiv" id="'+ids+'"><a href="javascript:SetEditorContents(\'Content\',\'<%=target%>\')" ><img src="'+ t + '" border="0" /></a><br><input type="radio" name="IndexImageradio" οnclick="setIndexImage(\''+t+'\')" value="'+t+'" />設爲縮略圖 <a href="javascript:dropThisDiv(\''+ids+'\',\''+t+'\')">刪除</a></div> ';
imgvalue=imgvalue+t+'|';
}
else
{
var itml = pstr + '<div class="imgDiv" id="'+t+'">"'+t+'"<br/>圖片上傳失敗</div> ';
}
//document.getElementById("ImagePath").value=imgvalue;
parent.document.getElementById("pw").innerHTML=itml;
}
divMsg('<%=target%>')
</script>
<%
Case "swf"
inEditorStr="oEditor.InsertHtml('<object codebase=""http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=7,0,0,0"" classid=""clsid:D27CDB6E-AE6D-11cf-96B8-444553540000"" width=""400"" height=""300""><param name=""movie"" value=""" & target & """ /><param name=""quality"" value=""high"" /><param name=""AllowScriptAccess"" value=""never"" /><embed src=""" & target & """ quality=""high"" pluginspage=""http://www.macromedia.com/go/getflashplayer"" type=""application/x-shockwave-flash"" width=""400"" height=""300"" /></object>')" & vbCrLf
Case "mp3","wma"
inEditorStr="oEditor.InsertHtml('<object classid=""CLSID:22d6f312-b0f6-11d0-94ab-0080c74c7e95"" id=""MediaPlayer"" width=""450"" height=""70""><param name=""howStatusBar"" value=""-1""><param name=""AutoStart"" value=""False""><param name=""Filename"" value=""" & target & """></object>')" & vbCrLf
Case "rm","rmvb"
inEditorStr="oEditor.InsertHtml('<object classid=""clsid:CFCDAA03-8BE4-11cf-B84B-0020AFBBCCFA"" width=""400"" height=""300""><param name=""SRC"" value=""" & target & """ /><param name=""CONTROLS"" VALUE=""ImageWindow"" />"& vbCrLf&_
"<param name=""CONSOLE"" value=""one"" /><param name=""AUTOSTART"" value=""true"" /><embed src=""" & target & """ nojava=""true"" controls=""ImageWindow"" console=""one"" width=""400"" height=""300""></object><br/>"& vbCrLf&_
"<object classid=""clsid:CFCDAA03-8BE4-11cf-B84B-0020AFBBCCFA"" width=""400"" height=""32"" /><param name=""CONTROLS"" value=""StatusBar"" /><param name=""AUTOSTART"" value=""true"" /><param name=""CONSOLE"" value=""one"" />"& vbCrLf&_
"<embed src=""" & target & """ nojava=""true"" controls=""StatusBar"" console=""one"" width=""400"" height=""24"" /></object><br/><object classid=""clsid:CFCDAA03-8BE4-11cf-B84B-0020AFBBCCFA"" width=""400"" height=""32"" />"& vbCrLf&_
"<param name=""CONTROLS"" value=""ControlPanel"" /><param name=""AUTOSTART"" value=""true"" /><param name=""CONSOLE"" value=""one"" /><embed src=""" & target & """ nojava=""true"" controls=""ControlPanel"" console=""one"" width=""400"" height=""24"" autostart=""true"" loop=""false"" /></object>')}" & vbCrLf
Case "ra"
inEditorStr="oEditor.InsertHtml('<object classid=""clsid:CFCDAA03-8BE4-11CF-B84B-0020AFBBCCFA"" id=""RAOCX"" width=""450"" height=""60""><param name=""_ExtentX"" value=""6694""><param name=""_ExtentY"" value=""1588""><param name=""AUTOSTART"" value=""true""><param name=""SHUFFLE"" value=""0""><param name=""PREFETCH"" value=""0"">"& vbCrLf&_
"<param name=""NOLABELS"" value=""0""><param name=""SRC"" value=""" & target & """><param name=""CONTROLS"" value=""StatusBar,ControlPanel""><param name=""LOOP"" value=""0""><param name=""NUMLOOP"" value=""0""><param name=""CENTER"" value=""0""><param name=""MAINTAINASPECT"" value=""0""><param name=""BACKGROUNDCOLOR"" value=""#000000""><embed src=""" & target & """ width=""450"" autostart=""true"" height=""60""></embed></object>')" & vbCrLf
Case "asf","avi","wmv"
inEditorStr="oEditor.InsertHtml('<object classid=""clsid:22D6F312-B0F6-11D0-94AB-0080C74C7E95"" codebase=""http://activex.microsoft.com/activex/controls/mplayer/en/nsmp2inf.cab#Version=6,0,02,902"" type=""application/x-oleobject"" standby=""Loading..."" width=""400"" height=""300"">"& vbCrLf&_
"<param name=""FileName"" VALUE=""" & target & """ /><param name=""ShowStatusBar"" value=""-1"" /><param name=""AutoStart"" value=""true"" /><embed type=""application/x-mplayer2"" pluginspage=""http://www.microsoft.com/Windows/MediaPlayer/"" src=""" & target & """ autostart=""true"" width=""400"" height=""300"" /></object>')" & vbCrLf
Case Else
inEditorStr="oEditor.InsertHtml('<a href=""" & target & """>點擊下載此文件</a>')" & vbCrLf
End Select
%>
<script type="text/javascript">
//parent.parent.FCKeditorAPI.GetInstance('content')
// 設置編輯器中內容
function SetEditorContents(EditorName, ContentStr) {
var oEditor = parent.FCKeditorAPI.GetInstance(EditorName) ;
oEditor.Focus();
//setTimeout(function() { oEditor.Focus(); }, 100);
//oEditor.InsertHtml("<img src="+"'"+ContentStr+"'"+"/>");
<%=inEditorStr%>
}
SetEditorContents('Content','<%=target%>')
</script>
<%
elseif stype="file" then
echo "<script language=""javascript"">parent.document.getElementById("""&Tobj&""").value='"&target&"'</script>"
'echo "<table><tr><td bgcolor=#FFFFFF style=""font-size:12px;""><font color=red>"&filename&"上傳成功![ <span οnclick=history.go(-1)>重新上傳</span> ]</font></td></tr></table>"
end if
next
end if
set upfile=nothing
end function
function jsonString(str)
str=replace(str,"\","\\")
str=replace(str,"/","\/")
str=replace(str,"'","\'")
jsonString=str
end function
Function Iif(expression,returntrue,returnfalse)
If expression=true Then
iif=returntrue
Else
iif=returnfalse
End If
End Function
function DateFormat(strDate,fstr)
if isdate(strDate) then
dim i,temp
temp=replace(fstr,"yyyy",DatePart("yyyy",strDate))
temp=replace(temp,"yy",mid(DatePart("yyyy",strDate),3))
temp=replace(temp,"y",DatePart("y",strDate))
temp=replace(temp,"w",DatePart("w",strDate))
temp=replace(temp,"ww",DatePart("ww",strDate))
temp=replace(temp,"q",DatePart("q",strDate))
temp=replace(temp,"mm",iif(len(DatePart("m",strDate))>1,DatePart("m",strDate),"0"&DatePart("m",strDate)))
temp=replace(temp,"dd",iif(len(DatePart("d",strDate))>1,DatePart("d",strDate),"0"&DatePart("d",strDate)))
temp=replace(temp,"hh",iif(len(DatePart("h",strDate))>1,DatePart("h",strDate),"0"&DatePart("h",strDate)))
temp=replace(temp,"nn",iif(len(DatePart("n",strDate))>1,DatePart("n",strDate),"0"&DatePart("n",strDate)))
temp=replace(temp,"ss",iif(len(DatePart("s",strDate))>1,DatePart("s",strDate),"0"&DatePart("s",strDate)))
DateFormat=temp
else
DateFormat=false
end if
end function
Function moveFile(oldfile,newfile)
dim fs
Set fs=Server.CreateObject("Scri"&"pting.File"&"Sys"&"temObject")
fs.movefile Server.MapPath(oldfile),Server.MapPath(newfile)
Set fs=Nothing
End Function
'----------------------------------------------------------------------
'文件上傳類
Class UpFile_Class
Dim Form,File
Dim AllowExt_
Dim NoAllowExt_
Dim IsDebug_
Private oUpFileStream
Private isErr_
Private ErrMessage_
Private isGetData_
'------------------------------------------------------------------
'類的屬性
Public Property Get Version
Version="無懼上傳類 Version V2.0"
End Property
Public Property Get isErr
isErr=isErr_
End Property
Public Property Get ErrMessage
ErrMessage=ErrMessage_
End Property
Public Property Get AllowExt
AllowExt=AllowExt_
End Property
Public Property Let AllowExt(Value)
AllowExt_=LCase(Value)
End Property
Public Property Get NoAllowExt
NoAllowExt=NoAllowExt_
End Property
Public Property Let NoAllowExt(Value)
NoAllowExt_=LCase(Value)
End Property
Public Property Let IsDebug(Value)
IsDebug_=Value
End Property
'----------------------------------------------------------------
'類實現代碼
'初始化類
Private Sub Class_Initialize
isErr_ = 0
NoAllowExt="asp;asa;cer;aspx;php;"
NoAllowExt=LCase(NoAllowExt)
AllowExt=""
AllowExt=LCase(AllowExt)
isGetData_=false
End Sub
'類結束
Private Sub Class_Terminate
on error Resume Next
'清除變量及對像
Form.RemoveAll
Set Form = Nothing
File.RemoveAll
Set File = Nothing
oUpFileStream.Close
Set oUpFileStream = Nothing
if Err.number<>0 then OutErr("清除類時發生錯誤!")
End Sub
'分析上傳的數據
Public Sub GetData (MaxSize)
'定義變量
on error Resume Next
if isGetData_=false then
Dim RequestBinDate,sSpace,bCrLf,sInfo,iInfoStart,iInfoEnd,tStream,iStart,oFileInfo
Dim sFormValue,sFileName
Dim iFindStart,iFindEnd
Dim iFormStart,iFormEnd,sFormName
'代碼開始
If Request.TotalBytes < 1 Then '如果沒有數據上傳
isErr_ = 1
ErrMessage_="沒有數據上傳,這是因爲直接提交網址所產生的錯誤!"
OutErr("沒有數據上傳,這是因爲直接提交網址所產生的錯誤!!")
Exit Sub
End If
If MaxSize > 0 Then '如果限制大小
If Request.TotalBytes > MaxSize Then
isErr_ = 2 '如果上傳的數據超出限制大小
ErrMessage_="上傳的數據超出限制大小!"
OutErr("上傳的數據超出限制大小!")
Exit Sub
End If
End If
Set Form = Server.CreateObject ("Scripting.Dictionary")
Form.CompareMode = 1
Set File = Server.CreateObject ("Scripting.Dictionary")
File.CompareMode = 1
Set tStream = Server.CreateObject ("ADODB.Stream")
Set oUpFileStream = Server.CreateObject ("ADODB.Stream")
if Err.number<>0 then OutErr("創建流對象(ADODB.STREAM)時出錯,可能系統不支持或沒有開通該組件")
oUpFileStream.Type = 1
oUpFileStream.Mode = 3
oUpFileStream.Open
oUpFileStream.Write Request.BinaryRead (Request.TotalBytes)
oUpFileStream.Position = 0
RequestBinDate = oUpFileStream.Read
iFormEnd = oUpFileStream.Size
bCrLf = ChrB (13) & ChrB (10)
'取得每個項目之間的分隔符
sSpace = MidB (RequestBinDate,1, InStrB (1,RequestBinDate,bCrLf)-1)
iStart = LenB(sSpace)
iFormStart = iStart+2
'分解項目
Do
iInfoEnd = InStrB (iFormStart,RequestBinDate,bCrLf & bCrLf)+3
tStream.Type = 1
tStream.Mode = 3
tStream.Open
oUpFileStream.Position = iFormStart
oUpFileStream.CopyTo tStream,iInfoEnd-iFormStart
tStream.Position = 0
tStream.Type = 2
tStream.CharSet = "gbk"
sInfo = tStream.ReadText
'取得表單項目名稱
iFormStart = InStrB (iInfoEnd,RequestBinDate,sSpace)-1
iFindStart = InStr (22,sInfo,"name=""",1)+6
iFindEnd = InStr (iFindStart,sInfo,"""",1)
sFormName = Mid(sinfo,iFindStart,iFindEnd-iFindStart)
'如果是文件
If InStr (45,sInfo,"filename=""",1) > 0 Then
Set oFileInfo = new FileInfo_Class
'取得文件屬性
iFindStart = InStr (iFindEnd,sInfo,"filename=""",1)+10
iFindEnd = InStr (iFindStart,sInfo,""""&vbCrLf,1)
sFileName = Trim(Mid(sinfo,iFindStart,iFindEnd-iFindStart))
oFileInfo.FileName = GetFileName(sFileName)
oFileInfo.FilePath = GetFilePath(sFileName)
oFileInfo.FileExt = GetFileExt(sFileName)
iFindStart = InStr (iFindEnd,sInfo,"Content-Type: ",1)+14
iFindEnd = InStr (iFindStart,sInfo,vbCr)
oFileInfo.FileMIME = Mid(sinfo,iFindStart,iFindEnd-iFindStart)
oFileInfo.FileStart = iInfoEnd
oFileInfo.FileSize = iFormStart -iInfoEnd -2
oFileInfo.FormName = sFormName
file.add sFormName,oFileInfo
else
'如果是表單項目
tStream.Close
tStream.Type = 1
tStream.Mode = 3
tStream.Open
oUpFileStream.Position = iInfoEnd
oUpFileStream.CopyTo tStream,iFormStart-iInfoEnd-2
tStream.Position = 0
tStream.Type = 2
tStream.CharSet = "gbk"
sFormValue = tStream.ReadText
If Form.Exists (sFormName) Then
Form (sFormName) = Form (sFormName) & ", " & sFormValue
else
Form.Add sFormName,sFormValue
End If
End If
tStream.Close
iFormStart = iFormStart+iStart+2
'如果到文件尾了就退出
Loop Until (iFormStart+2) >= iFormEnd
if Err.number<>0 then OutErr("分解上傳數據時發生錯誤,可能客戶端的上傳數據不正確或不符合上傳數據規則")
RequestBinDate = ""
Set tStream = Nothing
isGetData_=true
end if
End Sub
'保存到文件,自動覆蓋已存在的同名文件
Public Function SaveToFile(Item,Path)
SaveToFile=SaveToFileEx(Item,Path,True)
End Function
'保存到文件,自動設置文件名
Public Function AutoSave(Item,Path)
AutoSave=SaveToFileEx(Item,Path,false)
End Function
'保存到文件,OVER爲真時,自動覆蓋已存在的同名文件,否則自動把文件改名保存
Private Function SaveToFileEx(Item,Path,Over)
On Error Resume Next
Dim FileExt
if file.Exists(Item) then
Dim oFileStream
Dim tmpPath
isErr_=0
Set oFileStream = CreateObject ("ADODB.Stream")
oFileStream.Type = 1
oFileStream.Mode = 3
oFileStream.CharSet = "gbk"
oFileStream.Open
oUpFileStream.Position = File(Item).FileStart
oUpFileStream.CopyTo oFileStream,File(Item).FileSize
tmpPath=Split(Path,".")(0)
FileExt=GetFileExt(Path)
if Over then
if isAllowExt(FileExt) then
oFileStream.SaveToFile tmpPath & "." & FileExt,2
if Err.number<>0 then OutErr("保存文件時出錯,請檢查路徑,是否存在該上傳目錄!該文件保存路徑爲" & tmpPath & "." & FileExt)
Else
isErr_=3
ErrMessage_="該後綴名的文件不允許上傳!"
OutErr("該後綴名的文件不允許上傳")
End if
Else
Path=GetFilePath(Path)
dim fori
fori=1
if isAllowExt(File(Item).FileExt) then
do
fori=fori+1
Err.Clear()
tmpPath=Path&GetNewFileName()&"."&File(Item).FileExt
oFileStream.SaveToFile tmpPath
loop Until ((Err.number=0) or (fori>50))
if Err.number<>0 then OutErr("自動保存文件出錯,已經測試50次不同的文件名來保存,請檢查目錄是否存在!該文件最後一次保存時全路徑爲"&Path&GetNewFileName()&"."&File(Item).FileExt)
Else
isErr_=3
ErrMessage_="該後綴名的文件不允許上傳!"
OutErr("該後綴名的文件不允許上傳")
End if
End if
oFileStream.Close
Set oFileStream = Nothing
else
ErrMessage_="不存在該對象(如該文件沒有上傳,文件爲空)!"
OutErr("不存在該對象(如該文件沒有上傳,文件爲空)")
end if
if isErr_=3 then SaveToFileEx="" else SaveToFileEx=GetFileName(tmpPath)
End Function
'取得文件數據
Public Function FileData(Item)
isErr_=0
if file.Exists(Item) then
if isAllowExt(File(Item).FileExt) then
oUpFileStream.Position = File(Item).FileStart
FileData = oUpFileStream.Read (File(Item).FileSize)
Else
isErr_=3
ErrMessage_="該後綴名的文件不允許上傳"
OutErr("該後綴名的文件不允許上傳")
FileData=""
End if
else
ErrMessage_="不存在該對象(如該文件沒有上傳,文件爲空)!"
OutErr("不存在該對象(如該文件沒有上傳,文件爲空)")
end if
End Function
'取得文件路徑
Public function GetFilePath(FullPath)
If FullPath <> "" Then
GetFilePath = Left(FullPath,InStrRev(FullPath, "\"))
Else
GetFilePath = ""
End If
End function
'取得文件名
Public Function GetFileName(FullPath)
If FullPath <> "" Then
GetFileName = mid(FullPath,InStrRev(FullPath, "\")+1)
Else
GetFileName = ""
End If
End function
'取得文件的後綴名
Public Function GetFileExt(FullPath)
If FullPath <> "" Then
GetFileExt = LCase(Mid(FullPath,InStrRev(FullPath, ".")+1))
Else
GetFileExt = ""
End If
End function
'取得一個不重複的序號
Public Function GetNewFileName()
dim ranNum
dim dtNow
dtNow=Now()
randomize
ranNum=int(90000*rnd)+10000
'以下這段由webboy提供
GetNewFileName=year(dtNow) & right("0" & month(dtNow),2) & right("0" & day(dtNow),2) & right("0" & hour(dtNow),2) & right("0" & minute(dtNow),2) & right("0" & second(dtNow),2) & ranNum
End Function
Public Function isAllowExt(Ext)
If NoAllowExt = "" Then
isAllowExt=cbool(InStr(1,";"&AllowExt&";",LCase(";"&Ext&";")))
Else
Dim ar, a
ar = Split(NoAllowExt, ";")
For Each a In ar
If a <> "" Then
If InStr(LCase(Ext), LCase(a)) > 0 Then
isAllowExt = False
Exit Function
End If
End If
Next
isAllowExt = True
End If
End Function
End Class
Public Sub OutErr(ErrMsg)
if IsDebug_=true then
Response.Write ErrMsg
Response.End
End if
End Sub
'----------------------------------------------------------------------------------------------------
'文件屬性類
Class FileInfo_Class
Dim FormName,FileName,FilePath,FileSize,FileMIME,FileStart,FileExt
End Class
%>
