同文件夹内文本搜索器(vbs)

  <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>