frmmain.frm

监控类的开发

      Caption         =   "打印"
      Begin VB.Menu mMonthOuter 
         Caption         =   "月度外勤"
      End
      Begin VB.Menu mMonthOperator 
         Caption         =   "月度操作"
      End
      Begin VB.Menu mLinePrint 
         Caption         =   "-"
      End
      Begin VB.Menu mMonthOrder 
         Caption         =   "月度订单"
      End
      Begin VB.Menu mSumUp 
         Caption         =   "按段汇总"
      End
   End
   Begin VB.Menu mHelp 
      Caption         =   "帮助"
      Begin VB.Menu mTopics 
         Caption         =   "主题"
      End
      Begin VB.Menu mLineHelp 
         Caption         =   "-"
      End
      Begin VB.Menu mAbout 
         Caption         =   "关于"
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Public strCaller_ID As String
Public strCaller_ID_Reply As String
Dim nTestNo As Integer

Public Sub Load_Table(strTable As String, strOrder As String)
    On Error Resume Next 'CallerID
    
    With AdodcCaller
        .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + _
                          strDataPath + ";Persist Security Info=False"
        .CommandType = adCmdUnknown
        .RecordSource = "select * from " + strTable + " order by " + strOrder
        .Refresh
    End With
    
    If UCase(strTable) = "NOWS" And DG_Nows.Caption = "当前订单" Then
        DG_Nows.AllowUpdate = True
    Else
        DG_Nows.AllowUpdate = False
    End If
End Sub

Public Sub Display_Clients()
    DG_Clients.ZOrder
    Load_Table "Clients", "[ID]"
End Sub

Private Sub Display_Days()
    DG_Nows.ZOrder
    DG_Nows.Caption = "当日订单"
    Load_Table "Days", "[ID]"
End Sub

Private Sub Display_Nows()
    DG_Nows.ZOrder
    DG_Nows.Caption = "当前订单"
    Load_Table "Nows", "[ID]"
End Sub

Public Sub Display_History()
    On Error Resume Next 'CallerID
    
    DG_Nows.ZOrder
    With AdodcCaller
        .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + _
                          strDataHistory + ";Persist Security Info=False"
        .CommandType = adCmdUnknown
        .RecordSource = "select * from DayCounts order by [ID]"
        .Refresh
    End With
    DG_Nows.Caption = "历史订单"
    DG_Nows.AllowUpdate = False
End Sub

Public Sub GetBossMbInfo()
    On Error Resume Next 'CallerID
    
    With frmCompany.AdodcCaller
        .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + _
                          strDataPath + ";Persist Security Info=False"
        .CommandType = adCmdUnknown
        .RecordSource = "select * from Company"
        .Refresh
        With .Recordset
            If .RecordCount > 0 Then
                .MoveFirst
                strCorpName = ![Corp]
                strMb = ![Mb]
                strMbPass = Base64_Decode(![Password])
            End If
        End With
    End With
End Sub

Private Sub GetAreaCodes()
    On Error Resume Next 'CallerID
    
    strAreaCodes = "/"
    
    With frmArea.AdodcCaller
        .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + _
                          strDataPath + ";Persist Security Info=False"
        .CommandType = adCmdUnknown
        .RecordSource = "select * from Area"
        .Refresh
        With .Recordset
            If .RecordCount > 0 Then
                .MoveFirst
                Do While Not .EOF
                    strAreaCodes = strAreaCodes + Trim(Str(![Code])) + "/"
                    .MoveNext
                Loop
            End If
        End With
    End With
End Sub

Private Sub GetAreaID_Mb()
    On Error Resume Next 'CallerID
    
    strAreaMb = "/"
    
    With frmOuter.AdodcCaller
        .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + _
                          strDataPath + ";Persist Security Info=False"
        .CommandType = adCmdUnknown
        .RecordSource = "select * from Outers"
        .Refresh
        With .Recordset
            If .RecordCount > 0 Then
                .MoveFirst
                Do While Not .EOF
                    strAreaMb = strAreaMb + Trim(Str(![AreaCode])) + "/" + ![Mb] + "/"
                    .MoveNext
                Loop
            End If
        End With
    End With
