企业管理

开发平台：
Visual Basic

：源码内容
							VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomct2.ocx"
Object = "{BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1.1#0"; "tabctl32.ocx"
Begin VB.Form Xt_login 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "百利/ERP5.0-电子报表"
   ClientHeight    =   4170
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4830
   ControlBox      =   0   'False
   Icon            =   "系统登录窗体.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form2"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4170
   ScaleWidth      =   4830
   StartUpPosition =   1  '所有者中心
   Begin VB.CheckBox CtdrCheck 
      Caption         =   "非第一次调入窗体"
      Height          =   735
      Left            =   4980
      TabIndex        =   25
      Top             =   450
      Width           =   705
   End
   Begin VB.CheckBox QdCheck 
      Caption         =   "是否修改查询条件"
      Height          =   825
      Left            =   4980
      TabIndex        =   24
      Top             =   1320
      Value           =   1  'Checked
      Width           =   705
   End
   Begin TabDlg.SSTab StTab 
      Height          =   4095
      Left            =   60
      TabIndex        =   12
      Top             =   30
      Width           =   4725
      _ExtentX        =   8334
      _ExtentY        =   7223
      _Version        =   393216
      Style           =   1
      TabHeight       =   520
      TabCaption(0)   =   "帐套选择及身份验证"
      TabPicture(0)   =   "系统登录窗体.frx":0442
      Tab(0).ControlEnabled=   -1  'True
      Tab(0).Control(0)=   "Frame1(0)"
      Tab(0).Control(0).Enabled=   0   'False
      Tab(0).ControlCount=   1
      TabCaption(1)   =   "数据服务器连接设置"
      TabPicture(1)   =   "系统登录窗体.frx":045E
      Tab(1).ControlEnabled=   0   'False
      Tab(1).Control(0)=   "Frame1(1)"
      Tab(1).ControlCount=   1
      TabCaption(2)   =   "更改密码"
      TabPicture(2)   =   "系统登录窗体.frx":047A
      Tab(2).ControlEnabled=   0   'False
      Tab(2).Control(0)=   "Frame1(2)"
      Tab(2).ControlCount=   1
      Begin VB.Frame Frame1 
         Height          =   3645
         Index           =   2
         Left            =   -74910
         TabIndex        =   26
         Top             =   330
         Width           =   4515
         Begin VB.CommandButton MmqdCommand 
            Caption         =   "确定(&O)"
            Height          =   300
            Left            =   1260
            TabIndex        =   34
            Top             =   2100
            Width           =   1120
         End
         Begin VB.CommandButton MmqxCommand 
            Caption         =   "取消(&C)"
            Height          =   300
            Left            =   2430
            TabIndex        =   33
            Top             =   2100
            Width           =   1120
         End
         Begin VB.TextBox LrText 
            Height          =   300
            IMEMode         =   3  'DISABLE
            Index           =   2
            Left            =   1350
            MaxLength       =   20
            PasswordChar    =   "*"
            TabIndex        =   11
            Top             =   1170
            Width           =   3000
         End
         Begin VB.TextBox LrText 
            Height          =   300
            IMEMode         =   3  'DISABLE
            Index           =   1
            Left            =   1350
            MaxLength       =   20
            PasswordChar    =   "*"
            TabIndex        =   10
            Top             =   780
            Width           =   3000
         End
         Begin VB.TextBox LrText 
            Height          =   300
            IMEMode         =   3  'DISABLE
            Index           =   0
            Left            =   1350
            MaxLength       =   20
            PasswordChar    =   "*"
            TabIndex        =   9
            Top             =   390
            Width           =   3000
         End
         Begin VB.Line Line1 
            BorderColor     =   &H00FFFFFF&
            Index           =   3
            X1              =   300
            X2              =   4290
            Y1              =   1800
            Y2              =   1800
         End
         Begin VB.Label TsLabel 
            AutoSize        =   -1  'True
            Caption         =   "确认密码:"
            Height          =   195
            Index           =   16
            Left            =   300
            TabIndex        =   29
            Top             =   1230
            Width           =   765
         End
         Begin VB.Label TsLabel 
            AutoSize        =   -1  'True
            Caption         =   "新密码:"
            Height          =   195
            Index           =   15
            Left            =   300
            TabIndex        =   28
            Top             =   840
            Width           =   585
         End
         Begin VB.Label TsLabel 
            AutoSize        =   -1  'True
            Caption         =   "旧密码:"
            Height          =   195
            Index           =   14
            Left            =   300
            TabIndex        =   27
            Top             =   420
            Width           =   585
         End
         Begin VB.Line Line1 
            Index           =   2
            X1              =   300
            X2              =   4290
            Y1              =   1770
            Y2              =   1770
         End
      End
      Begin VB.Frame Frame1 
         Height          =   3645
         Index           =   1
         Left            =   -74910
         TabIndex        =   19
         Top             =   330
         Width           =   4515
         Begin VB.CommandButton LjqxCommand 
            Caption         =   "取消(&C)"
            Height          =   300
            Left            =   2850
            TabIndex        =   21
            Top             =   1350
            Width           =   1120
         End
         Begin VB.CommandButton LjqdCommand 
            Caption         =   "确定(&O)"
            Height          =   300
            Left            =   1680
            TabIndex        =   8
            Top             =   1350
            Width           =   1120
         End
         Begin VB.TextBox ServerText 
            Height          =   300
            Left            =   1350
            TabIndex        =   7
            Top             =   600
            Width           =   2985
         End
         Begin MSComCtl2.Animation Animation1 
            Height          =   615
            Left            =   300
            TabIndex        =   23
            Top             =   1260
            Visible         =   0   'False
            Width           =   705
            _ExtentX        =   1244
            _ExtentY        =   1085
            _Version        =   393216
            Center          =   -1  'True
            BackStyle       =   1
            FullWidth       =   47
            FullHeight      =   41
         End
         Begin VB.Label DdtsLabel 
            ForeColor       =   &H00FF0000&
            Height          =   255
            Left            =   1110
            TabIndex        =   22
            Top             =   2550
            Width           =   3045
         End
         Begin VB.Label TsLabel 
            AutoSize        =   -1  'True
            Caption         =   "数据服务器:"
            Height          =   195
            Index           =   7
            Left            =   330
            TabIndex        =   20
            Top             =   660
            Width           =   945
         End
      End
      Begin VB.Frame Frame1 
         Height          =   3585
         Index           =   0
         Left            =   90
         TabIndex        =   13
         Top             =   390
         Width           =   4545
         Begin VB.CommandButton Rlcommand 
            CausesValidation=   0   'False
            Height          =   302
            Left            =   4140
            Picture         =   "系统登录窗体.frx":0496
            Style           =   1  'Graphical
            TabIndex        =   36
            Top             =   990
            Width           =   315
         End
         Begin VB.ComboBox sysCombo 
            Height          =   300
            ItemData        =   "系统登录窗体.frx":0820
            Left            =   1200
            List            =   "系统登录窗体.frx":0822
            Style           =   2  'Dropdown List
            TabIndex        =   3
            Top             =   1380
            Width           =   3255
         End
         Begin VB.CommandButton QxCommand 
            Caption         =   "取消(&C)"
            Height          =   300
            Left            =   3300
            TabIndex        =   32
            Top             =   3180
            Width           =   1120
         End
         Begin VB.CommandButton QdCommand 
            Caption         =   "确定(&O)"
            Height          =   300
            Left            =   2130
            TabIndex        =   6
            Top             =   3180
            Width           =   1120
         End
         Begin VB.CommandButton XgmaCommand 
            Caption         =   "修改密码(&E)"
            Height          =   300
            Left            =   2130
            TabIndex        =   31
            Top             =   2820
            Width           =   1120
         End
         Begin VB.CommandButton GgszCommand 
            Caption         =   "更改设置(&R)"
            Height          =   300
            Left            =   3300
            TabIndex        =   30
            Top             =   2820
            Width           =   1120
         End
         Begin VB.Timer Timer1 
            Interval        =   100
            Left            =   60
            Top             =   150
         End
         Begin VB.TextBox MmText 
            Height          =   300
            IMEMode         =   3  'DISABLE
            Left            =   1200
            MaxLength       =   20
            PasswordChar    =   "*"
            TabIndex        =   5
            Top             =   2175
            Width           =   2535
         End
         Begin VB.ComboBox CzyCombo 
            Height          =   300
            Left            =   1200
            TabIndex        =   4
            Text            =   "CzyCombo"
            Top             =   1785
            Width           =   3255
         End
         Begin VB.TextBox CzrqText 
            Height          =   300
            Left            =   1200
            MaxLength       =   10
            TabIndex        =   2
            Top             =   990
            Width           =   2955
         End
         Begin VB.ComboBox KjyearCombo 
            Height          =   300
            Left            =   1200
            Style           =   2  'Dropdown List
            TabIndex        =   1
            Top             =   600
            Width           =   3255
         End
         Begin VB.ComboBox ZtCombo 
            Height          =   300
            Left            =   1200
            Style           =   2  'Dropdown List
            TabIndex        =   0
            Top             =   210
            Width           =   3255
         End
         Begin VB.Line Line1 
            BorderColor     =   &H00FFFFFF&
            Index           =   1
            X1              =   180
            X2              =   4320
            Y1              =   2700
            Y2              =   2700
         End
         Begin VB.Line Line1 
            Index           =   0
            X1              =   180
            X2              =   4320
            Y1              =   2670
            Y2              =   2670
         End
         Begin VB.Label TsLabel 
            AutoSize        =   -1  'True
            Caption         =   "当前系统:"
            Height          =   180
            Index           =   5
            Left            =   240
            TabIndex        =   35
            Top             =   1440
            Width           =   810
         End
         Begin VB.Image Image1 
            Height          =   480
            Left            =   3900
            Picture         =   "系统登录窗体.frx":0824
            Top             =   2175
            Width           =   480
         End
         Begin VB.Label TsLabel 
            AutoSize        =   -1  'True
            Caption         =   "密码:"
            Height          =   195
            Index           =   4
            Left            =   270
            TabIndex        =   18
            Top             =   2235
            Width           =   405
         End
         Begin VB.Label TsLabel 
            AutoSize        =   -1  'True
            Caption         =   "用户名:"
            Height          =   195
            Index           =   2
            Left            =   270
            TabIndex        =   17
            Top             =   1845
            Width           =   585
         End
         Begin VB.Label TsLabel 
            AutoSize        =   -1  'True
            Caption         =   "公司帐套:"
            Height          =   195
            Index           =   0
            Left            =   270
            TabIndex        =   16
            Top             =   300
            Width           =   765
         End
         Begin VB.Label TsLabel 
            AutoSize        =   -1  'True
            Caption         =   "会计年度:"
            Height          =   195
            Index           =   1
            Left            =   270
            TabIndex        =   15
            Top             =   660
            Width           =   765
         End
         Begin VB.Label TsLabel 
            AutoSize        =   -1  'True
            Caption         =   "操作日期:"
            Height          =   195
            Index           =   3
            Left            =   270
            TabIndex        =   14
            Top             =   1050
            Width           =   765
         End
      End
   End
