文本特征码定位器

On Error Resume Next
Call Help()
f=InputBox ("输入要定位的文件名(带后缀)","脚本文件特征码定位 by DOS资源站")
If f="" Then
WScript.Quit
End If

Suffix = mid(f,instr(1,f,"."),len(f))   '得到文件后缀

Set fso=CreateObject("Scripting.FileSystemObject")
set file=fso.opentextfile(f,1,true)
getline=0   '得到文件的长度
Do While Not file.AtEndOfStream
file.SkipLine
getline=getline+1
Loop
file.Close

fso.DeleteFolder("outfiles")   '删除文件夹outfiles
fso.CreateFolder("outfiles")   '新建文件夹outfiles

n=0
Set file=fso.OpenTextFile(f,1,True)   '生成查杀的文件
Do Until n>=getline
n=n+1
Set killf=fso.OpenTextFile("outfiles\"&n&Suffix,2,True)
temp=deltextfile(f,n)
killf.Write temp
killf.Close
Loop
file.Close

return=MsgBox ("杀毒软件查杀完成后点击确定",64,"脚本文件特征码定位 by www.cmdos.net")
If return=1 Then
ffnames=getFfnames("outfiles")   '取得outfiles下文件名
ffnames=Replace(ffnames,Suffix,",")
ffnames=Left(ffnames,Len(ffnames)-1)
ary = Split(ffnames,",", -1,1)
Else If return=2 Then
   WScript.Quit
   End If
End If

Set report=fso.OpenTextFile("Report.txt",2,True)   '生成报告文件
report.WriteLine "脚本文件特征码定位 by www.cmdos.net"&vbCrLf&vbCrLf
report.WriteLine "特征码定位结果如下："&vbCrLf
For Each num In ary
line=FSOlinedit(f,num)
report.WriteLine num&"、"&line
Next
report.Close
fso=Nothing

MsgBox "定位完成，请打开report.txt查看定位结果。",64,"脚本文件特征码定位 by www.cmdos.net"

Function deltextfile(Filename,lineNum)   '删除指定文件指定行数函数
Set fso=CreateObject("Scripting.FileSystemObject")
Set delfile=fso.OpenTextFile(filename,1,True)
temp=""
While Not delfile.AtEndOfStream
If CInt(delfile.Line)<>CInt(linenum) Then
   If temp<>"" Then
    temp=temp&vbCrLf&delfile.ReadLine
   Else
    temp=temp&delfile.ReadLine
   End If
Else
   delfile.SkipLine
   temp=temp&vbCrLf
End If
Wend
delfile.Close
deltextfile=temp
End Function

Function FSOlinedit(filename,lineNum)   '读取指定行数内容函数
lineNum=Int(lineNum)
    If lineNum < 1 Or linenum="" Then Exit Function
    Dim fso,f,temparray,tempcnt
    Set fso=CreateObject("Scripting.FileSystemObject")
    If Not fso.FileExists(filename) Then Exit Function
    Set f=fso.OpenTextFile(filename,1,True)
    If Not f.AtEndOfStream Then
        tempcnt=f.ReadAll
        f.Close
        Set f=Nothing
        temparray=Split(tempcnt,vbCrLf)
        If linenum > UBound(temparray)+1 Then Exit Function
        FSOlinedit=temparray(linenum-1)
    End If
End Function

Function getFfnames(mulu)   '参数，目录名
Set fso=CreateObject("Scripting.FileSystemObject")
Set folder=fso.GetFolder(mulu)
Set fc = folder.Files
For Each fs In fc
ary=fs.Name
mystring=mystring+ary
Next
getFfnames=mystring
End Function

Function Help()
MsgBox "使用方法:输入要定位的文件名(必须与本VBS放同一目录)，按确定生成文件，杀毒软件查杀完后按确定，生成report.txt文件。",64,"脚本文件特征码定位 by DOS资源站 www.cmdos.net"
End Function