frmclientsrecord.frm

这是一本学习串口编程喝计算机监控的好书里面是用VB开发的源代码

      Left            =   120
      TabIndex        =   28
      Top             =   840
      Width           =   1575
   End
   Begin VB.Label Label10 
      Alignment       =   2  'Center
      Caption         =   "年"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   2280
      TabIndex        =   27
      Top             =   840
      Width           =   375
   End
   Begin VB.Label Label9 
      Alignment       =   2  'Center
      Caption         =   "月  至"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   3120
      TabIndex        =   26
      Top             =   840
      Width           =   975
   End
   Begin VB.Label Label2 
      Alignment       =   2  'Center
      Caption         =   "年"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   4680
      TabIndex        =   25
      Top             =   840
      Width           =   375
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      Caption         =   "月"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   5520
      TabIndex        =   24
      Top             =   840
      Width           =   375
   End
   Begin VB.Label Label8 
      Alignment       =   2  'Center
      Caption         =   "月"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   5520
      TabIndex        =   23
      Top             =   240
      Width           =   375
   End
   Begin VB.Label Label7 
      Alignment       =   2  'Center
      Caption         =   "年"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   4680
      TabIndex        =   22
      Top             =   240
      Width           =   375
   End
   Begin VB.Label Label6 
      Alignment       =   2  'Center
      Caption         =   "月  至"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   3120
      TabIndex        =   21
      Top             =   240
      Width           =   975
   End
   Begin VB.Label Label5 
      Alignment       =   2  'Center
      Caption         =   "年"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   2280
      TabIndex        =   20
      Top             =   240
      Width           =   375
   End
   Begin VB.Label Label3 
      Alignment       =   2  'Center
      Caption         =   "①首次日期从"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   120
      TabIndex        =   19
      Top             =   240
      Width           =   1575
   End
End
Attribute VB_Name = "frmClientsRecord"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim strDateFrom1 As String
Dim strDateTo1 As String
Dim strDateFrom2 As String
Dim strDateTo2 As String
Dim nFrom As Integer
Dim nTo As Integer
Dim bPlus2 As Boolean

Private Sub GetData()
    On Error Resume Next 'CallerID
    
    strDateFrom1 = Trim(txtYearFrom1.Text) + "-" + TwoDigit(Val(txtMonthFrom1.Text)) + "-01"
    strDateTo1 = Trim(txtYearTo1.Text) + "-" + TwoDigit(Val(txtMonthTo1.Text)) + "-31"
    strDateTo1 = GetMonthEnd(strDateTo1)

    strDateFrom2 = Trim(txtYearFrom2.Text) + "-" + TwoDigit(Val(txtMonthFrom2.Text)) + "-01"
    strDateTo2 = Trim(txtYearTo2.Text) + "-" + TwoDigit(Val(txtMonthTo2.Text)) + "-31"
    strDateTo2 = GetMonthEnd(strDateTo2)
    
    nFrom = Val(txtNum1.Text)
    nTo = Val(txtNum2.Text)
End Sub

Private Sub DisableCmd()
    cmdPrintFirst.Enabled = False
    cmdPrintLast.Enabled = False
    cmdPrintTotal.Enabled = False
    cmdDel.Enabled = False
End Sub

