aspでファイルの閲覧、アップロード、ダウンロードを実現するプログラム
17622 ワード
サーバー上に置いて、サーバー上のファイルを閲覧、アップロード、ダウンロードすることができ、ファイルのソースコードをダウンロードすることができます.
下のすべてのコードを1つのファイルに入れると、ファイルの接尾辞はaspになります.
下のすべてのコードを1つのファイルに入れると、ファイルの接尾辞はaspになります.
thedir = request("thedir")
if thedir = "" then
folderini = server.mappath(".")&"\"
else
folderini = server.mappath(thedir)&"\"
end if
foldinfo=trim(Request.Querystring("foldinfo"))
if foldinfo = "" then
foldinfo = folderini
end if
class clsUp
Dim Form,File
Dim AllowExt_
Dim NoAllowExt_
Private oUpFileStream
Private isErr_
Private ErrMessage_
Private isGetData_
Public Property Get Version
Version="v1.0.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
Private Sub Class_Initialize
isErr_ = 0
NoAllowExt=""
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
End Sub
Public Sub GetData (MaxSize)
on error Resume Next
if isGetData_=false then
Dim getupdata1,sSpace,bCrLf,sInfo,iInfoStart,iInfoEnd,tStream,iStart,oFileInfo
Dim sFormValue,sFileName
Dim iFindStart,iFindEnd
Dim iFormStart,iFormEnd,sFormName
If Request.TotalBytes isErr_ = 1
ErrMessage_=""
Exit Sub
End If
If MaxSize > 0 Then
If Request.TotalBytes > MaxSize Then
isErr_ = 2
ErrMessage_=""
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")
oUpFileStream.Type = 1
oUpFileStream.Mode = 3
oUpFileStream.Open
oUpFileStream.Write Request.BinaryRead (Request.TotalBytes)
oUpFileStream.Position = 0
getupdata1 = oUpFileStream.Read
iFormEnd = oUpFileStream.Size
bCrLf = ChrB (13) & ChrB (10)
sSpace = MidB (getupdata1,1, InStrB (1,getupdata1,bCrLf)-1)
iStart = LenB(sSpace)
iFormStart = iStart+2
Do
iInfoEnd = InStrB (iFormStart,getupdata1,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 = "gb2312"
sInfo = tStream.ReadText
iFormStart = InStrB (iInfoEnd,getupdata1,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 clsFileInfo
iFindStart = InStr (iFindEnd,sInfo,"filename=""",1)+10
iFindEnd = InStr (iFindStart,sInfo,""""&vbCrLf,1)
sFileName = 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 = "gb2312"
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
getupdata1 = ""
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
Private Function SaveToFileEx(Item,Path,Over)
On Error Resume Next
Dim oFileStream
Dim tmpPath
Dim nohack
isErr=0
Set oFileStream = CreateObject ("ADODB.Stream")
oFileStream.Type = 1
oFileStream.Mode = 3
oFileStream.Open
oUpFileStream.Position = File(Item).FileStart
oUpFileStream.CopyTo oFileStream,File(Item).FileSize
nohack=split(path,".")
tmpPath=nohack(0)&"."&nohack(ubound(nohack))
if Over then
if isAllowExt(GetFileExt(tmpPath)) then
oFileStream.SaveToFile tmpPath,2
Else
isErr_=3
ErrMessage_="!"
End if
Else
Path=GetFilePath(Path)
if isAllowExt(File(Item).FileExt) then
do
Err.Clear()
nohack=split(Path&GetNewFileName()&"."&File(Item).FileExt,".")
tmpPath=nohack(0)&"."&nohack(ubound(nohack))
oFileStream.SaveToFile tmpPath
loop Until Err.number<1
oFileStream.SaveToFile Path
Else
isErr_=3
ErrMessage_=" !"
End if
End if
oFileStream.Close
Set oFileStream = Nothing
if isErr_=3 then SaveToFileEx="" else SaveToFileEx=GetFileName(tmpPath)
End Function
'
Public Function FileData(Item)
isErr_=0
if isAllowExt(File(Item).FileExt) then
oUpFileStream.Position = File(Item).FileStart
FileData = oUpFileStream.Read (File(Item).FileSize)
Else
isErr_=3
ErrMessage_=""
FileData=""
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()
ranNum=int(90000*rnd)+10000
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
isAllowExt=not CBool(InStr(1,";"&NoAllowExt&";",LCase(";"&Ext&";")))
end if
End Function
End Class
Class clsFileInfo
Dim FormName,FileName,FilePath,FileSize,FileMIME,FileStart,FileExt
End Class
%>
function deletefile(filename)
set objfilesys=server.createobject("scripting.filesystemobject")
ss=filename
ss=foldinfo&ss
if objfilesys.FILEExists(ss) then
objfilesys.deleteFILE ss
end if
end function
function deletedir(dirname)
set objfilesys=server.createobject("scripting.filesystemobject")
ss=dirname&idd
ss=server.mappath(ss)
if objfilesys.FOLDERExists(ss) then
objfilesys.deleteFOLDER ss
end if
end function
function download(filename)
Response.Buffer = true
Response.Clear
dim url
Dim fso,fl,flsize
dim Dname
Dim objStream,ContentType,flName,isre,url1
Dname=filename
If Dname<>"" Then
url=foldinfo&Dname
End If
Set fso=Server.CreateObject("Scripting.FileSystemObject")
Set fl=fso.getfile(url)
flsize=fl.size
flName=fl.name
Set fl=Nothing
Set fso=Nothing
Set objStream=Server.CreateObject("ADODB.Stream")
objStream.Open
objStream.Type=1
objStream.LoadFromFile url
ContentType="text/html"
Response.AddHeader "Content-Disposition","attachment;filename="&flName
Response.AddHeader "Content-Length", flsize
Response.Charset = "UTF-8"
Response.ContentType = ContentType
Response.BinaryWrite objStream.Read
Response.Flush
response.Clear()
objStream.Close
Set objStream = Nothing
end function
function uploadfiles()
filepath=foldinfo
set upload=new clsUp
upload.NoAllowExt="aep"
upload.GetData (3072000)
if upload.form("act")="uploadfile" then
for each formName in upload.File
set file=upload.File(formName)
randomize
filename1=file.FileName
filename=filepath&filename1
if file.FileSize>0 then
upload.SaveToFile formName,FileName
end if
set file=nothing
next
set upload=nothing
end if
end function
action = request("action")
if action = "deletefile" then
filename = request("filename")
deletefile(filename)
end if
if action = "deletedir" then
deletedirname = request("deletedir")
deletedir(deletedirname)
end if
if action = "download" then
filename = request("filename")
download(filename)
end if
if action = "uploadfiles" then
uploadfiles()
end if
%>
:
Folder Size LastTime Operate
upfolder=left(foldinfo,len(foldinfo)-1)
upfolder=left(upfolder,InstrRev(upfolder, "\"))
if foldinfo<>folderini then
response.write("Go Back")
else
response.write("Go Back")
end if%>
File Size LastTime Operate
Sub ShowFolderList(folderspec)
Dim fs, f, f1, fc, s, schild,p,fsize
Set fs = CreateObject("scripting.FileSystemObject")
Set f = fs.GetFolder(folderspec)
Set fc = f.SubFolders
For Each f1 in fc
s = f1.name
's = s & vbCrLf
p = f1.DateLastModified
fsize = f1.Size
schild=folderspec&s&"\"
Response.write("")
Response.write("")
Response.write("")
Response.write("")
Response.write("")
Response.write("")
Response.write("")
Response.write("0"&s&" "&fsize&" "&p&" ")
Response.write("DEL")
Response.write("
")
Next
End Sub
Sub showfolderinfo(folderspc)
set MyFileObject=Server.CreateObject("scripting.FileSystemObject")
Set MyFolder=MyFileObject.GetFolder(folderspc)
for each thing in MyFolder.Files
Set afile=MyFileObject.GetFile(thing)
filenamecode=afile.name
filedetail=folderspc+filenamecode
filedetail=replace(filedetail,"\","*s_p_l_i_t*")
filesize=afile.size
lastmodify=afile.DateLastModified
Response.write("")
Response.write("")
Response.write("")
Response.write("")
Response.write("")
Response.write("")
Response.write("")
Response.write("2"&filenamecode&" "&filesize&" "&lastmodify&" ")
Response.write("DEL ")
Response.write("DL")
Response.write("
")
Next
End sub
%>