[原创] 消费记录程序(hta+xml)

youxi01

经过三天的努力奋斗，终于完成了消费记录程序（注：这个程序虽然在以前已经写过，但是“内核”已完全不同以前了，包括界面，包括数据读取、保存方式等等。）
1、程序介绍：
'/*/////////////////////////////////////////////////////////////////////////////////////
'Intro  消费记录：支持添加、删除、查询、保存消费记录
'FileName 消费记录器
'Author  2laoshi
'Version  ver1.1
'Web  http://www.2laoshi.cn
'MadeTime 2008-9-29~2008-10-2

'开发工具：notepad.exe
'文件大小：14K（另一版本18K，增加了自动分页显示）
'运行平台：WinNT
'//////////////////////////////////////////////////////////////////////////////////////////

2、运行界面：
[attach]415[/attach]

[attach]416[/attach]

3、下载：
[attach]417[/attach]

4、源代码：

<!--////////程序说明/////////====
Intro  消费记录：支持添加、删除、查询、保存消费记录
FileName 消费记录器
Author  2laoshi
Version  ver1.1
Web  http://www.2laoshi.cn
MadeTime 2008-9-29~2008-10-2
<!--//////////设置hta格式////////////-->
<HTA:APPLICATION 
 SCROLL="no" 
 MaximizeButton="no"
 MinimizeButton="no"
 INNERBORDER="no" 
 SHOWINTASKBAR="yes" 
 SINGLEINSTANCE="yes" 
 BORDER="thin"
 />
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<!--//////////样式////////////-->
<style type="text/css">
a:link {color: blue}
a:visited {color: blue}
body  {background: #EEEEEE}
fieldset {border :1px solid #BEBEBE;font-family:宋体;}
legend {color:red;font-size:14px} 
#table {border:none;width:100%;background: #EEEEEE;}
.header{text-align=center;background-color:#006699;font-size:13px;
         font-family: "隶书";color:#F2F3F7;padding:2px;line-height:22px;font:bold;}
.top{text-align:center;vertical-align: middle;font-size:14px;
         font-family: "宋体";color:red;font:bold;padding:2px;line-height:22px;}
.row_model{text-align:center;vertical-align: middle;background-color:#ccd2FF;font-size:12px;
         padding-top:4px;height:20px;COLOR:red}
.row_add{text-align:center;vertical-align: middle;background-color:#ccd2de;font-size:12px;
         padding-top:4px;height:20px;}
.new_row_add{text-align:center;vertical-align: middle;background-color:#ccd2ad;font-size:12px;padding-top:4px;height:20px;color:blue;cursor:hand;}
.td{border:1 solid #BEBEBE;}
.text{text-align:center;vertical-align: middle;}
.proginfo{font-size:12px;color:#333333;font-family: "隶书";}
.div_button{text-align:center;width:100%;border:1px solid #ccc;
          background-color:#EEEEEE;font-size:12px;color:#333333;
          padding:3px 2px;margin:2px;line-height:20px;}
.bottom{text-align:center;font-size:14px;color:#333333;font-family: "隶书";}
.div_class{WIDTH:100%; HEIGHT: 323; BACKGROUND-COLOR: transparent; overflow-y: scroll; scrollbar-shadow-color: #ffffff; scrollbar-highlight-color: #ffffff; scrollbar-face-color: #d9d9d9; scrollbar-3dlight-color: #d9d9d9; scrollbar-darkshadow-color: #d9d9d9; scrollbar-track-color: #ffffff; scrollbar-arrow-color: #ffffff;}
.button {padding:1px;text-align:center;border:0;background-color:#eee;height:23px;cursor:pointer}
</style>
<!--//////////函数区////////////-->
<script language="vbscript">
ON ERROR RESUME NEXT
set http=createobject("Msxml2.ServerXMLHTTP") 
set fso=createobject("Scripting.FileSystemObject")
Select_List=""
Sub Window_onLoad
 window.resizeTo 550,445
 ileft=(window.screen.width-550)/2
 itop=(window.screen.height-445)/2       
 window.moveTo ileft,itop                 
 document.all.namedItem("CYY").value=year(date())
 document.all.namedItem("CMM").value=month(date())
 document.all.namedItem("CDD").value=day(date())
 CheckFile("data.xml")
End Sub
 
Function CheckFile(filespec)
if not fso.fileexists(filespec) then 
 fso.createtextfile(filespec)
 CreateXMLFile(filespec)
else
 ReadXMLFile(filespec)
end if
End Function
Function CreateXMLFile(filespec)
Const ForReading=1,ForWriting=2,ForAppending=8
set f=fso.opentextfile(filespec,2,true)
f.writeline("<?xml version='1.0' encoding='gb2312'?>")
f.writeline("<root><data>")
f.writeline("</data></root>")
End Function
Function ReadXMLFile(filespec)
set objDom=CreateObject("microsoft.xmldom")
objDom.load("data.xml")
Set Node=objDom.documentElement.selectNodes("//data/list")
for each element in Node
 CStype=element.selectsinglenode("type").text
 CSmoney=element.selectsinglenode("money").text
 CSdate=element.selectsinglenode("date").text
 id=element.getAttribute("id") 
 addRow id,CSmoney,CStype,CSdate,"正常"
 Add_select_item(CStype)
next
set oXML=nothing
End Function
Function getID()
randomize()
getID=int(rnd()*10000)&int(rnd()*10000)&int(rnd()*10000)
End Function
Function addItem(id,mm,tt,dd)
set objDom=CreateObject("microsoft.xmldom")
objDom.load("data.xml")
Set Node=objDom.documentElement.selectsingleNode("data")
Set newNode=objDom.createElement("list") 
Node.appendChild newNode
newNode.setAttribute "id",id
Set childNode1=objDom.createElement("money")
childNode1.text=mm
Set childNode2=objDom.createElement("type")
childNode2.text=tt
Set childNode3=objDom.createElement("date")
childNode3.text=dd
newNode.appendChild childNode1
newNode.appendChild childNode2
newNode.appendChild childNode3
objDom.save("data.xml")
set objDom=nothing
End Function
Function delItem(id)
set objDom=CreateObject("microsoft.xmldom")
objDom.load("data.xml")
Set Node=objDom.documentElement.selectNodes("//data/list")
for each element in Node
 nodeid=element.getAttribute("id")
 if nodeid=id then
         element.parentNode.removechild element
 end if
next
objDom.save("data.xml")
set objDom=nothing
End Function
Function addRow(id,cnum,ctype,cdate,intro)   
set objTable=document.all.namedItem("mytable")      '根据ID获取对象表格
set newrow = objTable.insertRow()                   '插入一行
newrow.className="row_add"                        '设置该行的样式；
newrow.onmouseover=getRef("change_bgcolor")
newrow.onmouseout=getRef("back_bgcolor")
newrow.onclick=getRef("chooseThis")
var="#"&cnum&"#"&ctype&"#"&cdate&"#"&intro       
str=split(var,"#")
str(0)="<input type=checkbox id="&id&">"
for i=0 to 4
   set newcell=newrow.insertCell()                  '插入单元格，并设置单元格的值；
   newcell.innerhtml=str(i)
next
End Function
Function delRow(num)
End Function
Function SaveToFile()
RowNum=mytable.rows.length-1 
for i=1 to RowNum
  if mytable.rows(i).cells(4).innertext="待添加" then
  id=mytable.rows(i).cells(0).children(0).id
  mm=mytable.rows(i).cells(1).innertext
  tt=mytable.rows(i).cells(2).innertext
  dd=mytable.rows(i).cells(3).innertext
  addItem id,mm,tt,dd
  end if
  if mytable.rows(i).cells(4).innertext="待删除" then
  id=mytable.rows(i).cells(0).children(0).id
  delItem id
  end if
next
window.location.reload
End Function
Function tb_del_onclick()
strHTML="<font color=Green title=点击取消删除  style='cursor: hand' onclick="
strHTML=strHTML&"me.parentelement.innerHTML='正常'>待删除</font>"
RowNum=mytable.rows.length-1 
for i=1 to RowNum
  if mytable.rows(i).cells(0).children(0).checked=true then
  mytable.rows(i).cells(4).innerHTML=strHTML
 end if
next
End Function
 
Function tb_add_onclick()
checkValue()
if tipinfo.innertext="结果输出" then
ccdate=CYY.value&"-"&CMM.value&"-"&CDD.value
strHTML="<font color=red title=点击取消添加 style='cursor: hand' onclick="
strHTML=strHTML&"mytable.deleterow(me.parentelement.parentelement.rowindex)>待添加</font>"
addRow getid,cnum.value,ctype.value,ccdate,strHtml
Add_select_item(ctype.value)
end if
End Function
Function tb_query_onclick()
msgbox "此项功能停止开发!",vbinformation+0,"温馨提示"
End Function
Function RegExpTest(patrn,strng,info)      '建立正则表达式
    Dim regEx, retVal
    Set regEx = New RegExp
         regEx.Pattern = patrn
         regEx.IgnoreCase = False
         retVal = regEx.Test(strng)
    If not retVal Then
            RegExpTest="<font color=red>Error:</font>"&info
    End If
End Function
Function checkValue()
CL="<font color=green>"
str=CL&"『年份』应输入以2开头的四位整数</font></br>"
strHTML="<legend>结果输出</legend>"
strHTML=strHTML&RegExpTest("^[2]\d{3}$",CYY.value,str)
strHTML=strHTML&RegExpTest("^[1-9]\d{0,}$",Cnum.value,CL&"『金额』应为100000以内正整数</font>")
if len(Ctype.value)>7 or len(Ctype.value)<1 then 
   strHTML=strHTML&CL&"<font color=red>Error:</font>『消费项目』长度不超过6字符</font>"
end if
Tipinfo.innerhtml=strHTML
End Function
Function CT()
dim CTT,Tmoney,strT,strM,strY,showFlag,CCtype,DDstr,money,CCYY,CCMM,strHTML
CTT=0
Tmoney=0
if cntype.value="all" then 
 CTT=CTT+1
 strT=""
else
 strT="在 <font color=red>"&cntype.value&"</font> 上"
end if 
if cnmm.value="all" then 
 CTT=CTT+1
 strM=""
else
 strM="<font color=Green>"&cnmm.value&"</font> 月"
end if
if cnyy.value="all" then 
 CTT=CTT+1
 strY=""
else 
 strY="<font color=Blue>"&cnyy.value&"</font> 年 "
end if
for i=1 to mytable.rows.length-1 
 showFlag=CTT
 CCtype=mytable.rows(i).cells(2).innertext
 DDstr=split(mytable.rows(i).cells(3).innertext,"-")
 money=int(mytable.rows(i).cells(1).innertext)
 CCYY=DDstr(0)
 CCMM=DDstr(1)
 if cntype.value=CCtype then showFlag=showFlag+1
 if cnmm.value=CCMM then showFlag=showFlag+1
 if cnyy.value=CCYY then showFlag=showFlag+1
 if showFlag>=3 then 
  mytable.rows(i).style.display="block"
  Tmoney=Tmoney+money
 else
  mytable.rows(i).style.display="none"
 end if
next
strHTML="<legend>结果输出</legend></br>"
strHTML=strHTML&strY&strM&strT&" 花费总额为： <font color=Green>"&Tmoney&"</font> 元"
Tipinfo.innerhtml=strHTML
End Function
Function Add_select_item(text)
if instr(Select_List,text)=0 then
Select_List=Select_List&","&text 
set obj=document.createElement("option") 
obj.value=text
obj.text=text
cntype.add obj
end if
End Function
Function selectall_onclick()
if selectall.checked then
 selectall.title="全不选"
else
 selectall.title="全选"
end if
for i=1 to mytable.rows.length-1 
 if mytable.rows(i).style.display<>"none" then 
  mytable.rows(i).cells(0).children(0).checked=selectall.checked
 end if
next
End Function
Function change_bgcolor()
me.className="new_row_add"
me.title="点击(取消)选择此项"
End Function
Function back_bgcolor()
me.className="row_add"
End Function
Function chooseThis()
if me.cells(0).children(0).checked=true then
 me.cells(0).children(0).checked=false
else
 me.cells(0).children(0).checked=true
end if
End Function
</script>
<!--//////////版面设计区////////////-->
<title>消费记录程序</title>
<body topmargin="2" rightmargin="0" leftmargin="0" oncontextmenu=self.event.returnvalue=false>
<table id="table" cellpadding="3" cellspacing="5">
    <tr>
      <td width="75%" valign="top-center" rowspan=3 class="td">
<TABLE ID="header" cellSpacing=1  cellPadding=0 width="100%" align=center border=0>
<TR>
<TD class=top colSpan=5 height=20">
 <select id=cnyy onchange="CT()">   
 <option value="all">全部</option>  
 <option value="2008">2008</option>   
 <option value="2009">2009</option>
 </select>
消费一览表</TD>
<TR>
<TD width=81 class="header"><input type=checkbox id=selectall title="全选"></TD>
<TD width=121 class="header">金额</TD>
<TD width=100 class="header">
 <div style="position:relative;" title="支持下拉查询">   
 <span style="margin-left:59px;width:16px;overflow:hidden;margin-top:-10;height:18">   
 <select style="width:75px;margin-left:-57px;" id=cntype onchange="CT()">
        <option value="all">全部</option>
 </select></span>
        <p style="width:60px;position:absolute;left:0px;margin-top:-3">消费项目</p>
 </div>
</TD>
<TD width=100 class="header">
 <div style="position:relative;" title="支持下拉查询">   
 <span style="margin-left:59px;width:16px;overflow:hidden;margin-top:-10;height:18">   
 <select style="width:75px;margin-left:-57px;" id=cnmm onchange="CT()">  
 <option value="all">全部</option>  
 <option value="1">一月</option>   
 <option value="2">二月</option>
 <option value="3">三月</option>   
 <option value="4">四月</option>
 <option value="5">五月</option>   
 <option value="6">六月</option>
 <option value="7">七月</option>   
 <option value="8">八月</option>
 <option value="9">九月</option>   
 <option value="10">十月</option>
 <option value="11">十一月</option>   
 <option value="12">十二月</option>
 </select></span>
        <p style="width:60px;position:absolute;left:0px;margin-top:-3">消费日期</p>
 </div>
</TD>
<TD width=110 class="header">备注</TD>
<TD width="20" class="header"></TD></TR></TABLE>
<div class="div_class">
<TABLE name="mytable" id="mytable" cellSpacing=1 cellPadding=0 width=100%>
<TR title="这一行只是演示，所有数据不保存">
<TD width=80 class="row_model"><input type=checkbox disabled></TD>
<TD width=100 class="row_model">100000</TD>
<TD width=150 class="row_model">赌博的下场</TD>
<TD width=140 class="row_model">2008-10-30</TD>
<TD width=100 class="row_model">正常(演示)</TD>
</TABLE></div>
      </td>
      <td width="24%" height=120>
 <fieldset style="height=120;" class=proginfo id=Tipinfo>
 <legend>程序说明</legend>
        本作品立足原作品，有较大改进：</br>
 1.程序界面：优化控件布局，美化界面</br>
 2.数据保存方式：以xml形式保存数据，更方便更安全</br>
 </fieldset>
     </td>
    </tr>
    <tr>
       <td height=42>
 <fieldset style="height:42;text-align:center;font-size=12px">
 <legend>消费设置
</legend>
 <div style="position:relative;">
 <span style="margin-left:90px;width:18px;overflow:hidden;">  
 <select style="width:72px;margin-left:-57px" onchange="Ctype.value=me.value">   
 <option value="饮食">饮食</option>   
 <option value="娱乐">娱乐</option>   
 <option value="其它">其它</option>   
 </select></span>
        <input name="Ctype" value="饮食" onmouseover=me.select style="width:58px;position:absolute;left:34px;" title="消费类型,可以自定义输入">
 <div style="position:absolute;left:4px;padding-top:3">项目:</div> 
 </div>
 <input type=text size=4 name=CYY class=text title="年份，如：2008">-
 <input type=text size=1 name=CMM class=text title="月份，如：8">-
 <input type=text size=1 name=CDD class=text title="日期，如：8">
 消费:<input type=text value="100" size=5 name=Cnum onmouseover=me.select title="消费金额"> 元</br>
 </fieldset>
        </td>
    </tr>
   
    <tr>
       <td height=100>
 <fieldset style="height:100;text-align:center">
 <legend>控制菜单</legend>
 <div class="div_button">
 <input type=submit value="添加记录" class="button" id=tb_add></div>
 <div class="div_button">
 <input type=submit value="删除记录" class="button" id=tb_del></div>
 <div class="div_button">
 <input type=submit value="保存修改" class="button" onclick=savetofile></div>
 <div class="div_button">
 <input type=submit value="查询数据" class="button" id=tb_query></div>
 </fieldset>
        </td>
    </tr>
</table>
<div class="bottom">code by <a href=http://www.2laoshi.cn title=访问我的博客>2laoshi</a></div>
</body>COPY

PS：此版本没有自动分页显示功能，但数据查询相比较快，因另一版本功能尚不稳定，待测ing;

qgzhangying

我是菜鸟，我来学习，谢谢你们！