⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 mdldiary.bas

📁 本宿舍管理系统采用VB为系统开发平台
💻 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 + -