hta编写的软件管理工具0.1(IE7.0测试通过)

148 阅读 0 评论 98 点赞

我是靠谱客的博主虚心向日葵，最近开发中收集的这篇文章主要介绍hta编写的软件管理工具0.1(IE7.0测试通过)，觉得挺不错的，现在分享给大家，希望可以做个参考。

概述

自定义分类，是归档文件，好比你可以把你的工具分为渗透、溢出、网马、浏览之类的，可无限建分类
建好分类后，你可以进行第二步，根据你需要的后缀来进行分类，不建议将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> 