消费记录程序(hta+xml)(页 1) - VBS原创&转载 - 批处理之家 BAT,CMD,批处理,PowerShell,VBS,DOS

youxi01 发表于 2008-10-2 19:11

消费记录程序(hta+xml)

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

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

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

[attach]416[/attach]

[color=red]3、下载：[/color]
[attach]417[/attach]

[color=red]4、源代码：[/color][code]

<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>
[/code]PS：此版本没有自动分页显示功能，但数据查询相比较快，因另一版本功能尚不稳定，待测ing;

qgzhangying 发表于 2009-4-30 16:28

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

页: [1]

批处理之家's Archiver

消费记录程序(hta+xml)