Private Sub PrintClients(ByVal strTitle As String)
    Dim strMonth As String
    Dim strTitle1 As String
    Dim strTitle2 As String
    Dim strPrnNames As String
    Dim strTmp As String
    Dim l1 As Long
    Dim strData As String
    Dim nCount As Integer
    On Error Resume Next 'CallerID
    
    If frmMain.DG_Clients.Visible = False Then Exit Sub
    
    With frmMain.AdodcCaller.Recordset
        If .RecordCount < 1 Then
            MsgBox "此年月段没有数据！", vbExclamation + vbOKOnly, "提示"
            Exit Sub
        Else
            strTitle1 = GetNoString(strTitle, "#", 0)
            strTitle2 = NextString(strTitle, "#")
            
            .MoveFirst
            
            Do While Not .EOF
                nCount = nCount + 1
                    
                strData = strData + ts(nCount) + "," + ![Phone] + "," + _
                          ![Address] + "," + ![FirstDate] + "," + _
                          ![LastDate] + "," + ts(![Area]) + "," + _
                          ts(![Total]) + "," + _
                          IIf(IsNull(![Remark]), "", ![Remark]) + "," + strTitle1 + "," + strTitle2 + ","
                l1 = l1 + ![Total]
                    
                If nCount = .RecordCount Then
                    strData = strData + ts(nOperatorID) + "," + ts(l1)
                End If
                If Not .EOF Then strData = strData + vbCrLf
                    
                .MoveNext
            Loop
        End If
    End With
    
    WriteStringToTxt strData, App.Path + "\Clients.txt"
    strPrnNames = "序号;电话;地址;首次日期;最新日期;区域;累计;备注;标题;副标题;操作员;瓶总;"
    
    DataPrint App.Path + "\Clients.txt", App.Path + "\Clients", strPrnNames, 2
End Sub

Private Sub chk2_Click()
    If chk2.Value = 1 Then
        bPlus2 = True
    Else
        bPlus2 = False
    End If
End Sub

Private Sub cmdClear_Click()
    On Error Resume Next 'CallerID

    cmdDel.Enabled = False
    
    txtYearFrom1.Text = ""
    txtYearTo1.Text = ""
    txtMonthFrom1.Text = ""
    txtMonthTo1.Text = ""
    
    txtYearFrom2.Text = ""
    txtYearTo2.Text = ""
    txtMonthFrom2.Text = ""
    txtMonthTo2.Text = ""
    
    txtNum1.Text = ""
    txtNum2.Text = ""
    
    txtYearFrom1.SetFocus
End Sub

Private Sub cmdDel_Click()
    Dim nRet As Integer
    On Error Resume Next 'CallerID
    
    If frmMain.DG_Clients.Visible = False Then
        cmdDel.Enabled = False
        Exit Sub
    End If
    
    nRet = MsgBox("确信删除" + ts(DAYS_RESERVED) + "天之前的活动客户吗？", vbQuestion + vbYesNo, "提示")
    If nRet = 7 Then Exit Sub
    
    DeleteData frmMain.AdodcCaller, 0
    frmMain.Display_Clients
    AdjustNumber frmMain.AdodcCaller, 1
    cmdDel.Enabled = False
End Sub

Private Sub cmdInqeryFirst_Click()
    On Error Resume Next 'CallerID
    
    DisableCmd
    
    If txtYearFrom1 = "" Or txtYearTo1 = "" Or txtMonthFrom1 = "" Or txtMonthTo1 = "" Then
        MsgBox "请输入待查询的首次起止年月！", vbExclamation + vbOKOnly, "提示"
        txtYearFrom1.SetFocus
        Exit Sub
    End If
    
    GetData
    
    With frmMain.AdodcCaller
        .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + _
                          strDataPath + ";Persist Security Info=False"
        .CommandType = adCmdUnknown
        .RecordSource = "select * from Clients where [FirstDate]>='" + _
                         strDateFrom1 + "' and [FirstDate]<='" + _
                         strDateTo1 + "' order by [FirstDate]"
        .Refresh
        
        If .Recordset.RecordCount > 0 Then cmdPrintFirst.Enabled = True
    End With
End Sub

Private Sub cmdInqeryLast_Click()
    On Error Resume Next 'CallerID
    
    DisableCmd
    
    If txtYearFrom2 = "" Or txtYearTo2 = "" Or txtMonthFrom2 = "" Or txtMonthTo2 = "" Then
        MsgBox "请输入待查询的最新起止年月！", vbExclamation + vbOKOnly, "提示"
        txtYearFrom2.SetFocus
        Exit Sub
    End If
    
    GetData
    
    With frmMain.AdodcCaller
        .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + _
                          strDataPath + ";Persist Security Info=False"
        .CommandType = adCmdUnknown
        .RecordSource = "select * from Clients where [LastDate]>='" + _
                         strDateFrom2 + "' and [LastDate]<='" + _
                         strDateTo2 + "' order by [LastDate]"
        .Refresh
        
        With .Recordset
            If .RecordCount > 0 Then
                If Date - CDate(strDateTo2) > DAYS_RESERVED Then cmdDel.Enabled = True
                cmdPrintLast.Enabled = True
            End If
        End With
    End With
