<%@ Language=VBScript%>
<%option explicit%>
<%Server.ScriptTimeout = 600%>
<%
Response.Buffer = True
Response.Expires = 0
%>
<%
' SFManager v.1.3
' Author: Khristoforov Yuri
' http://www.activex.net.ru
Dim action, fs
action = Request.QueryString("action")
Set fs = Server.CreateObject("Scripting.FileSystemObject")
Dim curr_dir,curr_dir2, temp_arr
curr_dir2 = Request.QueryString("dir")
if InStr(1, curr_dir2, "..") <> 0 then
Response.Write "Nome della cartella non valido !"
Response.End
end if
Select Case action
Case "delfolder"
Call DelFolder()
Case "delfile"
Call DelFile()
Case "newfolder"
Call NewFolder()
Case "renamefolder"
Call RenameFolder()
Case "renamefile"
Call RenameFile()
Case "download"
Call Download()
Case "viewdownload"
Call ViewDownload()
Case ""
Call Main()
End Select
Set fs = Nothing
Sub Main()
%>
File manager
<%
curr_dir = root_folder & curr_dir2
temp_arr = ShowDirList(curr_dir)
temp_arr = SortStr(temp_arr)
%>
| | | | | | ');"> |  |
<%
Call Main_Print(temp_arr,1)
temp_arr = ShowFilesList(curr_dir)
temp_arr = SortStr(temp_arr)
Call Main_Print(temp_arr,0)
%>
| Cartella corrente: <%=Replace(curr_dir2, "\", "\ ")%> ...... >>> Click sulla casa per uscire |
<%
' ###################### Modificare il percorso della HOME PAGE ######################################
%>
 |
<%
Erase temp_arr
End Sub
'####################################
Function ShowFilesList(folder)
Dim f, f1, fc, i
ReDim farr(0)
Set f = fs.GetFolder(folder)
Set fc = f.Files
i=0
For Each f1 In fc
farr(i) = CStr(f1.Name)
i = i + 1
ReDim Preserve farr(i)
Next
ShowFilesList = farr
End Function
'####################################
Function ShowDirList(folder)
Dim f, f1, fc, i
ReDim dirarr(0)
Set f = fs.GetFolder(folder)
Set fc = f.SubFolders
i=0
For Each f1 In fc
dirarr(i) = CStr(f1.Name)
i = i + 1
ReDim Preserve dirarr(i)
Next
ShowDirList = dirarr
End Function
'##########################################################
Function SortStr(arr)
Dim t,i,j
For j = 0 To UBound(arr)-1
For i = j + 1 To UBound(arr)-1
If StrComp(CStr(arr(i)), CStr(arr(j)), vbTextCompare) < 0 Then
t = arr(j)
arr(j) = arr(i)
arr(i) = t
End If
Next
Next
SortStr = arr
End Function
Sub Main_Print(arr,flag)
' flag=1 - êàòàëîãè
' flag=0 - ôàéëû
Dim i,k,tmp, edit_file
i = 0
Select Case flag
Case 1
If curr_dir2 <> "" Then
k = InStrRev(curr_dir2,"\")
If k <> 0 Then
tmp = Mid(curr_dir2,1,k-1)
Response.Write ""
Response.Write " | "
Response.Write "" & " .. " & " | | | |
"
End If
End If
For i = 0 To UBound(arr)-1
Response.Write ""
Response.Write " | "
Response.Write "" & arr(i) & _
" | " & GetFolderLastModified(root_folder & curr_dir2 & "\" & arr(i)) & " | " & FormatSize(GetFolderSize(root_folder & curr_dir2 & "\" & arr(i))) & " | |  |  |
"
Next
Case 0
For i = 0 To UBound(arr)-1
if (in_array(arrEditable, GetExt(root_folder & curr_dir2 & "\" & arr(i)))) then
edit_file = "
"
else
edit_file = " "
end if
Response.Write ""
Response.Write "![Download](" & GetExtImg(root_folder & curr_dir2 & "\" & arr(i)) & ") | "
Response.Write "" & arr(i) & " | " & GetFileLastModified(root_folder & curr_dir2 & "\" & arr(i)) & " | " & FormatSize(GetFileSize(root_folder & curr_dir2 & "\" & arr(i))) & " | " & edit_file & " | | |
"
Next
End Select
End Sub
Sub DelFile()
Dim fl, fl_path
fl = Request.QueryString("file")
fl_path = root_folder & curr_dir2 & "\" & fl
if fl <> "" then
fs.DeleteFile(fl_path)
end if
Response.Redirect "sfmanager.asp?dir=" & Server.URLEncode(curr_dir2)
End Sub
Sub DelFolder()
Dim fl, dir_path, tmp, k
' tmp - îòíîñ. ïóòü ê ïàïêå âûøå óðîâíåì
If curr_dir2 <> "" Then
k = InStrRev(curr_dir2,"\")
If k <> 0 Then
tmp = Mid(curr_dir2,1,k-1)
end if
end if
if curr_dir2 <> "" then
dir_path = root_folder & curr_dir2
fs.DeleteFolder(dir_path)
end if
Response.Redirect "sfmanager.asp?dir=" & Server.URLEncode(tmp)
End Sub
Sub NewFolder()
Dim nd, nd_path
nd = Request.QueryString("newdir")
nd_path = root_folder & curr_dir2 & "\" & nd
if nd <> "" then
fs.CreateFolder(nd_path)
end if
Response.Redirect "sfmanager.asp?dir=" & Server.URLEncode(curr_dir2)
End Sub
Sub RenameFolder()
Dim d, path1, path2, oldname, newname
oldname = Request.QueryString("oldname")
newname = Request.QueryString("newname")
path1 = root_folder & curr_dir2 & "\" & oldname
path2 = root_folder & curr_dir2 & "\" & newname
if oldname <> "" And newname <> "" then
if fs.FolderExists(path2) then
fs.CopyFolder path1, path2, True
fs.DeleteFolder(path1)
else
fs.MoveFolder path1, path2
end if
end if
Response.Redirect "sfmanager.asp?dir=" & Server.URLEncode(curr_dir2)
End Sub
Sub RenameFile()
Dim d, path1, path2, oldname, newname
oldname = Request.QueryString("oldname")
newname = Request.QueryString("newname")
path1 = root_folder & curr_dir2 & "\" & oldname
path2 = root_folder & curr_dir2 & "\" & newname
if oldname <> "" And newname <> "" then
if fs.FileExists(path2) then
fs.DeleteFile(path2)
end if
fs.MoveFile path1, path2
end if
Response.Redirect "sfmanager.asp?dir=" & Server.URLEncode(curr_dir2)
End Sub
Sub Download()
Dim fl, obj, name
name = Request.QueryString("file")
' ïîëíûé ïóòü ê ôàéëó äëÿ ñêà÷èâàíèÿ
fl = root_folder & curr_dir2 & "\" & name
Set obj = Server.CreateObject("ADODB.Stream")
obj.Open
obj.Type = 1
obj.LoadFromFile(fl)
Response.Clear
Response.ContentType="application/octet-stream"
Response.AddHeader "Content-disposition","attachment;filename=" & fs.GetFileName(fl)
If obj.Size > 0 Then
Response.BinaryWrite obj.Read
End If
obj.Close
Set obj = Nothing
End Sub
Sub ViewDownload()
Dim fl, obj, name
name = Request.QueryString("file")
' ïîëíûé ïóòü ê ôàéëó äëÿ ñêà÷èâàíèÿ
fl = root_folder & curr_dir2 & "\" & name
Set obj = Server.CreateObject("ADODB.Stream")
obj.Open
obj.Type = 1
obj.LoadFromFile(fl)
Response.Clear
Response.ContentType="application/octet-stream"
Response.AddHeader "Content-disposition","inline;filename=" & fs.GetFileName(fl)
If obj.Size > 0 Then
Response.BinaryWrite obj.Read
End If
obj.Close
Set obj = Nothing
End Sub
Function FormatSize(Size)
If NOT IsNumeric(Size) OR Size="" Then
FormatSize=""
ElseIf Size=0 Then
FormatSize="0B"
ElseIf Size>1024*1024*1024 Then
FormatSize=Round(Size/1024/1024/1024,1) & "GB"
ElseIf Size>10*1024*1024 Then
FormatSize=Round(Size/1024/1024) & "MB"
ElseIf Size>1024*1024 Then
FormatSize=Round(Size/1024/1024,1) & "MB"
ElseIf Size<100 Then
FormatSize=Size & "B"
ElseIf Size<1024 Then
FormatSize="1kB"
ElseIf Size>100*1024 AND Size<=1024*1024 Then
FormatSize=Round(Size/1024/1024,1) & "MB"
Else
FormatSize=Round(Size/1024) & "kB"
End If
End Function
Function GetFileSize(fl_path)
Dim f
Set f = fs.GetFile(fl_path)
GetFileSize = f.Size
End Function
Function GetFileLastModified(fl_path)
Dim f, d, fday, fmonth, fyear
Set f = fs.GetFile(fl_path)
d = f.DateLastModified
fday = CStr(Day(d))
fmonth = CStr(Month(d))
fyear = CStr(Year(d))
If (Len(fmonth) = 1) Then
fmonth = "0" & fmonth
End If
If (Len(fday) = 1) Then
fday = "0" & fday
End If
GetFileLastModified = fday & "." & fmonth & "." & fyear
End Function
Function GetFolderLastModified(fo_path)
Dim f, d, fday, fmonth, fyear
Set f = fs.GetFolder(fo_path)
d = f.DateLastModified
fday = CStr(Day(d))
fmonth = CStr(Month(d))
fyear = CStr(Year(d))
If (Len(fmonth) = 1) Then
fmonth = "0" & fmonth
End If
If (Len(fday) = 1) Then
fday = "0" & fday
End If
GetFolderLastModified = fday & "." & fmonth & "." & fyear
End Function
Function GetFolderSize(fo_path)
Dim f
Set f = fs.GetFolder(fo_path)
GetFolderSize = f.Size
End Function
Function GetExtImg(strIn)
Dim ext, res
ext = fs.GetExtensionName(strIn)
res = ""
if fs.FileExists(Server.MapPath("./img/" & ext & ".gif")) then
res = "img/" & ext & ".gif"
else
res = "img/file.gif"
end if
GetExtImg = res
End Function
Function GetExt(strIn)
Dim ext
ext = LCase(fs.GetExtensionName(strIn))
GetExt = ext
End Function
%>