End
Attribute VB_Name = "Xt_login"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'***********************************************
'*    模 块 名 称 :系统日历帮助
'*    功 能 描 述 :
'*    程序员姓名  :奚俊峰
'*    最后修改人  :奚俊峰
'*    最后修改时间:2002/01/21
'***********************************************
Dim Xtsjljc As String                       '系统数据服务器连接串
Dim ErpPassWord As String                   '系统连接密码
Dim Cslj As New ADODB.Connection            '测试连接(为屏蔽提示信息)
Dim Tsxx As String                          '系统提示信息
Dim Czyrec As New ADODB.Recordset           '操作员动态集
Dim Xtrlrec As New ADODB.Recordset          '系统日历动态集
Dim Ztcsbrec As New ADODB.Recordset         '系统帐套参数表
Dim Ztdqsjk As String                       '所选帐套当前数据库
Private Function Ljyxxpd() As Boolean       '数据服务器(系统基本信息库)连接有效性测试
    Ljyxxpd = False
    If Len(Trim(ServerText.Text)) = 0 Then
        Tsxx = "数据服务器名不能为空!"
        Call Xtxxts(Tsxx, 0, 1)
        ServerText.SetFocus
        Exit Function
    End If
    
    Xtsjljc = "Provider=SQLOLEDB.1;"
    
    Xtsjljc = Xtsjljc + "Persist Security Info=False;"
    
    Xtsjljc = Xtsjljc + "Data Source=" + Trim(ServerText.Text) + ";"
    
    Xtsjljc = Xtsjljc + " Initial Catalog=" + "Master" + ";"
    
    If Cslj.State = 1 Then Cslj.Close
    
    DdtsLabel = "系统正在连接数据服务器,请稍等..."
    DdtsLabel.Refresh
    With Me.Animation1
        .Visible = True
        .Open App.Path + "Ljcs.avi"
        .Play
    End With
    On Error GoTo Cwcl
    
    If Cslj.State = 1 Then Cslj.Close
    Cslj.Open Xtsjljc, "Hxxd", ErpPassWord
    
    Animation1.Stop
    Animation1.Visible = False
    
    DdtsLabel = ""
    DdtsLabel.Refresh
    
    Ljyxxpd = True
    Exit Function
    
