frmlog.frm

一个用VB写的财务软件源码

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Begin VB.Form frmLog 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "上机日志"
   ClientHeight    =   6870
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   10815
   Icon            =   "frmLog.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6870
   ScaleWidth      =   10815
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   WhatsThisButton =   -1  'True
   WhatsThisHelp   =   -1  'True
   Begin VB.CommandButton cmdDelete 
      Caption         =   "清除日志(&L)"
      Enabled         =   0   'False
      Height          =   345
      Left            =   9240
      TabIndex        =   6
      Top             =   40
      Width           =   1545
   End
   Begin VB.CommandButton cmdClear 
      Caption         =   "清除显示(&C)"
      Enabled         =   0   'False
      Height          =   345
      Left            =   7440
      TabIndex        =   4
      Top             =   40
      Width           =   1545
   End
   Begin VB.CommandButton cmdFilter 
      Caption         =   "范围筛选(&F)"
      Height          =   345
      Left            =   5640
      TabIndex        =   3
      Top             =   40
      Width           =   1545
   End
   Begin MSComctlLib.ProgressBar pBr 
      Height          =   270
      Left            =   20
      TabIndex        =   1
      Top             =   6550
      Width           =   7950
      _ExtentX        =   14023
      _ExtentY        =   476
      _Version        =   393216
      Appearance      =   0
   End
   Begin MSComctlLib.StatusBar sBr 
      Align           =   2  'Align Bottom
      Height          =   375
      Left            =   0
      TabIndex        =   0
      Top             =   6495
      Width           =   10815
      _ExtentX        =   19076
      _ExtentY        =   661
      _Version        =   393216
      BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} 
         NumPanels       =   2
         BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Object.Width           =   14041
            MinWidth        =   14041
         EndProperty
         BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
         EndProperty
      EndProperty
   End
   Begin MSComctlLib.ListView lvwLog 
      Height          =   6070
      Left            =   0
      TabIndex        =   5
      Top             =   425
      WhatsThisHelpID =   52
      Width           =   10815
      _ExtentX        =   19076
      _ExtentY        =   10716
      LabelEdit       =   1
      LabelWrap       =   -1  'True
      HideSelection   =   0   'False
      FullRowSelect   =   -1  'True
      _Version        =   393217
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      NumItems        =   0
   End
   Begin VB.Label lblRange 
      AutoSize        =   -1  'True
      Height          =   180
      Left            =   45
      TabIndex        =   2
      Top             =   120
      Width           =   90
   End
End
Attribute VB_Name = "frmLog"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim frmF As frmLogFilter
Dim bLoadfrmF As Boolean
Dim m_sDelete As String


Private Sub cmdClear_Click()
    lvwLog.ListItems.Clear
    sBr.Panels(2).text = ""
    cmdClear.Enabled = False
    cmdDelete.Enabled = False
End Sub

Private Sub cmdDelete_Click()
    Dim adoCmd As ADODB.Command
    
    If MsgBox("确实要删除所选范围的日志吗？", vbQuestion + vbYesNo) = vbYes Then
        If m_sDelete = "" Then
            If MsgBox("当前选择的范围是所有日志，是否全部删除？", _
                    vbQuestion + vbYesNo) = vbNo Then
                Exit Sub
            End If
        End If
        Set adoCmd = New ADODB.Command
        With adoCmd
            .ActiveConnection = gloSys.cnnSys
            .CommandType = adCmdText
            .CommandText = "DELETE FROM tSYS_Manage" & _
                IIf(m_sDelete = "", "", " WHERE " & m_sDelete)
            .Execute
            Call cmdClear_Click
        End With
    End If
                    
End Sub

Private Sub cmdFilter_Click()
    Dim sCondition As String
    Dim sTemp As String
    
    If Not bLoadfrmF Then
        Set frmF = New frmLogFilter
        Me.MousePointer = vbHourglass
        Load frmF
        Me.MousePointer = vbDefault
        bLoadfrmF = True
    End If
    
    frmF.Show 1, Me
    
    If frmF.OK Then
        sCondition = frmF.usQuery
        m_sDelete = frmF.usDelete
        '如果 m_sCondition 不为空，则它不带前后空格及可能的"WHERE"与"AND"
        lvwLog.ListItems.Clear
        sTemp = "select A.ComputerName as COMPU,B.SubSysName as SUBSY," & _
                "C.UserName as USERN,D.AccountName as ACCOU,A.AccountYear as AYEAR," & _
                "A.LoginDateTime as LOGDT,A.AccountID as AAID," & _
                "A.UserID as AUID" & _
                " from tSYS_Manage A,tSYS_SubSys B,tSYS_User C,tSYS_Account D" & _
                " where A.SubSysID=B.SubSysID and A.UserID=C.UserID and" & _
                " A.AccountID=D.AccountID" & _
                IIf(sCondition = "", "", " and " & sCondition) & _
                " order by 1,2,3,4,5,6"
        Me.MousePointer = vbHourglass
        Call FillLog(sTemp)
        Me.MousePointer = vbDefault
        cmdClear.Enabled = True
        cmdDelete.Enabled = True
    Else
        m_sDelete = ""
    End If
    
'    If m_sCondition <> "" Then
'    End If
    
End Sub




Private Sub Form_Load()
    
    With lvwLog
        .View = lvwReport
        With .ColumnHeaders
            .Add , , "流水号", 800
            .Add , , "运行机器", 1400
            .Add , , "子系统", 1500
            .Add , , "操作员", 1300
            .Add , , "账套", 1800
            .Add , , "会计年度", 1200
            .Add , , "进入时间", 2000
        End With
    End With
            
End Sub

Private Sub Form_Unload(Cancel As Integer)
    bLoadfrmF = False
End Sub




Private Sub FillLog(ByVal sSql As String)
    Dim ItmX As ListItem
    Dim rstTemp As ADODB.Recordset
    Dim i As Long, k As Long
    
    Set rstTemp = New ADODB.Recordset
    With rstTemp
        .CursorLocation = adUseClient
        .Open sSql, gloSys.cnnSys, adOpenStatic, adLockReadOnly
        If .RecordCount <> 0 Then
            pbr.Value = 0
            pbr.Visible = True
            i = 0
            k = 0
            Do Until .EOF
                k = k + 1
                Set ItmX = lvwLog.ListItems.Add(, , k)
                ItmX.SubItems(1) = .Fields("COMPU").Value
                ItmX.SubItems(2) = .Fields("SUBSY").Value
                ItmX.SubItems(3) = .Fields("USERN").Value & "(" & .Fields("AUID").Value & ")"
                ItmX.SubItems(4) = .Fields("ACCOU").Value & "(" & .Fields("AAID").Value & ")"
                ItmX.SubItems(5) = .Fields("AYEAR").Value
                ItmX.SubItems(6) = Format(.Fields("LOGDT").Value, "yyyy-MM-dd hh:mm:ss")
                pbr.Value = .AbsolutePosition / .RecordCount * 100
                sBr.Panels(2).text = .AbsolutePosition & " / " & .RecordCount
                i = i + 1
                If i = 100 Then
                    lvwLog.Refresh
                    i = 0
                End If
                .MoveNext
            Loop
            pbr.Visible = False
        Else
            sBr.Panels(2).text = "0 / 0"
        End If
        .Close
    End With
    
End Sub