browse.asp

html在线编辑器

<!--#include file ="config.asp"--->
<%
dim suploaddir,scurrdir,sdir
str=split(aStyle(1),"|||")
call content()

Sub content()

	if  isobjinstalled("scripting.filesystemobject") = false then
        response.write("要支募系统FSO姆支")
        exit sub
        end if
        call InitParam()
        call ShowList()
end sub
sub ShowList()
If sCurrDir = "" Then Exit Sub
'去目录
'Response.Write "<table border=0 cellpadding=0 cellspacing=0 class=list1>" & _
'  "<form action='?dir=" & sDir & "' method=post name=myform>" & _
'  "<tr align=center>" & _
'   "<th width=50></th>" & _
'   "<th width=140>募址</th>" & _
'   "<th width=100>小</th>" & _
'   "<th width=130></th>" & _
'   "<th width=130>洗</th>" & _
'   "<th width=30>删</th>" & _
'  "</tr>"

 Dim sCurrPage, nCurrPage, nFileNum, nPageNum, nPageSize
 sCurrPage = Trim(Request("page"))
 nPageSize = 20
 If sCurrpage = "" Or Not IsNumeric(sCurrPage) Then
  nCurrPage = 1
 Else
  nCurrPage = CLng(sCurrPage)
 End If

 Dim oFSO, oUploadFolder, oUploadFiles, oUploadFile, sFileName

 Set oFSO = Server.CreateObject("Scripting.FileSystemObject")
 On Error Resume Next
' Set oUploadFolder = oFSO.GetFolder(Server.MapPath(sCurrDir))
 Set oUploadFolder = oFSO.GetFolder(Server.MapPath("\uploadfile"))
 If Err.Number>0 Then
  'Response.Write "</table>效目录"
  Exit Sub
 End If


 If sDir <> "" Then
  'Response.Write "<tr align=center>" & _
  ' "<td><img border=0 src='sysimage/file/folderback.gif'></td>" & _
   '"<td align=left colspan=5><a href=""?id=" & sStyleID & "&dir="
  If InstrRev(sDir, "/") > 1 Then
  ' Response.Write Left(sDir, InstrRev(sDir, "/") - 1)
  End If
  'Response.Write """>一目录</a></td></tr>"
 End If

 Dim oSubFolder
 For Each oSubFolder In oUploadFolder.SubFolders
  'Response.Write "<tr align=center>" & _
 '"<td><img border=0 src='sysimage/file/folder.gif'></td>" & _
 ' "<td align=left colspan=4><a href=""?id=" & sStyleID & "&dir="
  If sDir <> "" Then
 '  Response.Write sDir & "/"
  End If
  'Response.Write oSubFolder.Name & """>" & oSubFolder.Name & "</a></td>" & _
  ' "<td><a href='?dir=" & sDir & "'>删</a></td></tr>"
 Next


 Set oUploadFiles = oUploadFolder.Files

 nFileNum = oUploadFiles.Count
 nPageNum = Int(nFileNum / nPageSize)
 If nFileNum Mod nPageSize > 0 Then
  nPageNum = nPageNum+1
 End If
 If nCurrPage > nPageNum Then
  nCurrPage = 1
 end If

 Dim i
 i = 0
 For Each oUploadFile In oUploadFiles
  i = i + 1
  If i > (nCurrPage - 1) * nPageSize And i <=oUploadFiles.Count Then
   sFileName = oUploadFile.Name
 
 '+++++++++++++++++++++++++++++++++++++++++++++
' 式
'<tr onclick='doRowClick(this)' onmouseover='doRowOver(this)' onmouseout='doRowOut(this)' url='http://des.yi.org/uploadfile/20060428213656536.jpg'><td>
'  <img border=0 src='../sysimage/file/jpg.gif'></td><td noWrap>20060428213656536.jpg</td>
'  <td align=right>52.29K</td></tr>

 
 
 '+++++++++++++++++++++++++++++++++++++++++++++++++++
   
   
    pstr=pstr&"<tr onclick='doRowClick(this)' onmouseover='doRowOver(this)' onmouseout='doRowOut(this)' url='../" & sCurrDir & sFileName &"'><td>" & _ 
    "" & FileName2Pic(sFileName) & "</td>" & _
    "<td noWrap>" & sFileName & "</td>" & _
    "<td align=right>" & GetSizeUnit(oUploadFile.size) & "  </td></tr>" 
   ' "<td><input type=checkbox name=delfilename value=""" & sFileName & """></td></tr>"
  Elseif i > nCurrPage * nPageSize Then
   Exit For
  End If
 Next
 Set oUploadFolder = Nothing
 Set oUploadFiles = Nothing

 If nFileNum <= 0 Then
 ' Response.Write "<tr><td colspan=6>指目录诨没募</td></tr>"
 End If
 'Response.Write "</table>"

 If nFileNum > 0 Then
  ' 页
 ' Response.Write "<table border=0 cellpadding=3 cellspacing=0 width='100%'><tr><td>"
  If nCurrPage > 1 Then
  ' Response.Write "<a href='?id=" & sStyleID & "&dir=" & sDir & "&page=1'>页</a>&nbsp;&nbsp;<a href='?id=" & sStyleID & "&dir=" & sDir & "&page="& nCurrPage - 1 & "'>一页</a>&nbsp;&nbsp;"
  Else
   'Response.Write "页&nbsp;&nbsp;一页&nbsp;&nbsp;"
  End If
  If nCurrPage < i / nPageSize Then
  ' Response.Write "<a href='?id=" & sStyleID & "&dir=" & sDir & "&page=" & nCurrPage + 1 & "'>一页</a>&nbsp;&nbsp;<a href='?id=" & sStyleID & "&dir=" & sDir & "&page=" & nPageNum & "'>尾页</a>"
  Else
  ' Response.Write "一页&nbsp;&nbsp;尾页"
  End If
 ' Response.Write "&nbsp;&nbsp;&nbsp;&nbsp;<b>" & nFileNum & "</b>&nbsp;&nbsp;页:<b><span class=highlight2>" & nCurrPage & "</span>/" & nPageNum & "</b>&nbsp;&nbsp;<b>" & nPageSize & "</b>募/页"
 ' Response.Write "</td></tr></table>"
 End If