Cwcl:
    Animation1.Visible = False
    Animation1.Stop
    DdtsLabel = ""
    Tsxx = "数据服务器连接测试失败!"
    Call Xtxxts(Tsxx, 0, 1)
    Exit Function
    
End Function
Private Sub CzrqText_KeyPress(KeyAscii As Integer)
    Call Lrrqxz(KeyAscii)
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)   '控 制 焦 点 转 移
    Dim jdzygs As Integer
    jdzygs = 15
    Select Case KeyAscii
    Case vbKeyReturn
        If Kjjdzy(jdzygs) Then
            KeyAscii = 0
        End If
    Case 39           '屏蔽"'"
        KeyAscii = 0
    End Select
End Sub
Private Sub Form_Load()
    
    App.HelpFile = App.Path + "电子报表.chm"
    
    XtMenuList = "01%"         '子系统菜单系统代号
    
    ErpPassWord = "123"
    
    Call Qcljnr     '读入连接内容
    
    With StTab
        .TabEnabled(0) = False
        Frame1(0).Enabled = False
        .TabEnabled(1) = True
        Frame1(1).Enabled = True
        .TabEnabled(2) = False
        Frame1(2).Enabled = False
        StTab.Tab = 1
    End With
    
    
End Sub
Private Sub GgszCommand_Click()
    With Me.StTab
        .TabEnabled(0) = False
        Frame1(0).Enabled = False
        .TabEnabled(1) = True
        Frame1(1).Enabled = True
        .Tab = 1
    End With
    
    '让数据服务器得到焦点
    ServerText.SetFocus
    ServerText.SelStart = 0
    ServerText.SelLength = Len(ServerText.Text)
