个人学习之作 hta <font color=red>原创</font>

复制代码代码如下: <!--

***********************************************************************

'*一直想做一个自己用来学习的东西，可是一直没有时间，本想用asp（用netbox）做的。，我一直

'*想学习程序，vb但没有时间学习，现在想用c#做一个，但没有什么时间，偶尔去官方找vbscript发现

'*这个不错的hta于是花了两三天的时间，做了一个这个，希望大家能喜欢。

'*Author: dxy(reterry)

'*version:1.0

'*QQ: 461478385

'*Email:douxy001@gmail.com

***********************************************************************

//-->

<html>

<head>

<hta:application

id="dxymdb"

scroll="yes"

singleinstance="yes"

border="thin"

windowstate="maximize"

icon="dxy.ico"

<title>我的第一个hta程序</title>

<!--

BODY

{

scrollbar-face-color : #D8DBDF;

scrollbar-highlight-color : #FFFFFF;

scrollbar-shadow-color : #C1C6CC;

scrollbar-3dlight-color : #ABB1B3;

scrollbar-arrow-color : #7F8996;

scrollbar-track-color : #F8FAF9;

scrollbar-darkshadow-color : #ABB1B3;

}

body,td,th {

font-size: 10pt;

color: #FFFFFF;

}

body {

background-color: #3a6ead;

}

a {

font-size: 9pt;

color: #000000;

}

a:link {

text-decoration: none;

color: #FFFF33;

}

a:visited {

text-decoration: none;

color: #FFFF33;

}

a:hover {

text-decoration: none;

color: #FFffff;

}

a:active {

text-decoration: none;

}

.style4 {font-weight: bold}

.b {

border-bottom-width: 1px;

border-bottom-style: dashed;

border-bottom-color: #BFDFFF;

}