' Response.Write "<p align=right><input type=submit name=b value=' 删选募 '> <input type=button name=b1 value=' 募 ' onclick=""javascript:if (confirm('确要募')) {location.href='admin_uploadfile.asp?id=" & sStyleID & "&dir=" & sDir & "&action=delall';}""></p></form>"
call  OutScript(pstr)
End Sub


' 欠支某一
Function IsObjInstalled(strClassString)
 On Error Resume Next
 IsObjInstalled = False
 Err = 0
 Dim xTestObj
 Set xTestObj = Server.CreateObject(strClassString)
 If 0 = Err Then IsObjInstalled = True
 Set xTestObj = Nothing
 Err = 0
End Function


' 募取图
function GetSizeUnit(n_Size)
	if(n_Size >= 1024*1024) then
		r_size=left((n_Size / 1024 / 1024), 2) & "M"
	else
		r_size=left((n_Size / 1024), 2) & "K"
	GetSizeUnit=r_size
	end if
end function

Function FileName2Pic(sFileName)
 Dim sExt, sPicName
 sExt = UCase(Mid(sFileName, InstrRev(sFileName, ".")+1))
 Select Case sExt
 Case "TXT"
  sPicName = "txt.gif"
 Case "CHM", "HLP"
  sPicName = "hlp.gif"
 Case "DOC"
  sPicName = "doc.gif"
 Case "PDF"
  sPicName = "pdf.gif"
 Case "MDB"
  sPicName = "mdb.gif"
 Case "GIF"
  sPicName = "gif.gif"
 Case "JPG"
  sPicName = "jpg.gif"
 Case "BMP"
  sPicName = "bmp.gif"
 Case "PNG"
  sPicName = "pic.gif"
 Case "ASP", "JSP", "JS", "PHP", "PHP3", "ASPX"
  sPicName = "code.gif"
 Case "HTM", "HTML", "SHTML"
  sPicName = "htm.gif"
 Case "ZIP"
  sPicName = "zip.gif"
 Case "RAR"
  sPicName = "rar.gif"
 Case "EXE"
  sPicName = "exe.gif"
 Case "AVI"
  sPicName = "avi.gif"
 Case "MPG", "MPEG", "ASF"
  sPicName = "mp.gif"
 Case "RA", "RM"
  sPicName = "rm.gif"
 Case "MP3"
  sPicName = "mp3.gif"
 Case "MID", "MIDI"
  sPicName = "mid.gif"
 Case "WAV"
  sPicName = "audio.gif"
 Case "XLS"
  sPicName = "xls.gif"
 Case "PPT", "PPS"
  sPicName = "ppt.gif"
 Case "SWF"
  sPicName = "swf.gif"
 Case Else
  sPicName = "unknow.gif"
 End Select
 FileName2Pic = "<img border=0 src='../sysimage/file/" & sPicName & "'>"
End Function


' ===============================================
' 始
' ===============================================
Function InitParam()
 sStyleID = Trim(Request("id"))
 sUploadDir = ""
 str=split(aStyle(1),"|||")
 sUploadDir=str(3)
 If sUploadDir = "" Then
  
 Else
  sUploadDir = Replace(sUploadDir, "\", "/")
  If Right(sUploadDir, 1) <> "/" Then
   sUploadDir =sUploadDir & "/"
  End If
 End If
 sCurrDir = sUploadDir

 ' 式碌目录
 sDir = Trim(Request("dir"))
 If sDir <> "" Then
  If CheckValidDir(Server.Mappath(sUploadDir & sDir)) = True Then
     sCurrDir = sUploadDir & sDir & "/"
  Else
   sDir = ""
  End If
 End If
End Function
function OutScript(pstr)
response.write("<HTML><HEAD><meta http-equiv='Content-Type' content='text/html; charset=utf-8'><TITLE>dr</TITLE></head><body>")
response.write("<script language=javascript>parent.setDirList(""" & pstr & "")
response.write("</table>"", ""/"")")
response.write("</script></body></html>")
end function


' ===============================================
' 目录效
' ===============================================
Function CheckValidDir(s_Dir)
 Dim oFSO
 Set oFSO = Server.CreateObject("Scripting.FileSystemObject")
 CheckValidDir = oFSO.FolderExists(s_Dir)
 Set oFSO = Nothing 
End Function
%>