module1.bas

该软件（教师住房管理系统）能实现如下功能： 基本信息录入 基本信息浏览 基本查询 分类查询 查基本信息的添加、删除修改。分房申请信息的录入及平分 分房处理 报表生成 打印功能 帮助

Attribute VB_Name = "Module1"
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''                    教师住房管理系统   Version 1.0                    '''
'''                         （VB6.0 源代码）                             '''
'''                                                                      '''
'''                        俊彦软件工作室出品                            '''
'''                                                                      '''
'''            （浦口校区科技节“电子杯”程序设计大赛参赛作品）          '''
'''                                                                      '''
'''                程序设计：东南大学土木工程学院   周曹俊               '''
'''                                                                      '''
'''                 CopyRight AllRights Reserved (c)2003                 '''
'''                                                                      '''
'''                         2003年5月15日                                '''
'''                                                                      '''
'''                                                                      '''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Public db As Database, db2 As Database, rs1 As Recordset, rs2 As Recordset, qr As QueryDef, qr2 As QueryDef
Public Const SYSTITLE As String = "教师住房管理系统 V1.0"
Public Function deypt(strkey) As String
'数据库密码加密函数
Dim i As Integer, strtmp As String
deypt = ""
For i = 1 To Len(strkey)
    strtmp = Mid$(strkey, i, 1)
    deypt = deypt & Chr(((Asc(strtmp) - 32) * 19) Mod 94 + 33)
Next
End Function
Public Sub browserpre(node As node)
'浏览信息函数
Dim i As Integer
Dim rs As Recordset, rst As Recordset, qrt As QueryDef, qr As QueryDef
i = 1
If node.Key Like "c*" Then
    '构造参数查询，以加快查询速度
    Set qr = db.CreateQueryDef("")
    qr.SQL = "parameters intid string;select * from host where id=intid"
    qr!intid = node.Text
    If rs Is Nothing Then
        Set rs = qr.OpenRecordset()
    Else
        rs.Requery qr
    End If
With frminfo
     .Mask2.Text = rs!id
     .Text1.Text = rs!Name
     .Combo1.Text = rs!sex
     If rs!married Then
         .Option1(0).Value = True
     Else
         .Option1(1).Value = True
     End If
     .DTPicker1.Value = rs!birth
     .DTPicker2.Value = rs!workdate
     .Combo2.Text = rs!zc
     .Combo3.Text = rs!xl
     .Combo4.ListIndex = rs!livedgr - 1
     .Text2.Text = rs!livearea
     .DTPicker3.Value = rs!indate
End With
'同样，构造参数查询，以加快查询速度
Set qrt = db.CreateQueryDef("")
qrt.SQL = "parameters intid string;select * from member where id=intid"
qrt!intid = node.Text
If rst Is Nothing Then
    Set rst = qrt.OpenRecordset()
Else
    rst.Requery qrt
End If
With frminfo.MSFlexGrid1
 If Not rst.EOF Then
    rst.MoveFirst
    Do Until rst.EOF
            .TextMatrix(i, 0) = rst!Name
            .TextMatrix(i, 1) = rst!sex
            .TextMatrix(i, 2) = rst!Relation
            .TextMatrix(i, 3) = Format(rst!birth, "yyyy年MM月")
        i = i + 1
        rst.MoveNext
    Loop
 End If
End With
frminfo.Command4.Enabled = True
frminfo.Command5.Enabled = True
frmMDI.Toolbar1.Buttons(5).Enabled = True
frmMDI.Toolbar1.Buttons(6).Enabled = True
frmMDI.kill.Enabled = True
frmMDI.edit.Enabled = True
Else
frminfo.Command4.Enabled = False
frminfo.Command5.Enabled = False
frmMDI.Toolbar1.Buttons(5).Enabled = False
frmMDI.Toolbar1.Buttons(6).Enabled = False
frmMDI.kill.Enabled = False
frmMDI.edit.Enabled = False
End If
End Sub

Public Sub treenode(node As node)
Dim strindex As String, strtmp(1 To 7) As String
Dim rstable As Recordset
Dim listx As ListItem
strtmp(1) = "分居在集体宿舍": strtmp(2) = "一室": strtmp(3) = "一室一厅": strtmp(4) = "二室": strtmp(5) = "二室一厅": strtmp(6) = "三室": strtmp(7) = "三室一厅"
strindex = Right(frmtree2.TreeView1.SelectedItem.Key, 1)
frmlist.ListView1.ListItems.Clear
frmlist.Frame2.Caption = ""
If frmtree2.TreeView1.SelectedItem.Key Like "r*" Then
    Set rstable = db2.OpenRecordset("select * from " & strindex & " order by zf desc")
    If Not rstable.EOF Then
        rstable.MoveFirst
        If rstable!newid <> "" Then
            frmlist.Command5.Enabled = True
            frmlist.Command1.Enabled = True
            frmlist.Command2.Enabled = False
            frmlist.Command3.Enabled = True
            frmlist.Command4.Enabled = True
            frmlist.Command5.Caption = "查看分房记录(&V)"
            frmMDI.deal.Enabled = False
        Else
            frmlist.Command5.Enabled = True
            frmlist.Command1.Enabled = True
            frmlist.Command2.Enabled = True
            frmlist.Command3.Enabled = True
            frmlist.Command4.Enabled = True
            frmlist.Command5.Caption = "开始分房(&S)"
            frmMDI.deal.Enabled = True
        End If
        frmMDI.Toolbar1.Buttons(13).Enabled = True
        frmMDI.Toolbar1.Buttons(14).Enabled = True
        frmMDI.preview.Enabled = True
        frmMDI.pnt.Enabled = True
    Else
        frmlist.Command1.Enabled = False
        frmlist.Command2.Enabled = False
        frmlist.Command3.Enabled = False
        frmlist.Command4.Enabled = False
        frmlist.Command5.Caption = "开始分房(&S)"
        frmlist.Command5.Enabled = False
        frmMDI.Toolbar1.Buttons(13).Enabled = False
        frmMDI.Toolbar1.Buttons(14).Enabled = False
        frmMDI.preview.Enabled = False
        frmMDI.pnt.Enabled = False
        frmMDI.deal.Enabled = False
    End If
    Do Until rstable.EOF
        Set listx = frmlist.ListView1.ListItems.add(, rstable!id, rstable!id, 1)
        With rstable
            listx.SubItems(1) = !id
            listx.SubItems(2) = !Name
            listx.SubItems(3) = !zc
            listx.SubItems(4) = Format(!birth, "yyyy年MM月")
            listx.SubItems(5) = Format(!workdate, "yyyy年MM月")
            listx.SubItems(6) = !xl
            listx.SubItems(7) = strtmp(!livedgr)
            listx.SubItems(8) = Format(!zcf, "0.00")
            listx.SubItems(9) = Format(!glf, "0.00")
            listx.SubItems(10) = Format(!nlf, "0.00")
            listx.SubItems(11) = Format(!xlf, "0.00")
            listx.SubItems(12) = Format(!zf, "0.00")
        End With
        rstable.MoveNext
    Loop
    frmlist.Frame2.Caption = "申请" & Chr(34) & strtmp(strindex + 1) & Chr(34) & "的住户信息一览表（按总分由高到低排列）"
    
Else
    frmlist.Command1.Enabled = False
    frmlist.Command2.Enabled = False
    frmlist.Command3.Enabled = False
    frmlist.Command4.Enabled = False
    frmlist.Command5.Enabled = False
    frmlist.Command5.Caption = "开始分房(&S)"
    frmMDI.Toolbar1.Buttons(13).Enabled = False
    frmMDI.Toolbar1.Buttons(14).Enabled = False
    frmMDI.preview.Enabled = False
    frmMDI.pnt.Enabled = False
    frmMDI.deal.Enabled = False
End If
End Sub

Public Sub Main()
Load frmSplash
frmSplash.Show
End Sub

Public Sub clearfrminfo()
'清空基本信息窗口
With frminfo
    .Text1 = ""
    .Text2 = ""
    .Mask2.Mask = ""
    .Mask2.Text = ""
    .Mask2.Mask = "?###"
    .DTPicker1.Value = Year(Now) & "年" & Month(Now) & "月"
    .DTPicker2.Value = Year(Now) & "年" & Month(Now) & "月"
    .Combo1.ListIndex = -1
    .Combo2.ListIndex = -1
    .Combo3.ListIndex = -1
    .Combo4.ListIndex = -1
    .MSFlexGrid1.Clear
    .MSFlexGrid1.TextMatrix(0, 0) = "姓名"
    .MSFlexGrid1.TextMatrix(0, 1) = "性别"
    .MSFlexGrid1.TextMatrix(0, 2) = "与户主关系"
    .MSFlexGrid1.TextMatrix(0, 3) = "出生年月"
End With
End Sub

Public Sub frmedit()
Dim strid As String, i As Integer, j As Integer
On Error GoTo errhdl
i = 1
With frminfo
strid = .Mask2.Text
Dim rs2 As Recordset, rs3 As Recordset
Set rs2 = db.OpenRecordset("select * from host where id='" & strid & "'")
Set rs3 = db.OpenRecordset("select * from member where id='" & strid & "'")
Static boledit As Boolean
If boledit = False Then
    .Frame1.Enabled = True
    .Command5.Caption = "更新(&R)"
    .Mask2.SetFocus
Else
    .Frame1.Enabled = False
    .Command5.Caption = "修改(&E)"
    If Trim(.Mask2.Text) = "" Then
        MsgBox "住号不能为空！", vbCritical + vbOKOnly, ""
        .Mask2.SetFocus
        Exit Sub
    End If
    '数据有效性检查
    If Trim(.Text1.Text) = "" Then
        MsgBox "户主姓名不能为空！", vbCritical + vbOKOnly, ""