程序初始化是建立与本文件同名后缀为mdb的数据库
自定义分类,是归档文件,好比你可以把你的工具分为渗透、溢出、网马、浏览之类的,可无限建分类
建好分类后,你可以进行第二步,根据你需要的后缀来进行分类,不建议将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+'rn'+O[I].value + 'rn' + Memo.value+'rn'); 换成数据库操作
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" & 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.lovean.com/200905/other/tools_hta.rar
最新资讯
特斯拉已与杰夫·达恩的电池研究实验室续签5年合同

特斯拉已与杰夫·达恩

1月19日消息,据国外媒体报道,特斯拉已经与杰夫·达恩(Jef
微信视频号公布运营规则 周五晚上为流量高峰期

微信视频号公布运营规

在今天举行的2021微信公开课PRO上,刚满一周岁的视频号
微信小游戏月活用户超5亿 单品月流水超20亿元

微信小游戏月活用户超

今日在2021微信公开课上,微信公开课讲师Togo透露,2020年
恒生科技指数涨4%港交所市值达6500亿港元 快手最快1月26日招股

恒生科技指数涨4%港交

周二港股,恒生科技指数飙升3%,报9399.850点,创下指数历史
互联网存款业务遭整顿 部分平台已主动“下线”相关产品

互联网存款业务遭整顿

近日,央行、银保监会联合发布《关于规范商业银行通过互
优衣库将启动应用支付功能Uniqlo Pay 母公司迅销集团开发

优衣库将启动应用支付

优衣库的运营商,日(J)本(P)时尚巨头迅销集团(Fast Retailing)将
最新文章
HTA编辑HOST文件的脚本

HTA编辑HOST文件的脚

一个修改HOST文件的小工具,利用FSO实现,代码比较长,功能
学习正则帮手笨狼正则练习器

学习正则帮手笨狼正则

把下面的文件保存为hta文件,运行即可
hta实现的笨狼XSLT练习器

hta实现的笨狼XSLT练

学习XSLT的朋友,用这个小工具不错
hta实现的定时关机小程序

hta实现的定时关机小

这个小程序使用hta写的,用了vbscript代码实现,喜欢的朋
用来通知论坛有新贴子的hta代码

用来通知论坛有新贴子

做了个用来通知论坛有新贴子的hta把下面的代码copy到
用vbs如何确定在 HTA 中选择了哪些文本?

用vbs如何确定在 HTA

问:您好,脚本专家!如何确定在HTA中选择了哪些文本?--DO答: