module1.bas

员工个人信息管理

Attribute VB_Name = "ModMain"
Option Explicit
Public g_DBCon As New ADODb.Connection
Public g_DBRct As New ADODb.Recordset
Public gUserName As String
Public gFileName As String
Public gSuperUser As Boolean

Sub main()
    ChDrive ("C")
    'If Dir("C:\UserPWD.dat", vbReadOnly) = Empty Then
    If Dir("C:\UserPWD.txt", vbReadOnly) = Empty Then   '"...\abc\"
        FrmSuperClient.Show
    Else
        If ConnectToServer = False Then End
        FrmLogin.Show
    End If
End Sub

'=================================================
'保存数据函数
'=================================================
Public Function WriteInfoToText(ByVal EMPNumber As String, _
                                ByVal EMPName As String, _
                                ByVal EMPAge As String, _
                                ByVal EMPDate As String, _
                                ByVal EMPAddress As String) As Boolean
    Dim lngFH As Long
End Function

'=================================================
'密码查找函数
'=================================================
Public Function LoginIn(ByVal gmUserName As String, ByVal gmUserPWD As String) As Boolean
Dim UserName As String
Dim UserPWD As String
Dim lngFH As Long
    
    lngFH = FreeFile
    'Open "c:\UserPWD.dat" For Input As #lngFH
    Open "c:\UserPWD.txt" For Input As #lngFH
    Line Input #lngFH, UserName
    If UserName = Empty Then
        Line Input #lngFH, UserName
        Line Input #lngFH, UserPWD
        If UserName = gmUserName Then
            If UserPWD = gmUserPWD Then
                LoginIn = True
                gSuperUser = True
                gUserName = gmUserName
                Close #lngFH
                Exit Function
            Else
                LoginIn = False
            End If
        End If
    End If
    Do While Not EOF(lngFH)
         Line Input #lngFH, UserName
         If UserName = Empty Then
            Line Input #lngFH, UserName
            Line Input #lngFH, UserPWD
            If UserName = gmUserName Then
                If UserPWD = gmUserPWD Then
                    LoginIn = True
                    gSuperUser = False
                    gUserName = gmUserName
                    Close #lngFH
                    Exit Function
                Else
                    LoginIn = False
                End If
            End If
        End If
    Loop
    Close #lngFH
End Function
'=================================================
'用户名查找函数
'=================================================
Public Function FoundUserName(ByVal InputUserName) As Boolean
Dim StrTemp As String
Dim lngFH As Long
    
    lngFH = FreeFile
    'Open "c:\UserPWD.dat" For Input As #lngFH
    Open "c:\UserPWD.txt" For Input As #lngFH
    Do While Not EOF(lngFH)
        Line Input #lngFH, StrTemp
        If StrTemp = Empty Then
            Line Input #lngFH, StrTemp
            If StrTemp = InputUserName Then
                FoundUserName = True
                Close #lngFH
                Exit Function
                
            End If
        End If
    Loop
    FoundUserName = False
    Close #lngFH
End Function

'=================================================
'用户名修改函数
'=================================================
Public Function ModifyUid(ByVal InputUserName, ByVal inputUserPWD) As Boolean
Dim StrTemp As String
Dim lngFH As Long
    
    lngFH = FreeFile
    'Open "c:\UserPWD.dat" For Input As #lngFH
    Open "c:\UserPWD.txt" For Input As #lngFH
    Do While Not EOF(lngFH)
        Line Input #lngFH, StrTemp
        If StrTemp = Empty Then
            Line Input #lngFH, StrTemp
            If StrTemp = InputUserName Then
                
                ModifyUid = True
                Close #lngFH
                Exit Function
            End If
        End If
    Loop
    ModifyUid = False
    Close #lngFH
End Function
'=================================================
'执行SQL的函数
'=================================================
Public Function ExecuteSQL(ByVal strSQL As String) As Boolean
On Error Resume Next
    g_DBCon.Execute (strSQL)
    If Err.Number > 0 Then
        MsgBox "错误代码:" & vbCrLf & "错误描述:" & Err.Description, vbCritical, "连接错误"
        Err.Clear
        ExecuteSQL = False
    Else
        ExecuteSQL = True
    End If
End Function
'=================================================
'关闭连接的函数
'=================================================
Public Function DisConnect() As Boolean
On Error Resume Next
    If g_DBCon.State = adStateOpen Then
        g_DBCon.Close
    End If
    DisConnect = True
End Function
'=================================================
'数据库连接函数
'=================================================
Public Function ConnectToServer() As Boolean
On Error GoTo ConnectErr
    '连接到ACCESS
    g_DBCon.ConnectionString = "provider=Microsoft.jet.oledb.4.0;" & _
                            "data source=d:\EMP.MDB;" & _
                            "mode=ReadWrite"
    g_DBCon.ConnectionTimeout = 30
    g_DBCon.Open
    ConnectToServer = True
    Exit Function
    
ConnectErr:
    ConnectToServer = False
    MsgBox "错误代码:" & Err.Number & vbCrLf & "错误描述:" & Err.Description, vbCritical, "连接错误"
End Function
'CREATE TABLE ManageList (Mname CHAR(32),MPWD CHAR(16))
'CREATE TABLE EMPLIST (ENumber Char(32) PRIMARY KEY,Ename CHAR(16),Eage int,Edate CHAR(32),Eadress CHAR(128))
'=================================================
'创建数据库表的函数
'=================================================
Public Function IniDB() As Boolean
On Error GoTo ON_DBERR
    'ENumber,EName,EAge,EDate,EAddress
    g_DBCon.Execute ("CREATE TABLE ManageList (Mname CHAR(32),MPWD CHAR(16))")
    g_DBCon.Execute ("CREATE TABLE EMPLIST (ENumber Char(32) PRIMARY KEY,EName CHAR(16),EAge int,EDate CHAR(32),EAddress CHAR(128))")
    IniDB = True
    Exit Function
    
ON_DBERR:
    MsgBox "错误代码:" & Err.Number & vbCrLf & "错误描述:" & Err.Description, vbCritical, "错误"
    IniDB = False
    FrmMain.mnuIniDB.Enabled = False
End Function
'=================================================
'提供数据库查询
'=================================================
Public Function QueryEmpInfo(ByVal strSQL As String) As Boolean
On Error GoTo ON_QUERYERR
    Set g_DBRct = Nothing
Call g_DBRct.Open(strSQL, g_DBCon, adOpenDynamic, adLockBatchOptimistic, -1)
    QueryEmpInfo = True
    Exit Function
    
ON_QUERYERR:
    MsgBox "错误代码:" & Err.Number & vbCrLf & "错误描述:" & Err.Description, vbCritical, "错误"
    QueryEmpInfo = False
End Function