End Sub
Private Sub LjqdCommand_Click()                              '保 存 设 置
    
    If Ljyxxpd Then
        If Cw_DataEnvi.jbxxconnect.State = 1 Then Cw_DataEnvi.jbxxconnect.Close
        Cw_DataEnvi.jbxxconnect.Open Xtsjljc, "Hxxd", ErpPassWord
        
        Tsxx = "连接测试成功!"
        Call Xtxxts(Tsxx, 0, 4)
        
        StTab.TabEnabled(1) = False
        Frame1(1).Enabled = False
        StTab.TabEnabled(0) = True
        Frame1(0).Enabled = True
        StTab.Tab = 0
        Call Tcztxx
        
        If ZtCombo.ListCount > 0 Then
            ZtCombo.ListIndex = 0
        End If
    End If
    '
End Sub
Private Sub Qcljnr()                                         '取 出 数 据
    Dim Fsote As New FileSystemObject, Tste As TextStream
    Dim Dqhs As Integer, Dqnr As String
    Dqhs = 5
    On Error GoTo Cwcl:
    Set Tste = Fsote.OpenTextFile(App.Path + "百利erp.txt", 1)
    For jsqte = 1 To Dqhs
        Dqnr = Trim(Tste.ReadLine)
        If InStr(1, UCase(Dqnr), "SQLSERVER=") <> 0 Then
            ServerText.Text = Mid(Dqnr, InStr(1, UCase(Dqnr), "SQLSERVER=") + 10, Len(Dqnr))
        End If
        If InStr(1, UCase(Dqnr), "ACCOUNT=") <> 0 Then
            str_Account = Mid(Dqnr, InStr(1, UCase(Dqnr), "ACCOUNT=") + 8, Len(Dqnr))
            Dim int_Count As Integer
             
            For int_Count = 0 To ZtCombo.ListCount - 1
                If UCase(Mid(ZtCombo.List(int_Count), 1, InStr(ZtCombo.List(int_Count), "-") - 1)) = UCase(Mid(str_Account, 1, InStr(str_Account, "-") - 1)) Then
                    ZtCombo.ListIndex = int_Count
                End If
            Next int_Count
        End If
    Next jsqte
    Exit Sub
Cwcl:
    Exit Sub
