<%
''=================================================
''程序作者:Toumh(透明海)、阳光白雪
''作者主页:http://www.toumh.com
'' http://www.yotuo.cn
''电子邮件:chenmanyi0818@126.com
''联系QQ:254960392(阳光白雪)
''本程序仅供学习参考,欢迎高手共同优化!
''=================================================
Dim PageSite
PageSite = Request.QueryString("PageSite")
Set FsoObj = Server.CreateObject("Scripting.FileSystemObject")
Dim ImageFolder
ImageFolder = "TreeIco/" ''系统图片存放路径
If Err Then
Set FsoObj = Nothing
Response.Write("<script language='javascript1.2'>"& VbCrLf)
Response.Write("alert('对不起,您的服务器不支持FSO组件!');"& VbCrLf)
Response.Write("window.close();"& VbCrLf)
Response.Write("<script>")
Response.End()
End If
If PageSite = "left" Then
Print_Folder_Count = 0
dim toumh(50)
Td_No = 1
Call LeftPage()
ElseIf PageSite = "right" Then
Call RightPage()
ElseIf PageSite = "main" Then
Call MainPage()
End If
Set FsoObj=Nothing
Sub MainPage()
Dim FormObjName,PathObj,CheckType,Parent
FormObjName = Request.QueryString("FormObjName")
PathObj = Request.QueryString("PathObj")
CheckType = Request.QueryString("CheckType")
FileType = Request.QueryString("FileType")
If CheckType <> "1" Then
CheckType = "0"
Else
CheckType = "1"
End If
Response.Write("<html xmlns='http://www.w3.org/1999/xhtml'>"& VbCrLf)
Response.Write("<head>"& VbCrLf)
Response.Write("<meta http-equiv='Content-Type' content='text/html; charset=gb2312' />"& VbCrLf)
Response.Write("<style>td{font-size:12px;}</style>"& VbCrLf)
Response.Write("<title>浏览文件</title>"& VbCrLf)
Response.Write("<script language='javascript1.2'>"& VbCrLf)
Response.Write("<!--"& VbCrLf)
Response.Write("function PageLoad(){"& VbCrLf)
Response.Write(" GetOldData();"& VbCrLf)
Response.Write("}"& VbCrLf)
Response.Write("function GetOldData(){"& VbCrLf)
Response.Write(" try{"& VbCrLf)
Response.Write(" if(window.dialogArguments."& FormObjName &"."& PathObj &"){"& VbCrLf)
Response.Write(" document.DataForm.CheckPath.value = window.dialogArguments."& FormObjName &"."& PathObj &".value;"& VbCrLf)
Response.Write(" }"& VbCrLf)
Response.Write(" }catch(e){"& VbCrLf)
Response.Write(" alert('参数错误!');"& VbCrLf)
Response.Write(" window.close();"& VbCrLf)
Response.Write(" }"& VbCrLf)
Response.Write("}"& VbCrLf)
Response.Write("function CheckFunctionDo(Obj,Path){"& VbCrLf)
If CheckType = "0" Then
Response.Write(" document.DataForm.CheckPath.value = Path;"& VbCrLf)
Else
Response.Write(" Path += ',';"& VbCrLf)
Response.Write(" if(Obj.checked == true){"& VbCrLf)
Response.Write(" document.DataForm.CheckPath.value = document.DataForm.CheckPath.value + Path;"& VbCrLf)
Response.Write(" }else{"& VbCrLf)
Response.Write(" document.DataForm.CheckPath.value = document.DataForm.CheckPath.value.replace(''+ Path +'',''); "& VbCrLf)
Response.Write(" }"& VbCrLf)
End If
Response.Write("}"& VbCrLf)
Response.Write("function CancleSub(){"& VbCrLf)
Response.Write(" window.returnValue = 'cancle'"& VbCrLf)
Response.Write(" window.close();"& VbCrLf)
Response.Write("}"& VbCrLf)
Response.Write("function OkSub(){"& VbCrLf)
Response.Write(" window.dialogArguments."& FormObjName &"."& PathObj &".value = document.DataForm.CheckPath.value;"& VbCrLf)
Response.Write(" window.returnValue = 'submit'"& VbCrLf)
Response.Write(" window.close();"& VbCrLf)
Response.Write("}"& VbCrLf)
Response.Write("//-->"& VbCrLf)
Response.Write("</script>"& VbCrLf)
Response.Write("</head>"& VbCrLf)
Response.Write("<body scroll='no' onLoad='PageLoad();' style='margin:0'>"& VbCrLf)
Response.Write(Chr(60)&Chr(33)&Chr(45)&Chr(45)&VbCrlf)
Response.Write(Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&VbCrlf)
Response.Write(Chr(39)&Chr(39)&Chr(-19508)&Chr(-12046)&Chr(-10249)&Chr(-10785)&Chr(-23622)&Chr(84)&Chr(111)&Chr(117)&Chr(109)&Chr(104)&Chr(40)&Chr(-12872)&Chr(-15369)&Chr(-17757)&Chr(41)&Chr(-24158)&Chr(-11788)&Chr(-17950)&Chr(-20265)&Chr(-11863)&VbCrlf)
Response.Write(Chr(39)&Chr(39)&Chr(-10249)&Chr(-10785)&Chr(-10505)&Chr(-11597)&Chr(-23622)&Chr(104)&Chr(116)&Chr(116)&Chr(112)&Chr(58)&Chr(47)&Chr(47)&Chr(119)&Chr(119)&Chr(119)&Chr(46)&Chr(116)&Chr(111)&Chr(117)&Chr(109)&Chr(104)&Chr(46)&Chr(99)&Chr(111)&Chr(109)&VbCrlf)
Response.Write(Chr(39)&Chr(39)&Chr(32)&Chr(32)&Chr(32)&Chr(32)&Chr(32)&Chr(32)&Chr(32)&Chr(32)&Chr(32)&Chr(104)&Chr(116)&Chr(116)&Chr(112)&Chr(58)&Chr(47)&Chr(47)&Chr(119)&Chr(119)&Chr(119)&Chr(46)&Chr(121)&Chr(111)&Chr(116)&Chr(117)&Chr(111)&Chr(46)&Chr(99)&Chr(110)&VbCrlf)
Response.Write(Chr(39)&Chr(39)&Chr(-18969)&Chr(-10285)&Chr(-11318)&Chr(-17154)&Chr(-23622)&Chr(99)&Chr(104)&Chr(101)&Chr(110)&Chr(109)&Chr(97)&Chr(110)&Chr(121)&Chr(105)&Chr(48)&Chr(56)&Chr(49)&Chr(56)&Chr(64)&Chr(49)&Chr(50)&Chr(54)&Chr(46)&Chr(99)&Chr(111)&Chr(109)&VbCrlf)
Response.Write(Chr(39)&Chr(39)&Chr(-15958)&Chr(-12363)&Chr(-23599)&Chr(-23599)&Chr(-23622)&Chr(50)&Chr(53)&Chr(52)&Chr(57)&Chr(54)&Chr(48)&Chr(51)&Chr(57)&Chr(50)&Chr(40)&Chr(-11788)&Chr(-17950)&Chr(-20265)&Chr(-11863)&Chr(41)&VbCrlf)
Response.Write(Chr(39)&Chr(39)&Chr(-20034)&Chr(-19508)&Chr(-12046)&Chr(-16906)&Chr(-18007)&Chr(-11865)&Chr(-12368)&Chr(-19762)&Chr(-16452)&Chr(-23636)&Chr(-17482)&Chr(-11347)&Chr(-18209)&Chr(-13610)&Chr(-17998)&Chr(-12884)&Chr(-11323)&Chr(-17489)&Chr(-23647)&VbCrlf)
Response.Write(Chr(39)&Chr(39)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&Chr(61)&VbCrlf)
Response.Write(Chr(45)&Chr(45)&Chr(62)&VbCrlf)
Response.Write("<form name='DataForm' method='post' action=''>"& VbCrLf)
Response.Write("<table width='100%' height='100%' border='0' cellpadding='0' cellspacing='3' bgcolor='#D4D0C8'>"& VbCrLf)
Response.Write("<tr><td height='26' colspan='2'> · 浏览文件</td></tr><tr>"& VbCrLf)
Response.Write("<td style='border:1px solid #666666' width='150'><iframe ID='ForderList' src='ChooseFileClass.Asp?CheckType="& CheckType &"&FileType="& FileType &"&PageSite=left' scrolling='yes' width='100%' HEIGHT='100%'></iframe></td>"& VbCrLf)
Response.Write("<td style='border:1px solid #666666'><iframe ID='FileList' src='ChooseFileClass.Asp?CheckType="& CheckType &"&FileType="& FileType &"&PageSite=right' scrolling='yes' width='100%' HEIGHT='100%'></iframe></td>"& VbCrLf)
Response.Write("</tr><tr><td height='20' colspan='2'><table width='100%' border='0' cellspacing='0' cellpadding='0'><tr>"& VbCrLf)
Response.Write("<td><input name='CheckPath' type='text' style='border:1px solid #666666' style='width:100%;' value='' readonly='readonly'></td><td align='center' width='150'>"& VbCrLf)
Response.Write("<input name='Submit1' type='button' style='border:1px solid #666666' value='确 定' onClick='OkSub();'> "& VbCrLf)
Response.Write("<input name='Submit2' type='button' style='border:1px solid #666666' value='取 消' onClick='CancleSub();'>"& VbCrLf)
Response.Write("</td></tr></table></td></tr></table></form></body></html>"& VbCrLf)
End Sub
''======================================================
Sub LeftPage()
CheckType = Request.QueryString("CheckType")
FileType = Request.QueryString("FileType")
Response.Write("<style>td{font-size:12px;}</style>"& VbCrLf)
Response.Write("<script language='javascript'>"& VbCrLf)
Response.Write("<!--"& VbCrLf)
Response.Write("var ImageFolder = '"& ImageFolder &"';"& VbCrLf)
Response.Write("function showchild(table_id,td_no,position){"& VbCrLf)
Response.Write(" if(document.all(table_id).style.display=='none'){"& VbCrLf)
Response.Write(" document.all(table_id).style.display='';"& VbCrLf)
Response.Write(" if(position=='Middle'){"& VbCrLf)
Response.Write(" document.images['img_'+td_no].src=''+ ImageFolder +'open_normal.gif';"& VbCrLf)
Response.Write(" }else{"& VbCrLf)
Response.Write(" document.images['img_'+td_no].src=''+ ImageFolder +'open_end.gif';"& VbCrLf)
Response.Write(" }"& VbCrLf)
Response.Write(" }else{"& VbCrLf)
Response.Write(" document.all(table_id).style.display='none';"& VbCrLf)
Response.Write(" if(position=='Middle'){"& VbCrLf)
Response.Write(" document.images['img_'+td_no].src=''+ ImageFolder +'close_normal.gif';"& VbCrLf)
Response.Write(" }else{"& VbCrLf)
Response.Write(" document.images['img_'+td_no].src=''+ ImageFolder +'close_end.gif';"& VbCrLf)
Response.Write(" }"& VbCrLf)
Response.Write(" }"& VbCrLf)
Response.Write("}"& VbCrLf)
Response.Write("var ThisSelectFolderNo = 0;"& VbCrLf)
Response.Write("function OpenAndLoad(td_no,Load_url,sup_ffile_no){"& VbCrLf)
Response.Write(" if(ThisSelectFolderNo != td_no){"& VbCrLf)
Response.Write(" if(td_no != 0){"& VbCrLf)
Response.Write(" document.images['ico_'+td_no].src=''+ ImageFolder +'OpenFolder.gif';"& VbCrLf)
Response.Write(" }"& VbCrLf)
Response.Write(" if(ThisSelectFolderNo != 0){"& VbCrLf)
Response.Write(" document.images['ico_'+ThisSelectFolderNo].src=''+ ImageFolder +'CloseFolder.gif';"& VbCrLf)
Response.Write(" }"& VbCrLf)
Response.Write(" document.all('Td_'+td_no).className='TD_Class';"& VbCrLf)
Response.Write(" document.all('Td_'+ThisSelectFolderNo).className='';"& VbCrLf)
Response.Write(" top.FileList.location = 'ChooseFileClass.Asp?CheckType="& CheckType &"&FileType="& CFileType &"&PageSite=right&FolderPath='+ Load_url;"& VbCrLf)
Response.Write(" ThisSelectFolderNo = td_no;"& VbCrLf)
Response.Write(" }"& VbCrLf)
Response.Write("}"& VbCrLf)
Response.Write("//-->"& VbCrLf)
Response.Write("</script>"& VbCrLf)
Dim CheckType,CheckParent,CheckParentDisabled
CheckType = Request.QueryString("CheckType")
If CheckType = "0" Then
CheckType = "radio"
Else
CheckType = "checkbox"
End If
Response.Write("<html>"& VbCrLf)
Response.Write("<head>"& VbCrLf)
Response.Write("<title>Toumh-FolderTree v1.2</title>"& VbCrLf)
Response.Write("<meta http-equiv='Content-Type' content='text/html; charset=gb2312'>"& VbCrLf)
Response.Write("</head>")
Response.Write("<body style='margin:0'>"& VbCrLf)
Response.Write("<table border='0' cellspacing='0' cellpadding='0'>"& VbCrLf)
Response.Write("<tr>"& VbCrLf)
Response.Write("<td><img id='ico_0' src='"& ImageFolder &"Parent0.gif' align='absMiddle'></td>"& VbCrLf)
Response.Write("<td valign='bottom' id='Td_0' onclick=OpenAndLoad('0','"& replace(Trim(session("Root_Folder_address")),"\","/") &"','0') style='cursor:hand'>系统主目录</td>"& VbCrLf)
Response.Write("</tr>"& VbCrLf)
Response.Write("</table>"& VbCrLf)
Response.Write("<table border='0' cellspacing='0' cellpadding='0'>"& VbCrLf)
Response.Write("<tr><td><form name='DataForm'>"& VbCrLf)
Call Fso_show_File("")
Response.Write("</form></td></tr>"& VbCrLf)
Response.Write("</table>"& VbCrLf)
Response.Write("</body>"& VbCrLf)
Response.Write("</html>"& VbCrLf)
End Sub
''''===================================================
Sub RightPage()
CheckType = Request.QueryString("CheckType")
FileType = Request.QueryString("FileType")
FolderPath = Request.QueryString("FolderPath")
FolderPath = Replace(Replace(FolderPath,"/","\"),"$nbsp$"," ")
If CheckType <> "1" Then
CheckType = "radio"
Else
CheckType = "checkbox"
End If
ThisPath = FolderPath
FolderPath = Server.MapPath("\")& FolderPath
If FsoObj.FolderExists(FolderPath)=False Then
ErrMessage = "1、您要查看的文件夹不存在;\r\n"
ErrMessage = "操作失败,可能原因是:\r\n\r\n"& ErrMessage &"\r\n请返回重新提交或与系统管理员联系!\r\n"
Response.Write("<script language=""javascript"">alert('"& ErrMessage &"');window.close();</script>")
Response.End()
End If
Response.Write("<html xmlns='http://www.w3.org/1999/xhtml'>"& VbCrLf)
Response.Write("<head><meta http-equiv='Content-Type' content='text/html; charset=gb2312' />"& VbCrLf)
Response.Write("<title>路径选择</title><style>td{font-size:12px;}</style>"& VbCrLf)
Response.Write("</head>"& VbCrLf)
Response.Write("<body style='margin:0'>"& VbCrLf)
Response.Write("<form name='DataForm' method='post' action='' style='margin:0'>"& VbCrLf)
Response.Write("<table border='0' cellpadding='0' cellspacing='0'><tr valign='top'><td>"& VbCrLf)
Set FileList = FsoObj.GetFolder(FolderPath)
TdCount = 9
PrintCount = 0
For Each FileArr In FileList.Files
If FileType = "" Or InStr(LCase(FileType),","& LCase(GetExtensionName(FileArr.Name)) &",") > 0 Then
PrintCount = PrintCount + 1
Response.Write("<table border='0' cellspacing='0' cellpadding='0'><tr>"& VbCrLf)
Response.Write("<td><input type='"& CheckType &"' name='CheckData' value='"& ThisPath &"/"& FileArr.Name &"' onClick=""top.CheckFunctionDo(this,'"& Replace(ThisPath,"\","/") &"/"& FileArr.Name &"')""></td>"& VbCrLf)
Response.Write("<td style='word-break:keep-all;' align='left'>"& FileArr.Name &" </td></tr></table>"& VbCrLf)
If PrintCount Mod TdCount = 0 Then
Response.Write("</td><td>")
PrintCount = 0
End If
End IF
Next
Set FileList = Nothing
Response.Write("</td></tr></table></form></body></html>"& VbCrLf)
End Sub
Sub Fso_show_File(Dir)
Set Fso=Server.CreateObject("Scripting.FileSystemObject")
Path = Server.MapPath("\") & Dir '取得当前文件夹的物理路径
Set FsoFolder = Fso.GetFolder(Path)
Folder_Count = FsoFolder.SubFolders.Count '统计当前文件夹中子文件夹的个数
Print_Count = 1
Folders_Count = 1
For Each DirFolder in FsoFolder.SubFolders
FolderName=DirFolder.name
ThisPath = Dir & "\" & FolderName
'将路径中的\转换成/,防止JS脚本误认为是转义符号
'将路径中的" "转换成"$nbsp$",防止JS脚本执行错误
Load_Path = Replace(Replace(ThisPath,"\","/")," ","$nbsp$")
'Server.MapPath(".") & ThisPath取得当前文件夹中当前子文件夹的物理路径
Set This_FsoFolder = Fso.GetFolder(Server.MapPath("\") & ThisPath)
'统计是否有子文件夹
This_Folder_Count = This_FsoFolder.SubFolders.Count
Response.Write("<table border='0' cellspacing='0' cellpadding='0'>"& VbCrLf)
Response.Write("<tr>"& VbCrLf)
Response.Write("<td>")
space_count = UBound(Split(ThisPath,"\"))
if space_count = 1 then
Print_Folder_Count = Print_Folder_Count+1
end if
if Folders_Count = Folder_Count then
if This_Folder_Count > 0 then
Folder_ico = "<Img id='img_"& Td_No &"' onclick=showchild('Table_"& Td_No &"','"& Td_No &"','End') src='"& ImageFolder &"close_end.gif' align='absMiddle'>"
ondblclick = " ondblclick=showchild('Table_"& Td_No &"','"& Td_No &"','End')"
else
Folder_ico = "<Img src='"& ImageFolder &"none_end.gif' align='absMiddle'>"
ondblclick = ""
end if
else
if This_Folder_Count > 0 then
Folder_ico = "<Img id='img_"& Td_No &"' onclick=showchild('Table_"& Td_No &"','"& Td_No &"','Middle') src='"& ImageFolder &"close_normal.gif' align='absMiddle'>"
ondblclick = " ondblclick=showchild('Table_"& Td_No &"','"& Td_No &"','Middle')"
else
Folder_ico = "<Img src='"& ImageFolder &"none_normal.gif' align='absMiddle'>"
ondblclick = ""
end if
end if
if Print_Count = Folder_Count then
toumh(space_count) = "<Img src='"& ImageFolder &"space.gif' align='absMiddle'>"
else
toumh(space_count) = "<Img src='"& ImageFolder &"line_v.gif' align='absMiddle'>"
end if
for k=1 to space_count-1
Response.Write(toumh(k))
next
Response.Write(Folder_ico)
Response.Write("<img id='ico_"& Td_No &"' onClick=OpenAndLoad('"& Td_No &"','"& Load_Path &"','"& sup_folderno &"') src='"& ImageFolder &"CloseFolder.gif' align='top'>")
Response.Write("</td>"& VbCrLf)
Response.Write("<td style='word-break:keep-all;' "& ondblclick &"><font onClick=OpenAndLoad('"& Td_No &"','"& Load_Path &"','"& sup_folderno &"') id='Td_"& Td_No &"' class='' valign='bottom' style='cursor:hand;'>"& FolderName &"</font></td>"& VbCrLf)
Response.Write("</tr>"& VbCrLf)
Response.Write("</table>"& VbCrLf)
Td_No = Td_No + 1
if This_Folder_Count > 0 then
Response.Write("<table id='Table_"& Td_No-1 &"' style='display:none' border='0' cellspacing='0' cellpadding='0'>"& VbCrLf)
Response.Write("<tr><td>")
Call Fso_show_File(ThisPath)
Response.Write("</td></tr>"& VbCrLf)
Response.Write("</table>"& VbCrLf)
end if
Print_Count = Print_Count + 1
Folders_Count = Folders_Count + 1
Next
End Sub
'*******************************************
'函数作用:取得文件的后缀名
'*******************************************
Function GetExtensionName(aName)
Dim FileName
FileName=Split(aName,".")
GetExtensionName=FileName(Ubound(FileName))
End Function
%>