hta编写的软件管理工具0.1(IE7.0测试通过)
(编辑：jimmy 日期: 2024/12/26 浏览：3 次 )
自定义分类，是归档文件，好比你可以把你的工具分为渗透、溢出、网马、浏览之类的，可无限建分类
建好分类后，你可以进行第二步，根据你需要的后缀来进行分类，不建议将dll文件也分类，只把exe和webshell之类进行收集吧
第二步查找结束后，可以选择程序建立的SearchResult.txt，根据提示构选要存到哪一个分类，自动存进数据库
第三步当然是进行查找了，根据自定义sql语句查找你的工具
程序只是个雏形，可以提供建议，有时间再修正bug，进行软件升级
复制代码 代码如下:
<HTML>
<HEAD>
<HTA:Application ID="oHTA"
Applicationname="myApp"
border="thin"
borderstyle="normal"
caption="yes"
maximizebutton="yes"
minimizebutton="yes"
showintaskbar="no"
singleinstance="no"
sysmenu="yes"
version="1.0"
windowstate="normal"
scroll="yes">
<TITLE>工具归类软件v0.1 code by lcx myweb:http://www.haiyangtop.net</TITLE>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
</head>
<style>
body
{
font-size:12;
BACKGROUND: #DADADA;
margin-left:5;
}
input
{
width:40;
overflow:visible;
border:1px solid lightblue;
background-color:#cccccc;
cursor:text;
}
button
{
border:1px solid gray;
width:260;
margin-left:2;
cursor:hand;
font-size:12;
filter:progid:DXImageTransform.Microsoft.Gradient(startColorStr='#eaeaff', endColorStr='#618fff', gradientType='0');
}
textarea
{
font-family:Verdana;
font-size:12px;
overflow-x:visible;
overflow-y:scroll;
}
</style>
<body>
<center>
<br><br><br><br><br><br><br>
<div id="DivList"></div>
<div id="start" style="display:none;">
<div id=baobao>自定义数据库字段，也就是软件分类工作</div>
<button onclick=vbs:addinput><strong>设定字段名+</strong></button>
<button onclick=vbs:delinput><strong>减少字段名-</strong></button>
<button onclick=vbs:countall><strong>建立数据库</strong></button>
</div>
<a href=# onclick="ShowHideLayer('start')" >程序初始化</a> </br>
<div id="starttwo" style="display:none;overflow:scroll">
<button onclick=vbs:startwo><strong>工具整理第一步</strong></button>
<button onclick=vbs:showpath><strong>工具整理第二步，列表选择写入数据库</strong></button>
</div>
<a href=# onclick="ShowHideLayer('starttwo')" >软件整理工作</a> </br>
<div id="startthree" style="display:none;">
<button onclick=vbs:mysqlecute><strong>软件查找,自定义sql语句执行</strong></button>
</div>
<a href=# onclick="ShowHideLayer('startthree')" >软件查找工作</a> </br>
<a href=# onclick=vbs:showHelp >软件使用说明</a> </br>
<br><br><br><br><br><br><br>
<div style="position: absolute; top: 30px; left: 3px" id="q00">
<div style="position: absolute; top: 30px; left: 3px; width: 3; height: 2; z-index: 4" id="q2">
<p style="font-size:44pt"><font color="#FFFFff">○</p>
</div>
<div style="position: absolute; top: -10px; left: 0px; width: 3; height: 2; z-index: 5" id="q3">
<p style="font-size:42pt"><font color="#FFFFff">○</p>
</div>
<div style="position: absolute; top: 17; left: 2px; width: 6; height: 2; z-index: 1" id="q4">
<p style="font-size:32pt"><font color="#FF0000">■</p>
</div>
</div></div>
</center>
<SCRIPT language=vbs>
on error resume next
window.resizeTo window.screen.availWidth/1.5,window.screen.availHeight/1.5
window.moveTo window.screen.availWidth/4,window.screen.availHeight/4
'------------------------------------------自定义建数据库表模块开始---------------------------------------------------------------
set fso=CreateObject("Scripting.FileSystemObject")
Set objConnection = CreateObject("ADODB.Connection")
Set objRecordSet = CreateObject("ADODB.Recordset")
set cn=CreateObject("ADODB.Connection")
set clx=CreateObject("ADOX.Column")
set cat=CreateObject("ADOX.Catalog")
set tblnam=CreateObject("ADOX.Table")
sub addinput
For i=1 to 6
set input = document.createElement("input")
input.value="分类名"&i
baobao.appendChild(input)
next
end sub
sub delinput
set input=document.getElementsByTagName("input")
if(input.length > 0)then baobao.removeChild(input(input.length - 1))
end sub
sub countall
adColNullable = 2
path=document.location.href
path=replace(path,"file:///","")
path=replace(path,"%20"," ")
path=replace(path,"#","")
if fso.FileExists(path&".mdb") Then
msgbox "数据库已存在，请删掉"
End if
cat.Create "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="&path&".mdb"
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="&path&".mdb"
Set cat.ActiveConnection = cn
tblnam.Name = "Test"
clx.ParentCatalog = cat
clx.Type = 3
clx.Name = "Id"
clx.Properties("AutoIncrement") = true
tblnam.Columns.Append clx
for i=0 to document.all.tags("input").length -1
tblnam.Columns.Append document.all.tags("input").item(i).value,202,255
tblnam.Columns(document.all.tags("input").item(i).value).Attributes = adColNullable
next
tblnam.Columns.Append "demo",202,255
tblnam.Columns("demo").Attributes = adColNullable
cat.Tables.Append tblnam
cat.Tables.Refresh
if fso.FileExists(path&".mdb") Then
msgbox "数据库已建好，可以下一步了"
End if
Set clx = Nothing
Set cat = Nothing
Set fso = Nothing
cn.Close
Set cn = Nothing
End Sub
'------------------------------------------自定义建数据库表模块结束-------------------------------------------------------
'-------------------------------------工具整理模块第一步----------------------------------------
on error resume next
Dim keyWord, DirTotal, TimeSpend, FileTotal, Fso, outFile, txtResult, txtPath, sPath
Const MY_COMPUTER = &H11&
Const WINDOW_HANDLE = 0
Const OPTIONS = 0
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(My_Computer)
Set objFolderItem = objFolder.Self
strPath = objFolderItem.Path
Function myFind(ByVal thePath)
Dim fso, myFolder, myFile, curFolder
Set fso = CreateObject("scripting.filesystemobject")
Set curFolders = fso.getfolder(thePath)
DirTotal = DirTotal + 1
If curFolders.Files.Count > 0 Then
For Each myFile In curFolders.Files
If InStr(1, LCase(myFile.Name), keyWord) > 0 Then
outFile.WriteLine FormatPath(thePath) & "\" & myFile.Name
FileTotal = FileTotal + 1
End If
Next
End If
If curFolders.subfolders.Count > 0 Then
For Each myFolder In curFolders.subfolders
myFind FormatPath(thePath) & "\" & myFolder.Name
Next
End If
End Function
Function FormatPath(ByVal thePath)
thePath = Trim(thePath)
FormatPath = thePath
If Right(thePath, 1) = "\" Then FormatPath = Mid(thePath, 1, Len(thePath) - 1)
End Function
SUB startwo
Set objFolder = objShell.BrowseForFolder(WINDOW_HANDLE, "选择你要搜索的文件夹，文件夹不宜过大超过几G哪样:", OPTIONS, strPath)
If objFolder Is Nothing Then
msgbox "您没有选择任何有效目录!"
else
Set objFolderItem = objFolder.Self
sPath = objFolderItem.Path
txtpath=sPath
Set Fso = CreateObject("scripting.filesystemobject")
FileTotal = 0
DirTotal = 0
keyWord = LCase(inputbox("请输入要整理的文件后缀:","文件搜索",".exe或.bat或.php,一般就这些，至于.dll手工添加吧"))
set outFile = Fso.createtextfile(sPath & "\SearchResult.txt")
TimeSpend = Timer
myFind txtPath
TimeSpend = round(Timer - TimeSpend,2)
txtResult = "搜索完成!" & vbCrLf & "共找到文件:" & FileTotal & "个." & vbCrLf & "共搜索目录:" & DirTotal & "个." & vbCrLf & "用时:" & TimeSpend & "秒."
msgbox txtResult &"结果保存在"&sPath &"\SearchResult.txt"
outFile.close
set outFile = nothing
set Fso = nothing
End if
END SUB
'-------------------------------------工具整理模块第一步结束----------------------------------------
'----------------------------------------工具整理模块第二步开始--------------------------------------------------
path=document.location.href
path=replace(path,"file:///","")
path=replace(path,"%20"," ")
path=replace(path,"#","")
dbname=path&".mdb"
'msgbox dbname
Function showColumn(mdb)
DBDriver = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
Set objConn = CreateObject("ADODB.Connection")
objConn.ConnectionString = DBDriver & mdb
objConn.Open
Set objTableRS = objConn.OpenSchema(20,Array(Empty, Empty, Empty, "TABLE"))
Set objColumnRS = objConn.OpenSchema(4,Array(Empty, Empty, objTableRS("Table_Name").Value))
While Not objColumnRS.EOF
Columns=Columns&(objColumnRS("Column_Name"))&"|"
objColumnRS.MoveNext
Wend
showColumn=Columns
end Function
SUB showpath
Exeurl = InputBox( "请输入刚才生成的SearchResult.txt地址：", "输入", "SearchResult.txt" )
'seletclist= split(replace(showColumn(dbname),"Id|",""),"|")
seletclist= replace(showColumn(dbname),"Id|","")
seletclist=replace(seletclist,"demo|","")
seletclist=split(seletclist,"|")
sSelect="<select id='select'>"
for i=0 to UBound(seletclist)-1
sSelect=sSelect&"<option value="&seletclist(i)&">"&seletclist(i)&"</option>"
next
sSelect=sSelect & "</select>"
aList=Split(LoadFile(Exeurl), vbCrLf)
sHTML = "<table width='100%' border='1' cellspacing='0' cellpadding='0'>"
for i=0 to UBound(aList)-1
sHTML = sHTML & "<tr><td>"
sHTML = sHTML & aList(i)&"<input type=checkbox name=checkBox"&i& " value="&aList(i)&"> 分类"&sSelect&"工具说明：<textarea rows=1 cols=20 name=demo"&i&"></textarea>"
sHTML = sHTML & "<br /></td></tr>"
Next
sHTML = sHTML & "</table><br /><button onclick='javascript:SelectByPreName(""checkBox"");' /><strong>全选</strong></button><button onclick='javascript:DoAction();' /><strong>写入数据库</strong></button>"
Document.getElementById("DivList").innerHTML = sHTML
end sub
Function LoadFile(ByVal File)
Dim objStream
On Error Resume Next
Set objStream = CreateObject("ADODB.Stream")
If Err.Number=-2147221005 Then
msgbox "<div align='center'>非常遗憾,您的主机不支持ADODB.Stream,不能使用本程序</div>"
Err.Clear
End If
With objStream
.Type = 2
.Mode = 3
.Open
.LoadFromFile File
.Charset = "GB2312" '可以根据需求，把这里的编码修改成utf-8等编码格式
.Position = 2
.LineSeparator=13
LoadFile = .ReadText
.Close
End With
Set objStream = Nothing
End Function
</SCRIPT>
<script language=javascript>
function DoAction()
{
var conn = new ActiveXObject("ADODB.Connection");
conn.Open("DBQ="+window.location.pathname + '.mdb'+";DRIVER={Microsoft Access Driver (*.mdb)};");
var rs = new ActiveXObject("ADODB.Recordset");
var I, O, Memo;
O = document.getElementsByTagName('select');
I = 0;
while(true)
{
O[I];
if(!O[I]) break;
if(document.getElementsByName('checkBox' + I)[0].checked)
{
Memo = document.getElementsByName('demo' + I)[0];
input= document.getElementsByName('checkBox' + I)[0]
// alert(input.value+'\r\n'+O[I].value + '\r\n' + Memo.value+'\r\n'); 换成数据库操作
sql="INSERT INTO test ("+O[I].value+",demo) VALUES ("+"'"+input.value+"'"+","+"'"+Memo.value+"'"+")";
//alert(sql);
rs.open(sql, conn);
//rs.close();
//rs = null;
//conn.close();
//conn = null;
}
I++;
}
alert("写入成功，你可以再操作别的目录了");
}
function SelectByPreName(sPreName)
{
var O;
O = document.getElementsByTagName('input');
for(var i = 0; i < O.length; i++)
{
if(O[i].name.indexOf(sPreName) == 0)
O[i].checked = !O[i].checked;
}
}
//---------------------------------------------------------工具整理模块第二步结束------------------------------------------
</script>
<SCRIPT Language="VBScript">
'=============================================================软件查找模块开始
Sub mysqlecute
path=document.location.href
path=replace(path,"file:///","")
path=replace(path,"%20"," ")
path=replace(path,"#","")
dbname=path&".mdb"
set fso=createobject("scripting.filesystemobject")
if fso.FileExists(path&".mdb") then
DBDriver = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
Set objConn = CreateObject("ADODB.Connection")
objConn.ConnectionString = DBDriver & dbname
objConn.Open
Set objTableRS = objConn.OpenSchema(20,Array(Empty, Empty, Empty, "TABLE"))
Set objColumnRS = objConn.OpenSchema(4,Array(Empty, Empty, objTableRS("Table_Name").Value))
Do While Not objTableRS.EOF
Document.write "表名--------------->"&objTableRS("Table_Name").Value&"</br>"
objTableRS.MoveNext
Loop
While Not objColumnRS.EOF
Columns=Columns&(objColumnRS("Column_Name"))&"|"
objColumnRS.MoveNext
Wend
showColumnss=Columns
seletclist= split(showColumnss,"|")
Document.write "字段名<-->"
for i=0 to UBound(seletclist)-1
Document.write "★" &seletclist(i)
next
Document.write "</br>"
document.write("<style>" & vbNewLine)
document.write("body " & vbNewLine)
document.write("{" & vbNewLine)
document.write(" font-size:12;" & vbNewLine)
document.write(" BACKGROUND: #DADADA;" & vbNewLine)
document.write(" margin-left:5;" & vbNewLine)
'document.write(" overflow:visible;" & vbNewLine)
document.write("}" & vbNewLine)
document.write("<" & Chr(47) & "style>" & vbNewLine)
document.write("<table width=""100%"" border=""1"" cellspacing=""0"" cellpadding=""1"" bordercolorlight=""#000000"" bordercolordark=""#FFFFFF"">" & vbNewLine)
document.write(" <tr align=""center"" valign=""top"">" & vbNewLine)
mysql=InputBox( "请输入sql语句：", "输入", "select * from test where id<50" )
Set objRS=objConn.Execute(mysql)
if objrs.state = 1 then
For i=0 to objRs.Fields.Count-1
document.write "<td>" & objRS.Fields(i).name&"</td>"
Next
Document.write "</tr>"
End If
document.write(" <tr align=""center"" valign=""top"">" & vbNewLine)
DO While NOT objRS.Eof
For i=0 to objRs.Fields.Count-1
If IsNull(objRs.Fields(i).value) or objRs.Fields(i).value="" or objRs.Fields(i).value=" " then
document.write "<td> </td>"
Else
If InstrRev(objRs.Fields(i).value ,"\", -1, 0)<>0 Then
url=split(objRs.Fields(i).value,"\")
urllian=left(objRs.Fields(i).value,len(objRs.Fields(i).value)-len(url(UBound(url)))-1 )
document.write "<td>" &objRs.Fields(i).value&"<a href="&urllian&">打开目录</a></td>"
Else
document.write "<td>" &objRs.Fields(i).value&"</td>"
End if
end if
Next
document.write"</tr>"
objRS.MoveNext
j=j+1
Loop
set objRs = nothing
set objTableRS = nothing
objConn.Close
set objConn = nothing
document.write("<" & Chr(47) & "table>" & vbNewLine)
else
MsgBox "数据库不存在，请copy到同文件夹"
End if
End Sub
'=============================================================软件查找模块结束
sub showHelp
dim msg
msg = " 软件管理工具0.1【IE7.0测试通过】" & vbcrlf
msg = msg & "------------------------------------------------" & vbcrlf
msg = msg & "程序初始化是建立与本文件同名后缀为mdb的数据库" & vbcrlf
msg = msg & "自定义分类，是归档文件，好比你可以把你的工具分为渗透、溢出、网马、浏览之类的，可无限建分类" & vbcrlf
msg = msg & "建好分类后，你可以进行第二步，根据你需要的后缀来进行分类，不建议将dll文件也分类，只把exe和webshell之类进行收集吧" & vbcrlf
msg = msg & "第二步查找结束后，可以选择程序建立的SearchResult.txt，根据提示构选要存到哪一个分类，自动存进数据库" & vbcrlf
msg = msg & "第三步当然是进行查找了，根据自定义sql语句查找你的工具" & vbcrlf
msg = msg & "程序只是个雏形，可以提供建议，有时间再修正bug，进行软件升级" & vbcrlf
msgbox msg
end sub
</script>
<script language=javascript>
//显示和隐藏层
function ShowHideLayer(ID)
{
var O = document.getElementById(ID);
if(O)
{
if(O.style.display == '')
O.style.display = 'none';
else
O.style.display = '';
}
}
</script>
</BODY>
</HTML>
因为直接的代码容易出问题，所以特打包提供下载
下载地址:http://xiazai.jb51.net/200905/other/tools_hta.rar
建好分类后，你可以进行第二步，根据你需要的后缀来进行分类，不建议将dll文件也分类，只把exe和webshell之类进行收集吧
第二步查找结束后，可以选择程序建立的SearchResult.txt，根据提示构选要存到哪一个分类，自动存进数据库
第三步当然是进行查找了，根据自定义sql语句查找你的工具
程序只是个雏形，可以提供建议，有时间再修正bug，进行软件升级
复制代码 代码如下:
<HTML>
<HEAD>
<HTA:Application ID="oHTA"
Applicationname="myApp"
border="thin"
borderstyle="normal"
caption="yes"
maximizebutton="yes"
minimizebutton="yes"
showintaskbar="no"
singleinstance="no"
sysmenu="yes"
version="1.0"
windowstate="normal"
scroll="yes">
<TITLE>工具归类软件v0.1 code by lcx myweb:http://www.haiyangtop.net</TITLE>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
</head>
<style>
body
{
font-size:12;
BACKGROUND: #DADADA;
margin-left:5;
}
input
{
width:40;
overflow:visible;
border:1px solid lightblue;
background-color:#cccccc;
cursor:text;
}
button
{
border:1px solid gray;
width:260;
margin-left:2;
cursor:hand;
font-size:12;
filter:progid:DXImageTransform.Microsoft.Gradient(startColorStr='#eaeaff', endColorStr='#618fff', gradientType='0');
}
textarea
{
font-family:Verdana;
font-size:12px;
overflow-x:visible;
overflow-y:scroll;
}
</style>
<body>
<center>
<br><br><br><br><br><br><br>
<div id="DivList"></div>
<div id="start" style="display:none;">
<div id=baobao>自定义数据库字段，也就是软件分类工作</div>
<button onclick=vbs:addinput><strong>设定字段名+</strong></button>
<button onclick=vbs:delinput><strong>减少字段名-</strong></button>
<button onclick=vbs:countall><strong>建立数据库</strong></button>
</div>
<a href=# onclick="ShowHideLayer('start')" >程序初始化</a> </br>
<div id="starttwo" style="display:none;overflow:scroll">
<button onclick=vbs:startwo><strong>工具整理第一步</strong></button>
<button onclick=vbs:showpath><strong>工具整理第二步，列表选择写入数据库</strong></button>
</div>
<a href=# onclick="ShowHideLayer('starttwo')" >软件整理工作</a> </br>
<div id="startthree" style="display:none;">
<button onclick=vbs:mysqlecute><strong>软件查找,自定义sql语句执行</strong></button>
</div>
<a href=# onclick="ShowHideLayer('startthree')" >软件查找工作</a> </br>
<a href=# onclick=vbs:showHelp >软件使用说明</a> </br>
<br><br><br><br><br><br><br>
<div style="position: absolute; top: 30px; left: 3px" id="q00">
<div style="position: absolute; top: 30px; left: 3px; width: 3; height: 2; z-index: 4" id="q2">
<p style="font-size:44pt"><font color="#FFFFff">○</p>
</div>
<div style="position: absolute; top: -10px; left: 0px; width: 3; height: 2; z-index: 5" id="q3">
<p style="font-size:42pt"><font color="#FFFFff">○</p>
</div>
<div style="position: absolute; top: 17; left: 2px; width: 6; height: 2; z-index: 1" id="q4">
<p style="font-size:32pt"><font color="#FF0000">■</p>
</div>
</div></div>
</center>
<SCRIPT language=vbs>
on error resume next
window.resizeTo window.screen.availWidth/1.5,window.screen.availHeight/1.5
window.moveTo window.screen.availWidth/4,window.screen.availHeight/4
'------------------------------------------自定义建数据库表模块开始---------------------------------------------------------------
set fso=CreateObject("Scripting.FileSystemObject")
Set objConnection = CreateObject("ADODB.Connection")
Set objRecordSet = CreateObject("ADODB.Recordset")
set cn=CreateObject("ADODB.Connection")
set clx=CreateObject("ADOX.Column")
set cat=CreateObject("ADOX.Catalog")
set tblnam=CreateObject("ADOX.Table")
sub addinput
For i=1 to 6
set input = document.createElement("input")
input.value="分类名"&i
baobao.appendChild(input)
next
end sub
sub delinput
set input=document.getElementsByTagName("input")
if(input.length > 0)then baobao.removeChild(input(input.length - 1))
end sub
sub countall
adColNullable = 2
path=document.location.href
path=replace(path,"file:///","")
path=replace(path,"%20"," ")
path=replace(path,"#","")
if fso.FileExists(path&".mdb") Then
msgbox "数据库已存在，请删掉"
End if
cat.Create "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="&path&".mdb"
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="&path&".mdb"
Set cat.ActiveConnection = cn
tblnam.Name = "Test"
clx.ParentCatalog = cat
clx.Type = 3
clx.Name = "Id"
clx.Properties("AutoIncrement") = true
tblnam.Columns.Append clx
for i=0 to document.all.tags("input").length -1
tblnam.Columns.Append document.all.tags("input").item(i).value,202,255
tblnam.Columns(document.all.tags("input").item(i).value).Attributes = adColNullable
next
tblnam.Columns.Append "demo",202,255
tblnam.Columns("demo").Attributes = adColNullable
cat.Tables.Append tblnam
cat.Tables.Refresh
if fso.FileExists(path&".mdb") Then
msgbox "数据库已建好，可以下一步了"
End if
Set clx = Nothing
Set cat = Nothing
Set fso = Nothing
cn.Close
Set cn = Nothing
End Sub
'------------------------------------------自定义建数据库表模块结束-------------------------------------------------------
'-------------------------------------工具整理模块第一步----------------------------------------
on error resume next
Dim keyWord, DirTotal, TimeSpend, FileTotal, Fso, outFile, txtResult, txtPath, sPath
Const MY_COMPUTER = &H11&
Const WINDOW_HANDLE = 0
Const OPTIONS = 0
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(My_Computer)
Set objFolderItem = objFolder.Self
strPath = objFolderItem.Path
Function myFind(ByVal thePath)
Dim fso, myFolder, myFile, curFolder
Set fso = CreateObject("scripting.filesystemobject")
Set curFolders = fso.getfolder(thePath)
DirTotal = DirTotal + 1
If curFolders.Files.Count > 0 Then
For Each myFile In curFolders.Files
If InStr(1, LCase(myFile.Name), keyWord) > 0 Then
outFile.WriteLine FormatPath(thePath) & "\" & myFile.Name
FileTotal = FileTotal + 1
End If
Next
End If
If curFolders.subfolders.Count > 0 Then
For Each myFolder In curFolders.subfolders
myFind FormatPath(thePath) & "\" & myFolder.Name
Next
End If
End Function
Function FormatPath(ByVal thePath)
thePath = Trim(thePath)
FormatPath = thePath
If Right(thePath, 1) = "\" Then FormatPath = Mid(thePath, 1, Len(thePath) - 1)
End Function
SUB startwo
Set objFolder = objShell.BrowseForFolder(WINDOW_HANDLE, "选择你要搜索的文件夹，文件夹不宜过大超过几G哪样:", OPTIONS, strPath)
If objFolder Is Nothing Then
msgbox "您没有选择任何有效目录!"
else
Set objFolderItem = objFolder.Self
sPath = objFolderItem.Path
txtpath=sPath
Set Fso = CreateObject("scripting.filesystemobject")
FileTotal = 0
DirTotal = 0
keyWord = LCase(inputbox("请输入要整理的文件后缀:","文件搜索",".exe或.bat或.php,一般就这些，至于.dll手工添加吧"))
set outFile = Fso.createtextfile(sPath & "\SearchResult.txt")
TimeSpend = Timer
myFind txtPath
TimeSpend = round(Timer - TimeSpend,2)
txtResult = "搜索完成!" & vbCrLf & "共找到文件:" & FileTotal & "个." & vbCrLf & "共搜索目录:" & DirTotal & "个." & vbCrLf & "用时:" & TimeSpend & "秒."
msgbox txtResult &"结果保存在"&sPath &"\SearchResult.txt"
outFile.close
set outFile = nothing
set Fso = nothing
End if
END SUB
'-------------------------------------工具整理模块第一步结束----------------------------------------
'----------------------------------------工具整理模块第二步开始--------------------------------------------------
path=document.location.href
path=replace(path,"file:///","")
path=replace(path,"%20"," ")
path=replace(path,"#","")
dbname=path&".mdb"
'msgbox dbname
Function showColumn(mdb)
DBDriver = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
Set objConn = CreateObject("ADODB.Connection")
objConn.ConnectionString = DBDriver & mdb
objConn.Open
Set objTableRS = objConn.OpenSchema(20,Array(Empty, Empty, Empty, "TABLE"))
Set objColumnRS = objConn.OpenSchema(4,Array(Empty, Empty, objTableRS("Table_Name").Value))
While Not objColumnRS.EOF
Columns=Columns&(objColumnRS("Column_Name"))&"|"
objColumnRS.MoveNext
Wend
showColumn=Columns
end Function
SUB showpath
Exeurl = InputBox( "请输入刚才生成的SearchResult.txt地址：", "输入", "SearchResult.txt" )
'seletclist= split(replace(showColumn(dbname),"Id|",""),"|")
seletclist= replace(showColumn(dbname),"Id|","")
seletclist=replace(seletclist,"demo|","")
seletclist=split(seletclist,"|")
sSelect="<select id='select'>"
for i=0 to UBound(seletclist)-1
sSelect=sSelect&"<option value="&seletclist(i)&">"&seletclist(i)&"</option>"
next
sSelect=sSelect & "</select>"
aList=Split(LoadFile(Exeurl), vbCrLf)
sHTML = "<table width='100%' border='1' cellspacing='0' cellpadding='0'>"
for i=0 to UBound(aList)-1
sHTML = sHTML & "<tr><td>"
sHTML = sHTML & aList(i)&"<input type=checkbox name=checkBox"&i& " value="&aList(i)&"> 分类"&sSelect&"工具说明：<textarea rows=1 cols=20 name=demo"&i&"></textarea>"
sHTML = sHTML & "<br /></td></tr>"
Next
sHTML = sHTML & "</table><br /><button onclick='javascript:SelectByPreName(""checkBox"");' /><strong>全选</strong></button><button onclick='javascript:DoAction();' /><strong>写入数据库</strong></button>"
Document.getElementById("DivList").innerHTML = sHTML
end sub
Function LoadFile(ByVal File)
Dim objStream
On Error Resume Next
Set objStream = CreateObject("ADODB.Stream")
If Err.Number=-2147221005 Then
msgbox "<div align='center'>非常遗憾,您的主机不支持ADODB.Stream,不能使用本程序</div>"
Err.Clear
End If
With objStream
.Type = 2
.Mode = 3
.Open
.LoadFromFile File
.Charset = "GB2312" '可以根据需求，把这里的编码修改成utf-8等编码格式
.Position = 2
.LineSeparator=13
LoadFile = .ReadText
.Close
End With
Set objStream = Nothing
End Function
</SCRIPT>
<script language=javascript>
function DoAction()
{
var conn = new ActiveXObject("ADODB.Connection");
conn.Open("DBQ="+window.location.pathname + '.mdb'+";DRIVER={Microsoft Access Driver (*.mdb)};");
var rs = new ActiveXObject("ADODB.Recordset");
var I, O, Memo;
O = document.getElementsByTagName('select');
I = 0;
while(true)
{
O[I];
if(!O[I]) break;
if(document.getElementsByName('checkBox' + I)[0].checked)
{
Memo = document.getElementsByName('demo' + I)[0];
input= document.getElementsByName('checkBox' + I)[0]
// alert(input.value+'\r\n'+O[I].value + '\r\n' + Memo.value+'\r\n'); 换成数据库操作
sql="INSERT INTO test ("+O[I].value+",demo) VALUES ("+"'"+input.value+"'"+","+"'"+Memo.value+"'"+")";
//alert(sql);
rs.open(sql, conn);
//rs.close();
//rs = null;
//conn.close();
//conn = null;
}
I++;
}
alert("写入成功，你可以再操作别的目录了");
}
function SelectByPreName(sPreName)
{
var O;
O = document.getElementsByTagName('input');
for(var i = 0; i < O.length; i++)
{
if(O[i].name.indexOf(sPreName) == 0)
O[i].checked = !O[i].checked;
}
}
//---------------------------------------------------------工具整理模块第二步结束------------------------------------------
</script>
<SCRIPT Language="VBScript">
'=============================================================软件查找模块开始
Sub mysqlecute
path=document.location.href
path=replace(path,"file:///","")
path=replace(path,"%20"," ")
path=replace(path,"#","")
dbname=path&".mdb"
set fso=createobject("scripting.filesystemobject")
if fso.FileExists(path&".mdb") then
DBDriver = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
Set objConn = CreateObject("ADODB.Connection")
objConn.ConnectionString = DBDriver & dbname
objConn.Open
Set objTableRS = objConn.OpenSchema(20,Array(Empty, Empty, Empty, "TABLE"))
Set objColumnRS = objConn.OpenSchema(4,Array(Empty, Empty, objTableRS("Table_Name").Value))
Do While Not objTableRS.EOF
Document.write "表名--------------->"&objTableRS("Table_Name").Value&"</br>"
objTableRS.MoveNext
Loop
While Not objColumnRS.EOF
Columns=Columns&(objColumnRS("Column_Name"))&"|"
objColumnRS.MoveNext
Wend
showColumnss=Columns
seletclist= split(showColumnss,"|")
Document.write "字段名<-->"
for i=0 to UBound(seletclist)-1
Document.write "★" &seletclist(i)
next
Document.write "</br>"
document.write("<style>" & vbNewLine)
document.write("body " & vbNewLine)
document.write("{" & vbNewLine)
document.write(" font-size:12;" & vbNewLine)
document.write(" BACKGROUND: #DADADA;" & vbNewLine)
document.write(" margin-left:5;" & vbNewLine)
'document.write(" overflow:visible;" & vbNewLine)
document.write("}" & vbNewLine)
document.write("<" & Chr(47) & "style>" & vbNewLine)
document.write("<table width=""100%"" border=""1"" cellspacing=""0"" cellpadding=""1"" bordercolorlight=""#000000"" bordercolordark=""#FFFFFF"">" & vbNewLine)
document.write(" <tr align=""center"" valign=""top"">" & vbNewLine)
mysql=InputBox( "请输入sql语句：", "输入", "select * from test where id<50" )
Set objRS=objConn.Execute(mysql)
if objrs.state = 1 then
For i=0 to objRs.Fields.Count-1
document.write "<td>" & objRS.Fields(i).name&"</td>"
Next
Document.write "</tr>"
End If
document.write(" <tr align=""center"" valign=""top"">" & vbNewLine)
DO While NOT objRS.Eof
For i=0 to objRs.Fields.Count-1
If IsNull(objRs.Fields(i).value) or objRs.Fields(i).value="" or objRs.Fields(i).value=" " then
document.write "<td> </td>"
Else
If InstrRev(objRs.Fields(i).value ,"\", -1, 0)<>0 Then
url=split(objRs.Fields(i).value,"\")
urllian=left(objRs.Fields(i).value,len(objRs.Fields(i).value)-len(url(UBound(url)))-1 )
document.write "<td>" &objRs.Fields(i).value&"<a href="&urllian&">打开目录</a></td>"
Else
document.write "<td>" &objRs.Fields(i).value&"</td>"
End if
end if
Next
document.write"</tr>"
objRS.MoveNext
j=j+1
Loop
set objRs = nothing
set objTableRS = nothing
objConn.Close
set objConn = nothing
document.write("<" & Chr(47) & "table>" & vbNewLine)
else
MsgBox "数据库不存在，请copy到同文件夹"
End if
End Sub
'=============================================================软件查找模块结束
sub showHelp
dim msg
msg = " 软件管理工具0.1【IE7.0测试通过】" & vbcrlf
msg = msg & "------------------------------------------------" & vbcrlf
msg = msg & "程序初始化是建立与本文件同名后缀为mdb的数据库" & vbcrlf
msg = msg & "自定义分类，是归档文件，好比你可以把你的工具分为渗透、溢出、网马、浏览之类的，可无限建分类" & vbcrlf
msg = msg & "建好分类后，你可以进行第二步，根据你需要的后缀来进行分类，不建议将dll文件也分类，只把exe和webshell之类进行收集吧" & vbcrlf
msg = msg & "第二步查找结束后，可以选择程序建立的SearchResult.txt，根据提示构选要存到哪一个分类，自动存进数据库" & vbcrlf
msg = msg & "第三步当然是进行查找了，根据自定义sql语句查找你的工具" & vbcrlf
msg = msg & "程序只是个雏形，可以提供建议，有时间再修正bug，进行软件升级" & vbcrlf
msgbox msg
end sub
</script>
<script language=javascript>
//显示和隐藏层
function ShowHideLayer(ID)
{
var O = document.getElementById(ID);
if(O)
{
if(O.style.display == '')
O.style.display = 'none';
else
O.style.display = '';
}
}
</script>
</BODY>
</HTML>
因为直接的代码容易出问题，所以特打包提供下载
下载地址:http://xiazai.jb51.net/200905/other/tools_hta.rar
下一篇：学习正则帮手笨狼正则练习器