!--
***********************************************************************
'*一直想做一個自己用來學習的東西，可是一直沒有時間，本想用asp（用netbox）做的。，我一直
'*想學習程序，vb但沒有時間學習，現(xiàn)在想用c#做一個，但沒有什么時間，偶爾去官方找vbscript發(fā)現(xiàn)
'*這個不錯的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">
'加入智能顯示信息條數(shù)
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
'------------------智能結(jié)速-----
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)delclassnamechr(39)
rs.open sqld,conn,3,3
msgbox chr(34)delclassnamechr(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)reditclasschr(39)" where class_name="chr(39)theeditclasschr(39)
rs.open sqld,conn,3,3
msgbox chr(34)theeditclass"-->"reditclasschr(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 gettitlegetcontent
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 "恭喜，數(shù)據(jù)添加成功"
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 page1 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)*maxperpagethecounts 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>]nbsp;"rs("title")"nbsp;nbsp;font color='#f6f6f6'>"rs("enter_time")"/font>nbsp;nbsp;a href='#' onclick=openthecontent("rs("id")")>查看/a>nbsp;a href='#' onclick=editnews("rs("id")")>修改/a>nbsp;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,"","lt;")
theopencontent=replace(theopencontent,">","gt;")
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>nbsp;nbsp;"
if cpage_v>1 then
cpage_value=cpage_value"a href='#' onclick='changeit("cpage_v-1")'>上一頁/a>nbsp;nbsp;"
end if
if cpage_vcpage_l and cpage_v>=1 then
cpage_value=cpage_value"a href='#' onclick='changeit("cpage_v+1")'>下一頁/a>nbsp;nbsp;"
end if
cpage_value=cpage_value"a href='#' onclick='changeit("cpage_l")'>尾頁/a>nbsp;nbsp;"
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("數(shù)據(jù)修改成功")
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%; ">類nbsp;nbsp;nbsp;nbsp;別：
      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>
      添加內(nèi)容：
      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">內(nèi)容列表/span>nbsp;[
      input type="button" value="添加信息" onClick="addnews">
      ]nbsp;類別：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>nbsp;nbsp;span id="dispage">/span>span id="fenye">/span>/td>
  /tr>  
/table>
/body>
/html>