hta編寫(xiě)的軟件管理工具0.1(IE7.0測(cè)試通過(guò))
來(lái)源:易賢網(wǎng) 閱讀:1699 次 日期:2014-08-12 17:19:11
溫馨提示:易賢網(wǎng)小編為您整理了“hta編寫(xiě)的軟件管理工具0.1(IE7.0測(cè)試通過(guò))”,方便廣大網(wǎng)友查閱!

定義分類(lèi),是歸檔文件,好比你可以把你的工具分為滲透、溢出、網(wǎng)馬、瀏覽之類(lèi)的,可無(wú)限建分類(lèi)

建好分類(lèi)后,你可以進(jìn)行第二步,根據(jù)你需要的后綴來(lái)進(jìn)行分類(lèi),不建議將dll文件也分類(lèi),只把exe和webshell之類(lèi)進(jìn)行收集吧

第二步查找結(jié)束后,可以選擇程序建立的SearchResult.txt,根據(jù)提示構(gòu)選要存到哪一個(gè)分類(lèi),自動(dòng)存進(jìn)數(shù)據(jù)庫(kù)

第三步當(dāng)然是進(jìn)行查找了,根據(jù)自定義sql語(yǔ)句查找你的工具

程序只是個(gè)雛形,可以提供建議,有時(shí)間再修正bug,進(jìn)行軟件升級(jí)

代碼如下:

<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>工具歸類(lèi)軟件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>自定義數(shù)據(jù)庫(kù)字段,也就是軟件分類(lèi)工作</div>

<button onclick=vbs:addinput><strong>設(shè)定字段名+</strong></button>

<button onclick=vbs:delinput><strong>減少字段名-</strong></button>

<button onclick=vbs:countall><strong>建立數(shù)據(jù)庫(kù)</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>工具整理第二步,列表選擇寫(xiě)入數(shù)據(jù)庫(kù)</strong></button>

</div>

<a href=# onclick="ShowHideLayer('starttwo')" >軟件整理工作</a> </br>

<div id="startthree" style="display:none;">

<button onclick=vbs:mysqlecute><strong>軟件查找,自定義sql語(yǔ)句執(zhí)行</strong></button>

</div>

<a href=# onclick="ShowHideLayer('startthree')" >軟件查找工作</a> </br>

<a href=# onclick=vbs:showHelp >軟件使用說(shuō)明</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

'------------------------------------------自定義建數(shù)據(jù)庫(kù)表模塊開(kāi)始---------------------------------------------------------------

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="分類(lèi)名"&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 "數(shù)據(jù)庫(kù)已存在,請(qǐng)刪掉"

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 "數(shù)據(jù)庫(kù)已建好,可以下一步了"

End if

Set clx = Nothing

Set cat = Nothing

Set fso = Nothing

cn.Close

Set cn = Nothing

End Sub

'------------------------------------------自定義建數(shù)據(jù)庫(kù)表模塊結(jié)束-------------------------------------------------------

'-------------------------------------工具整理模塊第一步----------------------------------------

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, "選擇你要搜索的文件夾,文件夾不宜過(guò)大超過(guò)幾G哪樣:", OPTIONS, strPath)

If objFolder Is Nothing Then

msgbox "您沒(méi)有選擇任何有效目錄!"

else

Set objFolderItem = objFolder.Self

sPath = objFolderItem.Path

txtpath=sPath

Set Fso = CreateObject("scripting.filesystemobject")

FileTotal = 0

DirTotal = 0

keyWord = LCase(inputbox("請(qǐng)輸入要整理的文件后綴:","文件搜索",".exe或.bat或.php,一般就這些,至于.dll手工添加吧"))

set outFile = Fso.createtextfile(sPath & "\SearchResult.txt")

TimeSpend = Timer

myFind txtPath

TimeSpend = round(Timer - TimeSpend,2)

txtResult = "搜索完成!" & vbCrLf & "共找到文件:" & FileTotal & "個(gè)." & vbCrLf & "共搜索目錄:" & DirTotal & "個(gè)." & vbCrLf & "用時(shí):" & TimeSpend & "秒."

msgbox txtResult &"結(jié)果保存在"&sPath &"\SearchResult.txt"

outFile.close

set outFile = nothing

set Fso = nothing

End if

END SUB

'-------------------------------------工具整理模塊第一步結(jié)束----------------------------------------