End Sub
Private Sub QdCommand_Click() '确定进入系统
    If Trim(CzyCombo.Text) = "" Then Exit Sub
    
    On Error GoTo ErrHandle
    
    Set Czyrec = Cw_DataEnvi.DataConnect.Execute("Select * From gy_czygl where czybm='" + Trim(CzyCombo.Text) + "' or czymc='" & Trim(CzyCombo.Text) & "' or rtrim(czybm)+'-'+rtrim(czymc)='" & Trim(CzyCombo.Text) & "'")
    With Czyrec
        If Not .EOF Then
        CzyCombo.Text = Trim(.Fields("czybm")) + "-" + Trim(.Fields("czymc"))
        Else
            Tsxx = "无此用户名!"
            Call Xtxxts(Tsxx, 0, 1)
            Exit Sub
        End If
    End With
    Czyrec.Close
    Set Czyrec = Nothing
    
    Xtczybm = Left(CzyCombo.Text, 3)
    Xtczy = Right(CzyCombo.Text, Len(CzyCombo.Text) - InStr(1, CzyCombo.Text, "-"))
    Xtdwm = Mid(ZtCombo.Text, InStr(1, ZtCombo.Text, "-") + 1) '系统打开帐套单位
    Curr_sys = Left(sysCombo.Text, 2)
    
    If Xtyxxpd Then
        If Ljyxxpd1 Then
            If Cw_DataEnvi.DataConnect.State = 1 Then Cw_DataEnvi.DataConnect.Close
            Cw_DataEnvi.DataConnect.Open Xtsjljc, "Hxxd", ErpPassWord
        End If
        
       '判断用户是否有此功能执行权限,如有则写上机日志(进入)
        If Not Security_Log("Dzbb_Dzbb", Xtczybm, 1) Then
            Exit Sub
        End If
        QdCheck.Value = 1
        Me.Hide
        
        Dim Fsote As New FileSystemObject, Tste As TextStream
        Set Tste = Fsote.CreateTextFile(App.Path + "百利erp.txt", True)
        Tste.WriteLine "Sqlserver=" + Trim(ServerText.Text)
        Tste.WriteLine "Account=" + Trim(ZtCombo.Text)
        Tste.Close
        
        If CtdrCheck.Value <> 1 Then
            CtdrCheck.Value = 1
            GgszCommand.Enabled = False
            Cw_DataEnvi.DataConnect.CommandTimeout = 99999999
            
            Call Xtcsh
            
            MDI_frame.Visible = False
            MDI_frame.Show
        End If
    End If
ErrHandle:
    
End Sub
Private Sub QxCommand_Click()                                     '取消进入系统
    Unload Me
End Sub
Private Function Mmjm1(Srmm As String) As String                  '密码加密模块
    Dim Zfcte As Integer
    Mmjm1 = ""
    For jsqte = 1 To Len(Srmm)
        Zfcte = Asc(Mid(Srmm, jsqte, 1)) + Len(Srmm) + jsqte
        Mmjm1 = Mmjm1 + Mid(Trim(Str(1000 + Zfcte)), 2, 3)
    Next jsqte
End Function
Private Function Mmjm2(Srmm As String) As String                  '密码解密模块
    Dim Zfcte As Integer
    Mmjm2 = ""
    For jsqte = 1 To Int(Len(Srmm) / 3)
        Zfcte = Val(Mid(Srmm, (jsqte - 1) * 3 + 1, 3)) - Int(Len(Srmm) / 3) - jsqte
        Mmjm2 = Mmjm2 + Chr(Zfcte)
    Next jsqte
End Function
Private Sub Rlcommand_Click()                                      '操作日期帮助
    Call Czrqbz
End Sub
Private Sub Timer1_Timer()                                         '激活连接测试
    Timer1.Enabled = False
    
    If Ljyxxpd Then
        If Cw_DataEnvi.jbxxconnect.State = 1 Then Cw_DataEnvi.jbxxconnect.Close
        Cw_DataEnvi.jbxxconnect.Open Xtsjljc, "Hxxd", ErpPassWord
    Else
        Exit Sub
    End If
    
    With StTab
        .TabEnabled(1) = False
        Frame1(1).Enabled = False
        .TabEnabled(0) = True
        Frame1(0).Enabled = True
    End With
    
    StTab.Tab = 0
    
    Call Tcztxx
    Qcljnr
    CzyCombo.SetFocus