.style9 {color: #ffff33}

input {

font-size:12px;

}

-->

</style>

</head>

'加入智能显示信息条数

strComputer = "."

Set objWMIService = GetObject("Winmgmts:" & strComputer & "rootcimv2")

Set colItems = objWMIService.ExecQuery("Select * From Win32_DesktopMonitor")

For Each objItem in colItems

thewidth = objItem.ScreenWidth

theheight = objItem.ScreenHeight

'------------------智能结速-----

const adUserClient=3

sub window_onload()

dim conn

set conn=createobject("adodb.connection")

conn.open "provider=microsoft.jet.oledb.4.0;data source=db.mdb"

set rs=createobject("adodb.recordset")

rs.cursorlocation=adUserClient

sql="select * from theclass order by id desc"

rs.open sql,conn,1,1

rs.movefirst

strclasslist="<select onclick=changeclass() name=theclassname>"

strclasslist=strclasslist+"<option value="&chr(34)&chr(34)&">"

do until rs.eof

strclasslist=strclasslist&"<option value="&chr(34)&rs.fields.item("class_name")&chr(34)&">"&rs.fields.item("class_name")&"</option>"

rs.movenext

loop

strclasslist=strclasslist&"<option value='其它'>其它</option><option value='全部'>全部</option></select>"

classlist.innerHTML=strclasslist

end sub

sub changeclass()

theclass.value=theclassname.value

if theclass.value="全部" then

theclass.value=""

end if

end sub

sub addclass()

classname=inputbox("请输入你要添加的类别","添加类别")

if classname="" then

msgbox "添加的类别不能为空"

exit sub

else

dim conn

set conn=createobject("adodb.connection")

conn.open "provider=microsoft.jet.oledb.4.0;data source=db.mdb"

set rs=createobject("adodb.recordset")

rs.cursorlocation=adUserClient

//sqla="insert into class(class_name)values("&classname&")"

rs.open "theclass",conn,3,3

rs.addnew()

rs("class_name")=classname

rs.update

rs.close

conn.close

msgbox classname&"添加成功",0

end if

call window_onload

end sub

sub delclass()

if confirm("你真的要删除吗？") then

delclassname=theclassname.value

if delclassname="" then

msgbox "要删除的类别不能为空"

exit sub

else

dim conn

set conn=createobject("adodb.connection")

conn.open "provider=microsoft.jet.oledb.4.0;data source=db.mdb"

set rs=createobject("adodb.recordset")

rs.cursorlocation=adUserClient

sqld="delete from theclass where class_name="&chr(39)&delclassname&chr(39)

rs.open sqld,conn,3,3

msgbox chr(34)&delclassname&chr(34)&"删除成功",0

//rs.close

//conn.close

end if

call window_onload

end if

end sub

sub editclass()

theeditclass=theclassname.value

reditclass=inputbox("请输入你要更改后的类别名称","类别修改")

if theeditclass="" or reditclass="" then

exit sub

else

dim conn

set conn=createobject("adodb.connection")

conn.open "provider=microsoft.jet.oledb.4.0;data source=db.mdb"

set rs=createobject("adodb.recordset")

rs.cursorlocation=adUserClient

sqld="update theclass set class_name="&chr(39)&reditclass&chr(39)&" where class_name="&chr(39)&theeditclass&chr(39)

rs.open sqld,conn,3,3

msgbox chr(34)&theeditclass&"-->"&reditclass&chr(34)&"成功修改",0

call window_onload

rs.close

conn.close

end if

end sub

sub window_onUnload

on error resume next

rs.close

conn.close

end sub

sub quitscript

on error resume next

rs.close

conn.close

self.close

end sub

sub unadd()

theclass.value=""

thetitle.value=""

content.value=""

theadd.style.display="none"

end sub

sub addnews()

theadd.style.display="block"

add.disabled=false

theclass.value=theclassname.value

getclass=theclass.value

gettitle=thetitle.value

getcontent=content.value

getisgood=isgood.value

if getisgood="" then

getisgood=0

else

getidgood=1

end if

if getclass<>"" and getclass<>"全部" and gettitle<>"" and getcontent<>"" then

//msgbox gettitle&getcontent

dim conn

set conn=createobject("adodb.connection")

conn.open "provider=microsoft.jet.oledb.4.0;data source=db.mdb"

set rs=createobject("adodb.recordset")

rs.cursorlocation=adUserClient

rs.open "list",conn,3,3

rs.addnew()

rs("title")=gettitle

rs("class_name")=getclass

rs("content")=getcontent

rs("isgood")=getisgood

rs.update

msgbox "恭喜，数据添加成功"

theclass.value=""

thetitle.value=""

content.value=""

end if

//rs.close

//conn.close

end sub

sub searchits()

thesearch=searchstr.value

'if thesearch<>"" then

'theclassname.value=""

'end if

call changeit(1)

end sub

sub changeit(thenum)

theclass.value=theclassname.value

thename=theclassname.value

thesearch=searchstr.value

'if thename<>"" then searchstr.value=""

thelist.innerHTML=""

thecounts.innerHTML=""

if thename<>"" or thesearch<>"" then

dim conn

set conn=createobject("adodb.connection")

conn.open "provider=microsoft.jet.oledb.4.0;data source=db.mdb"

set rs=createobject("adodb.recordset")

rs.cursorlocation=adUserClient

if thesearch="" then

if thename="全部" then

sql="select id,class_name,title,enter_time from list order by id desc"

else

sql="select id,class_name,title,enter_time from list where class_name='"&thename&"' order by id desc"

end if

else

if thename="" then

sql="select distinct id,class_name,title,enter_time from list where (title like '%"&thesearch&"%' or content like '%"&thesearch&"%' or class_name like '%"&thesearch&"%')"

else

sql="select distinct id,class_name,title,enter_time from list where (title like '%"&thesearch&"%' or content like '%"&thesearch&"%' or class_name like '%"&thesearch&"%') and class_name='"&thename&"'"

end if

rs.open sql,conn,1,1

page=trim(thenum)

if page<>"" then page=cint(page)

pre=true

last=true

if not rs.eof then

if theheight=600 then

maxperpage=20

elseif theheight>600 then

maxperpage=28

else

maxperpage=20

end if

rs.pagesize=maxperpage

thepages=rs.pagecount

thecount=rs.recordcount

if page="" and page<1 then

intpage=1

pre=false

else

if page>thepages then

intpage=thepages

last=false

else

intpage=cint(page)

end if

themovenum=(intpage-1)*maxperpage

thecounts.innerHTML="共有<font color='#ffff33'>"&thecount&"</font>条信息[<font color='#ffff33'>"&maxperpage&"</font>条/页共<font color='#ffff33'>"&thepages&"</font>页当前第<font color='#ffff33'>"&page&"</font>页]"

rs.movefirst

if (intpage-1)*maxperpage<thecounts then

dim bookmark

bookmark=rs.bookmark

rs.move themovenum

end if

strlist="<table width='80%' align='center' cellpadding='0' cellspacing='1' border=0>"

for i=1 to maxperpage

if rs.eof then exit for

strlist=strlist&"<tr><td height='20'>[<font color=yellow>"&rs("class_name")&"</font>]"&rs("title")&"<font color='#f6f6f6'>"&rs("enter_time")&"</font><a href='#' onclick=openthecontent("&rs("id")&")>查看</a><a href='#' onclick=editnews("&rs("id")&")>修改</a><a href='#' onclick=delthecontent("&rs("id")&")>删除</a></td></td>"

rs.movenext

if rs.eof then exit for

strlist=strlist&"</table>"

thelist.innerHTML=strlist

pagelist="第<select name='cpage' onchange=changeit2()>"

for j=1 to thepages

if j=intpage then

pagelist=pagelist&"<option value="&j&" selected>"&j&"</option>"

else

pagelist=pagelist&"<option value="&j&">"&j&"</option>"

end if

pagelist=pagelist&"</select>页"

fenye.innerHTML=pagelist

call changepage

else

thecounts.innerHTML="<font color='#ffff33'>对不起没有您要的信息</font>"

end if

//rs.close

//conn.close

end sub

sub changeit2()

thenum=cpage.value

call changeit(thenum)

end sub

sub openthecontent(id)

theid=id

if id<>"" then

id=cint(id)

end if

dim conn

set conn=createobject("adodb.connection")

conn.open "provider=microsoft.jet.oledb.4.0;data source=db.mdb"

set rs=createobject("adodb.recordset")

rs.cursorlocation=adUserClient

sql="select * from list where id="&id&""

rs.open sql,conn,1,1

if not rs.eof then

theopencontent=rs("content")

theopencontent=replace(theopencontent,"<","<")

theopencontent=replace(theopencontent,">",">")

set diswindow=window.open("about:blank","diswindow")

diswindow.document.body.style.fontSize="12px"

diswindow.focus()

diswindow.document.write("<html><head><scr"+"ipt>function saveit(){strDesktop='C:Documents and SettingsAdministrator桌面';var code=event.srcElement.parentElement.children[0].value;var objfso=new ActiveXObject('Scripting.FileSystemObject');var strname=prompt('请输入文件名和路',strDesktop+'temp.vbs');if(strname!=''){var objfile=objfso.CreateTextFile(strname,2,true);objfile.Write(code);objfile.Close();}}function runit(){var code=event.srcElement.parentElement.children[0].value;var newwin=window.open('');newwin.opener=null;newwin.document.write(code);newwin.document.close();}</scr"+"ipt><meta http-equiv='Content-Type' content='text/html; charset=gb2312'><title>"+rs("title")+"</title><body bgcolor='#3a6ead'><table width='700' border='0' align='center' cellpadding='0' cellspacing='0'><tr><td><textarea rows='20' onmouseover='this.style.posHeight=this.scrollHeight' onpropertychange='this.style.posHeight=this.scrollHeight' onload='this.style.posHeight=this.scrollHeight'>"+theopencontent+"</textarea><br><input type=button value='运行上面的代码[html]' onclick='runit()'> <input type=button value='保存' onclick='saveit()'></td></tr></table></body></html>")

diswindow.focus()

diswindow.document.close()

end if

end sub

sub delthecontent(strid)

if confirm("你真的要删除吗？") then

id=strid

if id<>"" then

id=cint(id)

end if

dim conn

set conn=createobject("adodb.connection")

conn.open "provider=microsoft.jet.oledb.4.0;data source=db.mdb"

set rs=createobject("adodb.recordset")

rs.cursorlocation=adUserClient

sql="delete from list where id="&id&""

rs.open sql,conn,3,3

msgbox "成功删除"

else

exit sub

end if

end sub

sub changepage()

cpage_l=cint(cpage.length)

cpage_v=cint(cpage.value)

cpage_value="<a href='#' onclick='changeit(1)'>首页</a>"

if cpage_v>1 then

cpage_value=cpage_value&"<a href='#' onclick='changeit("&cpage_v-1&")'>上一页</a>"

end if

if cpage_v<cpage_l and cpage_v>=1 then

cpage_value=cpage_value&"<a href='#' onclick='changeit("&cpage_v+1&")'>下一页</a>"

end if

cpage_value=cpage_value&"<a href='#' onclick='changeit("&cpage_l&")'>尾页</a>"

dispage.innerHTML=cpage_value

end sub

sub editnews(strid)

theadd.style.display="block"

id=strid

if id<>"" then

id=cint(id)

end if

dim conn

set conn=createobject("adodb.connection")

conn.open "provider=microsoft.jet.oledb.4.0;data source=db.mdb"

set rs=createobject("adodb.recordset")

rs.cursorlocation=adUserClient

sql="select * from list where id="&id&""

rs.open sql,conn,1,1

if not rs.eof then

titlee=rs("title")

contente=rs("content")

classname=rs("class_name")

end if

theclassname.value=classname

thetitle.value=titlee

content.value=contente

theid1.value=id

add.disabled=true

end sub

sub editsave()

id=theid1.value

edittitle=thetitle.value

editcontent=content.value

classname=theclass.value

if id<>"" then

dim conn

set conn=createobject("adodb.connection")

conn.open "provider=microsoft.jet.oledb.4.0;data source=db.mdb"

set rs=createobject("adodb.recordset")

rs.cursorlocation=adUserClient

sql="select id,class_name,title,content from list where id="&id&""

rs.open sql,conn,3,3

rs("class_name")=classname

rs("title")=edittitle

rs("content")=editcontent

rs.update

if err.number=0 then

msgbox("数据修改成功")

end if

theid1.value=""

thetitle.value=""

content.value=""

'theclassname.value=""

theclass.value=""

theadd.style.display="none"

add.disabled=false

call changeit2()

end sub

</script>

<body>

<tr>

</tr>

</table>

<tr>

<td>类别：

标题:

<br>

添加内容：

<span>

</span> <br>

是否推荐：<input name="isgood" type="text" size="5">

<br> id值：

</tr>

</table>

</span><br>

<tr>

<td height="23" align="center"><div align="left"><span>内容列表</span>[

]类别：<span id="classlist"></span>

</div></td>

</tr>

<tr>

</tr>

<tr>

</tr>

<tr>

</tr>

<tr>

</tr>

</table>

</body>

</html>

打包下载：jb51_hta(jb51.net).rar