📄 mdldiary.bas
字号:
Attribute VB_Name = "mdlDiary"
Option Base 1
Public Type RecDiary '定义记录
fldDate As String * 12
fldMemo As String * 1000
End Type
Public gsSql As String * 10
Public gsPath As String
Public giRecordCount As Integer '记录总数
Public giCurrentRecord As Integer '当前记录
Public goDiary As RecDiary '定义自定定类
Public goDiarys() As RecDiary '定义数组
Public gbFirst As Boolean
'------- ^^目的:访问注册表,验证密码.^^-----------------
Public Sub InitalizeData() '初始化数据
On Error Resume Next
Dim iFreefile%, I%
iFreefile = FreeFile()
Open gsPath & "DATA.DAT" For Random As #iFreefile Len = Len(goDiary)
giRecordCount = LOF(iFreefile) / Len(goDiary)
ReDim goDiarys(giRecordCount)
For I = 1 To giRecordCount
Get #iFreefile, I, goDiarys(I)
Next
Close #iFreefile
End Sub
Public Sub ReadData(curRecord As Integer) '读取数据
On Error Resume Next
Dim strcaption$
riji.txtDate = goDiarys(curRecord).fldDate
riji.txtMemo = goDiarys(curRecord).fldMemo
strcaption = "每日一记 [" & Date & "] " & Time & " " & WeekdayName(Weekday(Date)) & " 记录:" & giCurrentRecord & "/" & giRecordCount
riji.Caption = strcaption
End Sub
Public Function FindData(sql As String) As Boolean '查询数据
On Error Resume Next
Dim I%
For I = 1 To giRecordCount
If goDiarys(I).fldDate = sql Then
giCurrentRecord = I
FindData = True
Exit For
End If
Next
ReadData giCurrentRecord
End Function
Public Function WriteData() As Boolean '新增数据
On Error Resume Next
Dim iFreefile%, I%
iFreefile = FreeFile()
Open gsPath & "DATA.DAT" For Random As #iFreefile Len = Len(goDiary)
ReDim Preserve goDiarys(giRecordCount)
goDiarys(giRecordCount).fldDate = frminput.txtDate
goDiarys(giRecordCount).fldMemo = frminput.txtMemo
goDiary = goDiarys(giRecordCount)
Put #iFreefile, giRecordCount, goDiary
giCurrentRecord = giRecordCount
ReadData (giCurrentRecord)
Close #iFreefile
WriteData = True
End Function
Public Function ModifyData() As Boolean '修改数据
On Error Resume Next
Dim iFreefile%, I%
iFreefile = FreeFile()
Open gsPath & "DATA.DAT" For Random As #iFreefile Len = Len(goDiary)
goDiarys(giCurrentRecord).fldDate = frminput.txtDate
goDiarys(giCurrentRecord).fldMemo = frminput.txtMemo
goDiary = goDiarys(giCurrentRecord)
Put #iFreefile, giCurrentRecord, goDiary
ReadData (giCurrentRecord)
Close #iFreefile
ModifyData = True
End Function
Public Sub DeleteData() '删除数据
On Error Resume Next
Dim iFreefile%, I%, J%
I = 1: J = 1
iFreefile = FreeFile()
Open gsPath & "temp.dat" For Random As #iFreefile Len = Len(goDiary)
goDiarys(giCurrentRecord).fldMemo = "IWantToKillIt*" & goDiarys(giCurrentRecord).fldMemo '加删除标记
For I = 1 To giRecordCount '无删除标记的记录,保存到临时文件,TEMP.DAT
If Left(goDiarys(I).fldMemo, 14) <> "IWantToKillIt*" Then
goDiary = goDiarys(I)
Put #iFreefile, J, goDiary '在此必须有I,J两个变量,因为使用二进制保存文件时,
J = J + 1 '从1开始到后面,中间如有间隔就会出现乱码
End If
Next
Close #iFreefile
Kill gsPath & "data.dat"
Name gsPath & "temp.dat" As gsPath & "data.dat"
riji.txtDate = ""
riji.txtMemo = ""
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -