同文件夹内文本搜索器(vbs)
            (编辑:jimmy 日期: 2025/10/31 浏览:2)
         
        <HTML><HEAD><TITLE>同文件夹内文本搜索器(vbs)</TITLE>
<META http-equiv=Content-Type content="text/html; charset=gb2312">
<SCRIPT language=vbscript id=clientEventHandlersVBS>
<!--
Dim fso, f, f1, fc,fn,s,uf1,ufn
Sub B1_onclick
 fn=T1.value '' 
 pn=mid(location.pathname,2,len(location.pathname)-14)
 ShowFolderList(pn)
End Sub
Function ShowFolderList(path)
 ''msgbox path
 Set fso = CreateObject("Scripting.FileSystemObject")
 Set f = fso.GetFolder(path)
 Set fc = f.Files
'' ufn=ucase(fn)
 For Each f1 in fc 
 filespec= path & f1.name
 ReadEntireFile(filespec)
'' uf1=ucase(f1.name) 
'' if instr(uf1,ufn) <> 0 then 
'' s=s & "<a href=" & path & f1.name & ">" & f1.name & "</a><br>"
'' end if 
 Next
 document.write "已搜索到以下条目,请单击之。[墨伯编制 于2003年元月]<br>"
 document.write s
 set fc=nothing
 set f=nothing
 set fso=nothing
End Function
Function ReadEntireFile(filespec)
 Const ForReading = 1
 Dim fso, theFile, retstring
 Set fso = CreateObject("Scripting.FileSystemObject")
 Set theFile = fso.OpenTextFile(filespec, ForReading, False)
 ufn=ucase(fn)
 Do While theFile.AtEndOfStream<> True
 retstring = theFile.ReadLine
 uf1=ucase(retstring)
 if instr(uf1,ufn) <> 0 then 
 s=s & "<a href=" & path & f1.name & ">" & f1.name & "</a><br>"
 exit do
 end if 
 Loop
 theFile.Close
 ReadEntireFile = s
End Function
-->
</SCRIPT>
</HEAD>
<BODY>
<P align=center><FONT color=#000000 size=6>请输入要搜索[在正文中包含]的关键词(</FONT><FONT 
color=#000000 size=3>忽略大小写</FONT><FONT color=#000000 size=6>)</FONT> </P>
<P align=center><FONT size=2><FONT color=#000000>[墨伯编制 
于2003年1月5日]</FONT> </FONT> </P>
<P align=center><INPUT name=T1><INPUT type=button value=搜索! name=B1></P>
<P align=center> </P></BODY></HTML>