操作日志模块.

laiguiyou

有一个问题,为什么在有的窗体中调用了这个函数,就会经常出要求重新登陆,假如在窗体中删除事件中调用,在删除前有时会经常出现"请登陆系统"的提示,有时又不会,好象是隔的时间长一些就会出现. If GuserID = 0 Then.但登陆窗体并没有关闭啊.百思不得其解.

以下是摘自一位前辈的一个操作日志模块.

Option Compare Database
Option Explicit
Public checksub As Boolean
Public GuserID As Integer

Public Function insertLogo(ByVal strDescription As String)

    On Error GoTo Err

    If GuserID = 0 Then
         Msgbox "请登陆系统!", vbQuestion
         DoCmd.OpenForm "frmlogin"
    Else
        Dim conn As ADODB.Connection
        Set conn = CurrentProject.Connection

        Dim rst As New ADODB.Recordset

        Dim strSQL As String

        strSQL = "SELECT 计算机名, 操作员, 操作描述 FROM 操作日记"
        rst.Open strSQL, conn, adOpenKeyset, adLockOptimistic

        rst.AddNew

        rst("计算机名") = fOSMachineName()
        rst("操作员") = GuserID
        rst("操作描述") = strDescription

        rst.Update

        rst.Close
        Set rst = Nothing

        Set conn = Nothing
    End If
    Exit Function

Err:
    Msgbox Err.Number & Err.Description

End Function

这是登陆窗体登陆按钮的事件过程:

Private Sub CmdOK_Click()

'Call insertLogo("登陆系统")


Dim RecCount, RecNo, RecRate
    RecCount = 500
    For RecNo = 1 To RecCount
        RecRate = Int((RecNo / RecCount) * 100)
        进度.Caption = CStr(RecRate) & "%"
        进度.Width = Int(长度.Width * (RecRate / 100))
        Me.Repaint
    Next

  
    If Not IsNull(TxtPassword) And StrComp(Me.TxtPassword, Me.Password, vbBinaryCompare) = 0 Then
         GuserID = Me.username
        ' username2 = Me.username.Column(1)
        Me.Visible = False
        IsLoginError = True
    Else
        Msgbox "密码错误，请重新输入！", vbOKOnly + vbExclamation, SoftName
        Me.TxtPassword.SetFocus
        Me.TxtPassword = ""
        IsLoginError = False
        GoTo ErrorLab
        
    End If
    If IsLoginError Then
        If IsLoaded1("frmMain") Then
            Forms("frmMain").WelcomeTo.Caption = "当前用户，" & Forms("frmLogin").username.Column(1) & " 双击重新登陆"
            Forms("frmMain").SysDate.Caption = Format(WorkDate, "当前日期:yy-mm-dd")
            Forms("frmMain").SysDate.Tag = Format(WorkDate, "yy-mm-dd")
        Else
            DoCmd.OpenForm "frmMain"
             GuserID = Me.username
           ' username2 = Me.username.Column(1)
            Forms("frmMain").WelcomeTo.Caption = "当前用户，" & Forms("frmLogin").username.Column(1) & " 双击重新登陆"
            Forms("frmMain").SysDate.Caption = Format(WorkDate, "当前日期:yy-mm-dd")
            Forms("frmMain").SysDate.Tag = Format(WorkDate, "yy-mm-dd")
        End If
    End If
     
ErrorLab:
    Exit Sub
End Sub

[此贴子已经被作者于2006-12-28 8:04:50编辑过]

laiguiyou

laiguiyou

自已顶

文棣

看看 是啥

p51218

好好好