End Sub
Private Sub LjqxCommand_Click()                '连接失败退出
    If CtdrCheck.Value <> 1 Then
        Unload Me
    Else
        Me.Hide
    End If
End Sub
Private Sub Tcztxx()                           '填充帐套信息选择
    Dim Xtztxxrec As New ADODB.Recordset        '系统帐套信息动态集
    Set Xtztxxrec = Cw_DataEnvi.jbxxconnect.Execute("Select * From HDSystem_Databases order by number")
    ZtCombo.Clear
    With Xtztxxrec
        Do While Not .EOF
            If .Fields("YNuse") = "1" Then
                ZtCombo.AddItem .Fields("number") + "-" + Trim(.Fields("CountingRoomName"))
            End If
            .MoveNext
        Loop
        If ZtCombo.ListCount <> 0 Then
            ZtCombo.Text = ZtCombo.List(0)
        End If
    End With
End Sub
Private Sub ZtCombo_Click()
    Dim Xtztxxrec As New ADODB.Recordset        '系统帐套信息动态集
    
    
    On Error GoTo ErrHandle
    
    Set Xtztxxrec = Cw_DataEnvi.jbxxconnect.Execute("Select * From HDSystem_DataBases where Number='" + Trim(Mid(ZtCombo.Text, 1, InStr(1, ZtCombo.Text, "-") - 1)) + "'")
    With Xtztxxrec
        If Not .EOF Then
            Ztdqsjk = Trim(.Fields("DataBasesName"))
        End If
    End With
    If Ljyxxpd1 Then
        If Cw_DataEnvi.DataConnect.State = 1 Then Cw_DataEnvi.DataConnect.Close
        Cw_DataEnvi.DataConnect.Open Xtsjljc, "Hxxd", ErpPassWord
    Else
        Exit Sub
    End If
    Set Czyrec = Cw_DataEnvi.DataConnect.Execute("Select * From gy_czygl order by czybm")
    CzyCombo.Clear
    With Czyrec
        Do While Not .EOF
            CzyCombo.AddItem Trim(.Fields("czybm")) + "-" + Trim(.Fields("czymc"))
            .MoveNext
        Loop
        If CzyCombo.ListCount > 0 Then CzyCombo.ListIndex = 0
    End With
    Set sysrec = Cw_DataEnvi.DataConnect.Execute("Select * From dzbb_xtbm order by system_code")
    sysCombo.Clear
    With sysrec
        Do While Not .EOF
            sysCombo.AddItem .Fields("system_code") + "-" + Trim(.Fields("system_name"))
            .MoveNext
        Loop
        If sysCombo.ListCount > 0 Then sysCombo.ListIndex = 0
    End With
    
    Set Xtrlrec = Cw_DataEnvi.DataConnect.Execute("Select distinct kjyear From gy_kjrlb ")
    KjyearCombo.Clear
    With Xtrlrec
        Do While Not .EOF
            KjyearCombo.AddItem Trim(.Fields("kjyear"))
            .MoveNext
        Loop
        If KjyearCombo.ListCount > 0 Then KjyearCombo.ListIndex = KjyearCombo.ListCount - 1
    End With
    
    'Call Drxtztcs             '读入系统帐套参数
    
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute("Select ServerDate=getdate()")
    CzrqText = Format(RecTemp.Fields("ServerDate"), "yyyy-mm-dd")
    
    XgmaCommand.Enabled = True
    GgszCommand.Enabled = True
    QdCommand.Enabled = True
    
    Exit Sub
ErrHandle:
    XgmaCommand.Enabled = False
    GgszCommand.Enabled = False
    QdCommand.Enabled = False
    
    KjyearCombo.Clear
    sysCombo.Clear
    CzyCombo.Clear
    MmText.Text = ""
    CzrqText.Text = ""
    
    MsgBox Err.Description, vbInformation, "百利/ERP5.0-电子报表"
End Sub
Private Sub Czrqbz()                                                  '操作日期帮助
    Xtcdcs = Trim(CzrqText.Text)
    Xtfhcs = ""
    XT_calendar.Show 1
    If Xtfhcs <> "" Then
        CzrqText.Text = Trim(Xtfhcs)
    End If
    CzrqText.SetFocus
End Sub
Private Sub CzrqText_KeyDown(KeyCode As Integer, Shift As Integer)    '操作日期帮助
    If KeyCode = vbKeyF2 Then
        Call Czrqbz
    End If