End Sub

Private Sub cmdInqeryTotal_Click()
    On Error Resume Next 'CallerID
    
    DisableCmd
    
    If (txtNum1 = "") Or (txtNum2 = "") Or (Val(txtNum1) < 1) Or (Val(txtNum1) > Val(txtNum2)) Then
        MsgBox "请输入合适的瓶数！", vbExclamation + vbOKOnly, "提示"
        txtNum1.SetFocus
        Exit Sub
    End If
    
    If (bPlus2 = True) And (txtYearFrom2 = "" Or txtYearTo2 = "" Or txtMonthFrom2 = "" Or txtMonthTo2 = "") Then
        MsgBox "请输入待查询的最新起止年月！", vbExclamation + vbOKOnly, "提示"
        txtYearFrom2.SetFocus
        Exit Sub
    End If
    
    GetData
    
    With frmMain.AdodcCaller
        .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + _
                          strDataPath + ";Persist Security Info=False"
        .CommandType = adCmdUnknown
        
        If bPlus2 = True Then
            .RecordSource = "select * from Clients where [LastDate]>='" + _
                             strDateFrom2 + "' and [LastDate]<='" + _
                             strDateTo2 + "' and [Total]>=" + _
                             ts(nFrom) + " and [Total]<=" + _
                             ts(nTo) + " order by [Total], [LastDate]"
        Else
            .RecordSource = "select * from Clients where [Total]>=" + _
                             ts(nFrom) + " and [Total]<=" + _
                             ts(nTo) + " order by [Total]"
        End If
        
        .Refresh
        
        If .Recordset.RecordCount > 0 Then cmdPrintTotal.Enabled = True
    End With
End Sub

Private Sub cmdPrintFirst_Click()
    On Error Resume Next 'CallerID
    
    PrintClients txtYearFrom1.Text + "年" + ts(Val(txtMonthFrom1.Text)) + "月至" + _
                 txtYearTo1.Text + "年" + ts(Val(txtMonthTo1.Text)) + "月" + " 新增客户" + _
                 "#（依据首次日期）"
End Sub

Private Sub cmdPrintLast_Click()
    On Error Resume Next 'CallerID
    
    PrintClients txtYearFrom2.Text + "年" + ts(Val(txtMonthFrom2.Text)) + "月至" + _
                 txtYearTo2.Text + "年" + ts(Val(txtMonthTo2.Text)) + "月" + " 活动客户" + _
                 "#（依据最新日期）"
End Sub

Private Sub cmdPrintTotal_Click()
    Dim strTmp1 As String
    Dim strTmp2 As String
    On Error Resume Next 'CallerID

    strTmp1 = "累计数量从 " + ts(nFrom) + " 至 " + ts(nTo) + " 的客户"
    If bPlus2 = True Then
        strTmp2 = "#（最新日期从" + txtYearFrom2.Text + "年" + ts(Val(txtMonthFrom2.Text)) + _
                  "月至" + txtYearTo2.Text + "年" + ts(Val(txtMonthTo2.Text)) + "月）"
    Else
        strTmp2 = "#"
    End If
                 
    PrintClients strTmp1 + strTmp2
End Sub

Private Sub cmdQuit_Click()
    Unload Me
End Sub

Private Sub Form_Load()
    On Error Resume Next 'CallerID
    
    frmMain.Display_Clients
    
    txtYearFrom1.Text = Year(Date)
    txtYearTo1.Text = Year(Date)
    
    txtYearFrom2.Text = Year(Date)
    txtYearTo2.Text = Year(Date)
    
    DisableCmd
End Sub