End Sub

Public Sub GetCorpInfo()
    GetBossMbInfo
    GetSMTP
    GetAreaCodes
    GetAreaID_Mb
    
    strMailFrom = GetMailName(strMb)
    
    strCorpInfo = AGENT + strCorpName + "|" + strMb + "/" + strMbPass + "|" + _
                  Format(Date, "yyyy-mm-dd") + "|" + strAreaMb + "|" + _
                  Trim(Str(nOperatorID)) + "/" + strOperatorPassword + "|" + _
                  strComputerName + "/" + strUserName + "/" + tcpClient.LocalIP + "|#"
End Sub

Private Sub GetSMTP()
    Dim strTmp As String
    
    If strMb = "" Then GoTo EndMark
    strTmp = Mid(strMb, 1, 3)
    
    If strTmp >= "134" And strTmp <= "139" Then
        strSMTP = SMTP1
        Exit Sub
    End If
    
    If strTmp >= "130" And strTmp <= "133" Then
        strSMTP = SMTP2
        Exit Sub
    End If
    
EndMark:
    strSMTP = ""
End Sub

Private Sub Initialize()
    Dim strTmp As String
    On Error Resume Next 'CallerID
    
    App.Title = "基于短信的电话客户管理系统"
    
    Display_Days
    strTmp = Format(Date, "yyyy-mm-dd")
    With AdodcCaller.Recordset
        If .RecordCount > 0 Then
            .MoveFirst
            Do While Not .EOF
                If ![Date] <> strTmp Then .Delete  'all keep this days'
                .MoveNext
            Loop
            .Requery
        End If
    End With

    strCaller_ID = "ATS0=24#CID=1" + Chr(13)
    strCaller_ID_Reply = strCaller_ID + vbCrLf + "OK" + vbCrLf
    
    strDataHistory = App.Path + "\CallerID_History.mdb"
    
    strComputerName = GetMyComputerName
    strUserName = GetMyUserName
    
    GetCorpInfo
    
    Me.Caption = strCorpName + ": " + Me.Caption
    
    strSM_File = App.Path + "\SM_Records.txt"
    If CheckFile(strSM_File) Then strSM_Records = ReadTxtFile(strSM_File)
    
    strTmp = GetMySysDir + "\PrintForm.dll"
    
    If CheckFile(strTmp) = False And CheckFile(App.Path + "\PrintForm.dll") = True Then
        MyCopyFile App.Path + "\PrintForm.dll", strTmp
        KillSpFile App.Path + "\PrintForm.dll"
    End If
    
    strTmp = App.Path + "\CallerID_HLP.chm"
    If CheckFile(strTmp) Then
        App.HelpFile = strTmp
    Else
        mTopics.Enabled = False
    End If
    
    bNewUser = True
End Sub

Private Sub ProcessPhoneNo()
    Dim strTmp As String
    Dim nLoc As Integer
    On Error Resume Next 'CallerID
    
    strRingTime = Format(Time, "H:MM:SS")
    strTmp = OnlyOneSegChar(strComInBuffers, vbCrLf, True)
    nLoc = InStr(1, strComInBuffers, "NMBR", vbTextCompare)
    
    If nLoc <> 0 Then
        strTmp = Mid(strComInBuffers, nLoc)
        strTmp = GetNoString(strTmp, vbCrLf, 0)
        strTmp = GetNoString(strTmp + "=", "=", 1)
        strInPhoneNo = Trim(strTmp)
    End If
End Sub

