附网页文件查找字符串代码(findstr_html.vbs)：
| ' findstr_html.vbs Call Main() Sub Main() ' CMD 模式 If Not (LCase(Right(WScript.FullName,11)) = LCase("CScript.exe")) Then CreateObject("WScript.Shell").Run "cscript.exe //nologo """ & WScript.ScriptFullName & """", 1, False WScript.Quit(1) End If Dim strMeDir strMeDir = Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName,"")-1) Dim regEx, strHTML, strURL ' 扫描文件夹 Dim arr() : ReDim Preserve arr(0) Call ScanFolder(arr, strMeDir & "720.hao2046.net") If UBound(arr) = 0 Then WScript.Echo strMeDir & "720.hao2046.net" & ", Not Found!" Exit Sub End If ' 建立正则表达式。 Set regEx = CreateObject("VBScript.RegExp") ' 建立正则表达式。 regEx.IgnoreCase = True ' 设置是否区分大小写。 regEx.Global = True ' 设置全局替换。 regEx.MultiLine = True ' 设置多行匹配模式 Do strPattern = InputBox("请输入要匹配的正则表达式：","查找所有网页文件","123456") strInfo = strPattern & vbCrLf & "Not Found!" For i = 0 To UBound(arr) If LCase(Right(arr(i),5)) = ".html" Or LCase(Right(arr(i),4)) = ".htm" Then 'WScript.Echo arr(i) strHTML = ReadPfile(arr(i), "gb2312") If InStr(strHTML, strPattern)>0 Then strInfo = strPattern & vbCrLf & arr(i) & vbCrLf Exit For Else 'regEx.Pattern = "src=['""]http://S+.jpg['""]" regEx.Pattern = strPattern Set Matches = regEx.Execute(strHTML) ' 执行搜索。 For Each Match in Matches ' 遍历匹配集合。 If Not Match.Value = "" Then 'regEx.Pattern = "(src=['""])*(['""])*" 'strURL = strURL & regEx.Replace(Match.Value, "") & vbCrLf strInfo = strPattern & vbCrLf & arr(i) & vbCrLf Exit For End If Next End If End If Next WScript.Echo strInfo Loop End Sub '=========================================================================================== '按编码读取txt文件内容 Function ReadPfile(ByVal FileName, ByVal FileCode) Dim objStream Set objStream = CreateObject("ADODB.Stream") ' With objStream .Type = 2 .Mode = 3 .open .Charset = FileCode '不同编码时自己换,Chinese (Simplified) (GB2312),中文 GBK ,繁体中文 Big5 ,日文 EUC-JP ,韩文 EUC-KR,charset=UTF-8(国际化编码),ANSI,Unicode,unicode big endian .LoadFromFile FileName ReadPfile = .ReadText .Close End With Set objStream = Nothing End Function ' Dim arr() : ReDim Preserve arr(0) ' Call ScanFolder(arr, "V:") Sub ScanFolder(ByRef arr, ByVal strFolderspec) On Error Resume Next Dim fso, objFolder Set fso = Createobject("Scripting.FileSystemObject") Set objFolder = fso.getfolder(strFolderspec) ReDim Preserve arr(UBound(arr)+1) arr(UBound(arr)) = strFolderspec & "" For Each subFile In objFolder.files ReDim Preserve arr(UBound(arr)+1) arr(UBound(arr)) = subFile.path Next For Each subFolder In objFolder.subfolders ScanFolder arr, subFolder.path Next Set fso = NoThing Set objFolder = NoThing End Sub |
