个人学习之作 hta

2020-01-25 19:40:56

字体：大中小

来源：转载

供稿：网友

这个hta是基于asp操作access数据库实现的，方便存储个人学习资料的一个东西，也是武林网的雏形，好不容易找到了备份，希望大家能喜欢

复制代码代码如下:



<html>

<head>

<meta http-equiv="Content-Type" content="text/html; charset=gb2312">

<hta:application

     id="dxymdb"

  scroll="yes"

  singleinstance="yes"

border="thin"

  windowstate="maximize"

icon="dxy.ico"

>

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

<style type="text/css">



</style>

</head>

<script language="vbscript">

'加入智能显示信息条数

strComputer = "."

    Set objWMIService = GetObject("Winmgmts://" & strComputer & "/root/cimv2")

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

    For Each objItem in colItems

        thewidth = objItem.ScreenWidth

        theheight = objItem.ScreenHeight

    Next

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

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>"

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

do until rs.eof

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

rs.movenext

loop

strclassliststrclasslist=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

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

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

strliststrlist=strlist&"<tr><td height='20' class='b'>[<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

next

strliststrlist=strlist&"</table>"

thelist.innerHTML=strlist

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

for j=1 to thepages

if j=intpage then

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

else

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

end if

next

pagelistpagelist=pagelist&"</select>页"

fenye.innerHTML=pagelist

call changepage

else

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

end if

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 Settings//Administrator//桌面';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 style='margin:10px' bgcolor='#3a6ead'><table width='700' border='0' align='center' cellpadding='0' cellspacing='0'><tr><td><textarea rows='20' style='width:700; border:1px solid #808080; overflow:hidden;' 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_valuecpage_value=cpage_value&"<a href='#' onclick='changeit("&cpage_v-1&")'>上一页</a>  "

end if

if cpage_v<cpage_l and cpage_v>=1 then

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

end if

cpage_valuecpage_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

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 style="margin:0px; ">

<table width="98" height="10" border="0" align="center" cellpadding="0" cellspacing="0">

  <tr>

    <td></td>

  </tr>

</table>

<span name="theadd" id="theadd" style="display:none">

<table width="760" border="0" align="center" cellpadding="0" cellspacing="0" style="border:1px dotted #ffffff ">

  <tr>

    <td style="line-height:150%; ">类    别：

      <input name="theclass" type="text" id="theclass" style="border:1px solid #808080;" size="10" maxlength="50">

      标题:

      <input name="thetitle" type="text" id="thetitle" size="40" maxlength="200">

      <input type="button" name="add" value="添加" onClick="addnews">

      <input type="button" name="edit" value="修改" onClick="editsave">

      <input type="button" name="undo" value="取消" onClick="unadd">

      <br>

      添加内容：

      <span class="style4">

      <textarea name="content" rows="15" style="border:1px solid #808080; width:760; work-break:break-all; " ondblclick="content.style.posHeight=content.scrollHeight"></textarea>

      </span>    <br>

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

   <br> id值：

    <input name="theid1" type="text" size="5"></td>

  </tr>

</table>

</span><br>

<table width="760" height="47" border="0" align="center" cellpadding="0" cellspacing="0" style="border:1px dotted #ffffff;">

   <tr>

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

      <input type="button" value="添加信息" onClick="addnews">

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

<input name="button" type="button" onClick="changeit(1)" value="载入">

<input type="button" onClick="addclass" value="添加"'>

      <input type="button" onClick="delclass" value="删除"'>

      <input type="button" onClick="editclass" value="编辑"'>

      <input type="button" name="Submit" value="退出" onClick="quitscript"'>

        <input name="searchstr" type="text" id="searchstr"' onfocus="searchstr.select()">

    <input type="submit" name="Submit" value="搜"' onClick="searchits">

</div></td>

  </tr>

  <tr>

    <td><hr align="center" width="80%" size="1" noshade style="border:1px solid #ffffff "></td>

  </tr>

  <tr>

    <td align="center"><span id="fenyetop"></span></td>

  </tr>

  <tr>

    <td><span id="thelist"></span></td>

  </tr>

  <tr>

    <td align="center"><span id="thecounts"></span>  <span id="dispage"></span><span id="fenye"></span></td>

  </tr>

</table>

</body>

</html>