个人学习之作 hta 原创

代码如下:

<!--
***********************************************************************
'*一直想做一个自己用来学习的东西,可是一直没有时间,本想用asp(用netbox)做的。,我一直
'*想学习程序,vb但没有时间学习,现在想用c#做一个,但没有什么时间,偶尔去官方找vbscript发现
'*这个不错的hta于是花了两三天的时间,做了一个这个,希望大家能喜欢。
'*Author: dxy(reterry)
'*version:1.0
'*QQ: 461478385
'*Email:douxy001@gmail.com
***********************************************************************
//-->
<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">
<!--
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>
<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>"
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
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
strlist=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
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
next
pagelist=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_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
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>

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

(0)

相关推荐

  • 个人学习之作 hta 原创

    复制代码 代码如下: <!-- *********************************************************************** '*一直想做一个自己用来学习的东西,可是一直没有时间,本想用asp(用netbox)做的.,我一直 '*想学习程序,vb但没有时间学习,现在想用c#做一个,但没有什么时间,偶尔去官方找vbscript发现 '*这个不错的hta于是花了两三天的时间,做了一个这个,希望大家能喜欢. '*Author: dxy(reterry)

  • python爬虫框架talonspider简单介绍

    1.为什么写这个? 一些简单的页面,无需用比较大的框架来进行爬取,自己纯手写又比较麻烦 因此针对这个需求写了talonspider: •1.针对单页面的item提取 - 具体介绍点这里 •2.spider模块 - 具体介绍点这里 2.介绍&&使用 2.1.item 这个模块是可以独立使用的,对于一些请求比较简单的网站(比如只需要get请求),单单只用这个模块就可以快速地编写出你想要的爬虫,比如(以下使用python3,python2见examples目录): 2.1.1.单页面单目标 比如

  • 使用Python开发个京东上抢口罩的小实例(仅作技术研究学习使用)

    全国抗"疫"这么久终于见到曙光,在家待了将近一个月,现在终于可以去上班了,可是却发现出门必备的口罩却一直买不到.最近看到京东上每天都会有口罩的秒杀活动,试了几次却怎么也抢不到,到了抢购的时间,浏览器的页面根本就刷新不出来,等刷出来秒杀也结束了.现在每天只放出一万个,却有几百万人在抢,很想知道别人是怎么抢到的,于是就在网上找了大神公开出来的抢购代码.看了下代码并不复杂,现在我们就报着学习的态度一起看看. 使用模块 requests:类似 urllib,主要用于向网站发送 HTTP 请求.

  • laravel框架学习记录之表单操作详解

    本文实例讲述了laravel框架学习记录之表单操作.分享给大家供大家参考,具体如下: 1.MVC数据流动 拿到一个laravel项目最基本的是弄清楚它的页面请求.数据流动是怎样进行的,比如当通过get请求index页面时,如何显示如下的学生信息列表: 首先当一个页面请求到达时,需要在routes/web.php中定义路由请求以及对应的处理方法: Route::get('index','StudentController@getIndex'); 然后在.env文件下设置好数据库连接,新建数据库模型

  • 正则表达式 口诀 学习正则的朋友看看

    正则是每个程序员绕不开的堡垒,只有把它攻下来.我觉得正则之所以难,第一难是需要记忆,第二难是要求具备抽象逻辑思维. 签于网上太多的介绍都是一篇凶悍的短文,边看边理解可以,帮助记忆不行.又受五笔字型字根表口诀"白手看头三二斤..."的启发, 试作"正则表达式助记口诀"又名"正则打油诗",版本0.1,绝对原创,仿冒必究,:) 注:本文仅为学习正则时为了便于记忆而作,不能代替系统而全面的学习过程,错漏之处,敬请指正! 正则其实也势利,削尖头来把钱揣:

  • HTA版JSMin(省略修饰语若干)基于javascript语言编写

    以前我使用JSMin的时候,都是从http://fmarcia.info/jsmin/这里打开执行页面,然后把自己的代码粘贴过去,再把减肥后的代码复制回文本编辑工具.保存. 久而久之,我发现这样实在是太麻烦了!既然我们是程序员,为何不自己动手把事情变得简单一点呢? 因此我开始了对JSMin进行"友好化"的工作. 而在进行"友好化"工作的过程中,"不出意料"地遇到了一些意想不到的问题,马上我就讲遇到的是哪些问题.最后怎样解决. 不过由于是在一切问题

  • 正则表达式口诀_学习正则的朋友值得一看

    签于网上太多的介绍都是一篇凶悍的短文,边看边理解可以,帮助记忆不行.又受五笔字型字根表口诀"白手看头三二斤..."的启发, 试作"正则表达式助记口诀"又名"正则打油诗",版本0.1,绝对原创,仿冒必究,:) 注:本文仅为学习正则时为了便于记忆而作,不能代替系统而全面的学习过程,错漏之处,敬请指正! 正则其实也势利,削尖头来把钱揣:  (指开始符号^和结尾符号$) 特殊符号认不了,弄个倒杠来引路:  (指\. \*等特殊符号) 倒杠后面跟小w, 数

  • 正则表达式口诀 正则表达式学习工具

    签于网上太多的介绍都是一篇凶悍的短文,边看边理解可以,帮助记忆不行.又受五笔字型字根表口诀"白手看头三二斤..."的启发,  试作"正则表达式助记口诀"又名"正则打油诗",版本0.1,绝对原创,仿冒必究,:)  注:本文仅为学习正则时为了便于记忆而作,不能代替系统而全面的学习过程,错漏之处,敬请指正!  正则其实也势利,削尖头来把钱揣: (指开始符号^和结尾符号$)  特殊符号认不了,弄个倒杠来引路: (指\. \*等特殊符号)  倒杠后面跟小w

  • 学习YUI.Ext基础第一天

    导言 翻了翻以前的旧贴子,有值得回味的地方共分享: Post1: ................. 我们现在的大量应用依赖于浏览器(主要是 IE)的脚本处理能力,在有些老机器上跑的时候确实会略显缓慢,但是目前的主流机型处理起来已经没有任何问题了.我们设计了一整套的 Web 开发框架,这套框架将随着应用的锤炼而越来越稳定.JavaScript 用的不好容易造成 IE 的崩溃,我们是靠提高代码的重用度来解决这个问题的,因为重用度越高的代码往往越稳定. 有些眼高手低的人往往凭第一眼印象就把 Java

  • XML 轻松学习手册(比较不错)第1/3页

    我想就我个人学习过程的心得和经验,写一篇比较全面的介绍文章.首先有两点是需要肯定的: 第一:XML肯定是未来的发展趋势,不论是网页设计师还是网络程序员,都应该及时学习和了解,等待只会让你失去机会: 第二:新知识肯定会有很多新概念,尝试理解和接受,您才可能提高.不要害怕和逃避,毕竟我们还年轻. 提纲 本文共分五大部分.分别是XML快速入门,XML的概念,XML的术语,XML的实现,XML的实例分析.最后附录介绍了XML的相关资源.作者站在普通网页设计人员的角度,用平实生动的语言,向您讲述XML的方

随机推荐