Private Sub SetPortNoAndTest(nPort As Integer)
    On Error Resume Next 'CallerID
    
    CloseMsComm MSComm1, 50
    MSComm1.CommPort = nPort
    OpenMsComm MSComm1, 50
    MSComm1.Output = strCaller_ID
End Sub

Private Sub txtBox_Value()
    On Error Resume Next 'CallerID
    
    If txtAddress.Text <> strAddress Then bNewUser = True
    strAddress = txtAddress.Text
    
    nArea = Val(txtArea.Text)
    strName = txtName.Text
    nQuantity = Val(txtQuantity.Text)
    nSort = Val(txtSort.Text)
    strDelay = txtDelay.Text
    strRemark = txtRemark.Text
End Sub

Private Sub cmdClear_Click()
    txtPhone.Text = ""
    txtAddress.Text = ""
    txtArea.Text = 1
    txtName.Text = ""
    txtQuantity.Text = 1
    txtSort.Text = 1
    txtDelay.Text = ""
    txtRemark.Text = ""
End Sub

Private Sub cmdOK_Click()
    On Error Resume Next 'CallerID
    
    If Trim(txtAddress.Text) = "" Then
        MsgBox "地址不能为空！", vbExclamation + vbOKOnly, "提示"
        txtAddress.SetFocus
        Exit Sub
    End If
    
    If CheckAreaCode(Val(txtArea.Text)) = False Then
        MsgBox "无此区域代码！", vbCritical + vbOKOnly, "提示"
        Exit Sub
    End If
    
    txtBox_Value
    
    nDayBottles = nDayBottles + nQuantity
    nDayOrders = nDayOrders + 1
    
    Display_Clients
    With AdodcCaller.Recordset
        If bNewUser = True Then
            .AddNew
            ![ID] = .RecordCount
            ![Phone] = strInPhoneNo
            ![Address] = strAddress
            ![FirstDate] = Format(Date, "yyyy-mm-dd")
            ![Total] = nQuantity
        Else
            .MoveFirst
            Do While Not .EOF
                If ![Phone] = strInPhoneNo And ![Address] = txtAddress.Text Then Exit Do
                .MoveNext
            Loop
            
            If .EOF Then Exit Sub
            ![Total] = ![Total] + nQuantity
        End If
            
        ![LastDate] = Format(Date, "yyyy-mm-dd")
        ![Area] = nArea
        ![Sort] = nSort
        ![Name] = strName
        ![Remark] = strRemark
        .Update
        .Requery
    End With
    
    Display_History
    With AdodcCaller.Recordset
        .AddNew
        ![ID] = .RecordCount
        ![Phone] = strInPhoneNo
        ![Address] = txtAddress.Text
        ![Area] = nArea
        ![Name] = strName
        ![Date] = Format(Date, "yyyy-mm-dd")
        ![Time] = strRingTime
        ![Quantity] = nQuantity
        ![Sort] = nSort
        ![Delay] = strDelay
        ![Remark] = strRemark
        .Update
        .Requery
    End With
    
    Display_Days
    With AdodcCaller.Recordset
        .AddNew
        ![ID] = .RecordCount
        ![Phone] = strInPhoneNo
        ![Address] = txtAddress.Text
        ![Area] = nArea
        ![Name] = strName
        ![Date] = Format(Date, "yyyy-mm-dd")
        ![Time] = strRingTime
        ![Quantity] = nQuantity
        ![Sort] = nSort
        ![Delay] = strDelay
        ![Remark] = strRemark
        .Update
        .Requery
    End With
    
    If txtPhone.Locked = False Then GoTo END_MARK
    Display_Nows
    With AdodcCaller.Recordset
        .AddNew
        ![ID] = .RecordCount
        ![Phone] = strInPhoneNo
        ![Address] = txtAddress.Text
        ![Area] = nArea
        ![Name] = strName
        ![Date] = Format(Date, "yyyy-mm-dd")
        ![Time] = strRingTime
        ![Quantity] = nQuantity
        ![Sort] = nSort