'----------------------------------------工具整理模塊第二步開(kāi)始--------------------------------------------------

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( "請(qǐng)輸入剛才生成的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)&"> 分類(lèi)"&sSelect&"工具說(shuō)明:<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>寫(xiě)入數(shù)據(jù)庫(kù)</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'>非常遺憾,您的主機(jī)不支持ADODB.Stream,不能使用本程序</div>"

Err.Clear

End If

With objStream

.Type = 2

.Mode = 3

.Open

.LoadFromFile File

.Charset = "GB2312" '可以根據(jù)需求,把這里的編碼修改成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'); 換成數(shù)據(jù)庫(kù)操作

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("寫(xiě)入成功,你可以再操作別的目錄了");

}

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;

}

}

//---------------------------------------------------------工具整理模塊第二步結(jié)束------------------------------------------

</script>

<SCRIPT Language="VBScript">

'=============================================================軟件查找模塊開(kāi)始

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( "請(qǐng)輸入sql語(yǔ)句:", "輸入", "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&">打開(kāi)目錄</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 "數(shù)據(jù)庫(kù)不存在,請(qǐng)copy到同文件夾"

End if

End Sub

'=============================================================軟件查找模塊結(jié)束

sub showHelp

dim msg

msg = " 軟件管理工具0.1【IE7.0測(cè)試通過(guò)】" & vbcrlf

msg = msg & "------------------------------------------------" & vbcrlf

msg = msg & "程序初始化是建立與本文件同名后綴為mdb的數(shù)據(jù)庫(kù)" & vbcrlf

msg = msg & "自定義分類(lèi),是歸檔文件,好比你可以把你的工具分為滲透、溢出、網(wǎng)馬、瀏覽之類(lèi)的,可無(wú)限建分類(lèi)" & vbcrlf

msg = msg & "建好分類(lèi)后,你可以進(jìn)行第二步,根據(jù)你需要的后綴來(lái)進(jìn)行分類(lèi),不建議將dll文件也分類(lèi),只把exe和webshell之類(lèi)進(jìn)行收集吧" & vbcrlf

msg = msg & "第二步查找結(jié)束后,可以選擇程序建立的SearchResult.txt,根據(jù)提示構(gòu)選要存到哪一個(gè)分類(lèi),自動(dòng)存進(jìn)數(shù)據(jù)庫(kù)" & vbcrlf

msg = msg & "第三步當(dāng)然是進(jìn)行查找了,根據(jù)自定義sql語(yǔ)句查找你的工具" & vbcrlf

msg = msg & "程序只是個(gè)雛形,可以提供建議,有時(shí)間再修正bug,進(jìn)行軟件升級(jí)" & 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>

因?yàn)橹苯拥拇a容易出問(wèn)題,所以腳本之家特打包提供下載

更多信息請(qǐng)查看IT技術(shù)專(zhuān)欄

更多信息請(qǐng)查看腳本欄目
易賢網(wǎng)手機(jī)網(wǎng)站地址:hta編寫(xiě)的軟件管理工具0.1(IE7.0測(cè)試通過(guò))
由于各方面情況的不斷調(diào)整與變化,易賢網(wǎng)提供的所有考試信息和咨詢回復(fù)僅供參考,敬請(qǐng)考生以權(quán)威部門(mén)公布的正式信息和咨詢?yōu)闇?zhǔn)!

2025國(guó)考·省考課程試聽(tīng)報(bào)名

  • 報(bào)班類(lèi)型
  • 姓名
  • 手機(jī)號(hào)
  • 驗(yàn)證碼
關(guān)于我們 | 聯(lián)系我們 | 人才招聘 | 網(wǎng)站聲明 | 網(wǎng)站幫助 | 非正式的簡(jiǎn)要咨詢 | 簡(jiǎn)要咨詢須知 | 加入群交流 | 手機(jī)站點(diǎn) | 投訴建議
工業(yè)和信息化部備案號(hào):滇ICP備2023014141號(hào)-1 云南省教育廳備案號(hào):云教ICP備0901021 滇公網(wǎng)安備53010202001879號(hào) 人力資源服務(wù)許可證:(云)人服證字(2023)第0102001523號(hào)
云南網(wǎng)警備案專(zhuān)用圖標(biāo)
聯(lián)系電話:0871-65099533/13759567129 獲取招聘考試信息及咨詢關(guān)注公眾號(hào):hfpxwx
咨詢QQ:526150442(9:00—18:00)版權(quán)所有:易賢網(wǎng)
云南網(wǎng)警報(bào)警專(zhuān)用圖標(biāo)