作者：lcx
先放这吧，以后再改，将以下代码存为hta，：-）
<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>免责声明:文章中涉及的程序(方法)可能带有攻击性，仅供安全研究与教学之用，读者将其信息做其他用途，由读者承担全部法律及连带责任，本站不承担任何法律及连带责任；如有问题可邮件联系(建议使用企业邮箱或有效邮箱,避免邮件被拦截，联系方式见首页)，望知悉。
- 左青龙
- 微信扫一扫
-
- 右白虎
- 微信扫一扫
-
评论