End Sub
Private Function Xtyxxpd() As Boolean                                                   '系统有效性判断
    Xtyxxpd = False
    If Len(Trim(ZtCombo.Text)) = 0 Then
        Tsxx = "公司帐套不能为空,请先建帐套!"
        Call Xtxxts(Tsxx, 0, 1)
        ZtCombo.SetFocus
        Exit Function
    End If
    lsblte = Trim(CzrqText.Text)
    If IsDate(lsblte) Then
        CzrqText.Text = Format(lsblte, "yyyy-mm-dd")
        Xtrq = CDate(CzrqText)
    Else
        Tsxx = "非法公历日期!(格式:" + Format(Date, "yyyy-mm-dd") + ")"
        Call Xtxxts(Tsxx, 0, 1)
        Xtyxxpd = False
        CzrqText.SetFocus
        Exit Function
    End If
    If Val(KjyearCombo.Text) <> Val(Mid(CzrqText.Text, 1, 4)) Then
        Tsxx = "所选操作日期与会计年度不一致!"
        Call Xtxxts(Tsxx, 0, 1)
        Xtyxxpd = False
        CzrqText.SetFocus
        Exit Function
    End If
    Set Czyrec = Cw_DataEnvi.DataConnect.Execute("Select * From gy_czygl where czybm='" + Trim(Mid(CzyCombo.Text, 1, InStr(1, CzyCombo.Text, "-") - 1)) + "'")
    With Czyrec
        If Not .EOF Then
            If Trim(.Fields("czmm")) <> Mmjm(MmText.Text) Then
                Tsxx = "操作员密码录入错误!"
                Call Xtxxts(Tsxx, 0, 1)
                Xtyxxpd = False
                MmText.SetFocus
                Exit Function
            End If
        Else
            Tsxx = "无此操作员!"
            Call Xtxxts(Tsxx, 0, 1)
            Xtyxxpd = False
            CzyCombo.SetFocus
            Exit Function
        End If
    End With
    Xtyxxpd = True
End Function
Private Function Ljyxxpd1() As Boolean                  '数据服务器(帐套当前数据库)连接有效性测试
    Ljyxxpd1 = False
    
    Xtsjljc = "Provider=SQLOLEDB.1;"
    
    Xtsjljc = Xtsjljc + "Persist Security Info=False;"
    
    Xtsjljc = Xtsjljc + "Data Source=" + Trim(ServerText.Text) + ";"
    
    Xtsjljc = Xtsjljc + " Initial Catalog=" + Ztdqsjk + ";"
    
    On Error GoTo Cwcl
    If Cslj.State = 1 Then Cslj.Close
    Cslj.Open Xtsjljc, "Hxxd", ErpPassWord
    
    Ljyxxpd1 = True
    Exit Function
    
Cwcl:
    Tsxx = "帐套数据库连接失败!"
    Call Xtxxts(Tsxx, 0, 1)
    Exit Function
End Function
Private Sub XgmaCommand_Click()                '修改密码
    With StTab
        .TabEnabled(0) = False
        Frame1(0).Enabled = False
        .TabEnabled(2) = True
        Frame1(2).Enabled = True
        .Tab = 2
    End With
    LrText(0).Text = Trim(MmText.Text)
    LrText(1).Text = ""
    LrText(2).Text = ""
    LrText(0).SetFocus
    LrText(0).SelStart = 0
    LrText(0).SelLength = Len(LrText(0))
End Sub
Private Sub MmqdCommand_Click()                '修改密码完毕确定
    On Error GoTo ErrHandle
    
    With Czyrec
        If .State = 1 Then .Close
        .Open "SELECT * FROM gy_czygl WHERE czybm= '" + Trim(Mid(CzyCombo.Text, 1, InStr(1, CzyCombo.Text, "-") - 1)) + "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
        If .EOF Then
            Tsxx = "此操作员已删除!"
            Call Xtxxts(Tsxx, 0, 1)
            Exit Sub
        End If
        If Trim(.Fields("czmm")) <> Mmjm(Trim(LrText(0).Text)) Then
            Tsxx = "输入旧密码错误!"
            Call Xtxxts(Tsxx, 0, 1)
            LrText(0).SetFocus
            Exit Sub
        End If
        If Len(Trim(LrText(1).Text)) = 0 Then
            Tsxx = "操作员密码不能为空!"
            Call Xtxxts(Tsxx, 0, 1)
            LrText(1).SetFocus
            Exit Sub
        End If
        If Trim(LrText(0).Text) = Trim(LrText(1).Text) Then
            Tsxx = "密码没有发生改变!"
            Call Xtxxts(Tsxx, 0, 1)
            LrText(1).SetFocus
            Exit Sub
        End If
        If Trim(LrText(1).Text) <> Trim(LrText(2).Text) Then
            Tsxx = "输入密码与确认密码不一致!"
            Call Xtxxts(Tsxx, 0, 1)
            LrText(1).SetFocus
            Exit Sub
        End If
        .Fields("czmm") = Mmjm(Trim(LrText(1).Text))
        .Fields("xgrq") = Date
        .Update
        MmText.Text = Trim(LrText(1).Text)
        Tsxx = "用户密码修改完毕!"
        Call Xtxxts(Tsxx, 0, 4)
    End With
    With StTab
        .TabEnabled(0) = True
        Frame1(0).Enabled = True
        .TabEnabled(2) = False
        Frame1(2).Enabled = False
        .Tab = 0
    End With
    
ErrHandle:
    
End Sub
Private Sub MmqxCommand_Click()                          '修改密码取消
    With StTab
        .TabEnabled(0) = True
        Frame1(0).Enabled = True
        .TabEnabled(2) = False
        Frame1(2).Enabled = False
        .Tab = 0
    End With
End Sub
Private Sub Drxtztcs()                                   '读入系统帐套参数
    Dim Ztcsbrec As New ADODB.Recordset
    
    With Ztcsbrec
        '金额总位数
        .Open "Select * From Gy_AccInformation Where SystemCode='Cwzz'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
        .MoveFirst
        .Find "itemcode='cwjezws'"
        If Not Ztcsbrec.EOF Then
            Xtjezws = Val(Trim(Ztcsbrec.Fields("itemvalue")))
        End If
        
        '数量总位数
        .MoveFirst
        .Find "itemcode='cwslzws'"
        If Not Ztcsbrec.EOF Then
            Xtslzws = Val(Trim(Ztcsbrec.Fields("itemvalue")))
        End If
        
        '单价总位数
        .MoveFirst
        .Find "itemcode='cwdjzws'"
        If Not Ztcsbrec.EOF Then
            Xtdjzws = Val(Trim(Ztcsbrec.Fields("itemvalue")))
        End If
        
        '金额小数位数
        .MoveFirst
        .Find "itemcode='cwjexsws'"
        If Not Ztcsbrec.EOF Then
            Xtjexsws = Val(Trim(Ztcsbrec.Fields("itemvalue")))
        End If
        
        '数量小数位数
        .MoveFirst
        .Find "itemcode='cwslxsws'"
        If Not Ztcsbrec.EOF Then
            Xtslxsws = Val(Trim(Ztcsbrec.Fields("itemvalue")))
        End If
        
        '单价小数位数
        .MoveFirst
        .Find "itemcode='cwdjxsws'"
        If Not Ztcsbrec.EOF Then
            Xtdjxsws = Val(Trim(Ztcsbrec.Fields("itemvalue")))
        End If
        
        .Close
    End With
End Sub
Private Sub Xtcsh()
    With Xt_login
        Xtczybm = Trim(Mid(.CzyCombo.Text, 1, InStr(1, .CzyCombo.Text, "-") - 1))
        Xtczy = Trim(Mid(.CzyCombo.Text, InStr(1, .CzyCombo.Text, "-") + 1, Len(.CzyCombo.Text)))
        Xtztbm = Trim(Mid(.ZtCombo.Text, 1, InStr(1, .ZtCombo.Text, "-") - 1))
        Xtdwm = Trim(Mid(.ZtCombo.Text, InStr(1, .ZtCombo.Text, "-") + 1, Len(.ZtCombo.Text)))
        
        '用户选择系统年度
        Xtyear = Val(.KjyearCombo.Text)
        '用户选择系统会计期间
        Set Xtrlrec = Cw_DataEnvi.DataConnect.Execute("Select * From gy_kjrlb where qsrq<='" + .CzrqText.Text + "' and zzrq>='" + .CzrqText.Text + "'")
        If Not Xtrlrec.EOF Then
            Xtmm = Xtrlrec.Fields("period")
        End If
        '会计期间划分个数
        Xtkjqjgs = 12
        '业务操作日期
        Xtrq = CDate(.CzrqText.Text)
    End With
End Sub

						