企业管理

开发平台：
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    =   3765
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4770
   ControlBox      =   0   'False
   HelpContextID   =   1501007
   Icon            =   "系统_登录窗体.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form2"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3765
   ScaleWidth      =   4770
   StartUpPosition =   2  '屏幕中心
   Begin VB.CheckBox CtdrCheck 
      Caption         =   "非第一次调入窗体"
      Height          =   735
      Left            =   4920
      TabIndex        =   7
      Top             =   360
      Width           =   705
   End
   Begin VB.CheckBox QdCheck 
      Caption         =   "是否修改"
      Height          =   825
      Left            =   4920
      TabIndex        =   0
      Top             =   1230
      Value           =   1  'Checked
      Width           =   705
   End
   Begin TabDlg.SSTab StTab 
      Height          =   3705
      Left            =   60
      TabIndex        =   12
      Top             =   0
      Width           =   4665
      _ExtentX        =   8229
      _ExtentY        =   6535
      _Version        =   393216
      Style           =   1
      TabHeight       =   520
      TabCaption(0)   =   "帐套选择及身份验证"
      TabPicture(0)   =   "系统_登录窗体.frx":1042
      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":105E
      Tab(1).ControlEnabled=   0   'False
      Tab(1).Control(0)=   "Frame1(1)"
      Tab(1).ControlCount=   1
      TabCaption(2)   =   "更改密码"
      TabPicture(2)   =   "系统_登录窗体.frx":107A
      Tab(2).ControlEnabled=   0   'False
      Tab(2).Control(0)=   "Frame1(2)"
      Tab(2).ControlCount=   1
      Begin VB.Frame Frame1 
         Height          =   3255
         Index           =   2
         Left            =   -74910
         TabIndex        =   30
         Top             =   330
         Width           =   4455
         Begin VB.TextBox LrText 
            Height          =   300
            IMEMode         =   3  'DISABLE
            Index           =   2
            Left            =   1110
            MaxLength       =   20
            PasswordChar    =   "*"
            TabIndex        =   10
            Top             =   1200
            Width           =   3210
         End
         Begin VB.TextBox LrText 
            Height          =   300
            IMEMode         =   3  'DISABLE
            Index           =   1
            Left            =   1110
            MaxLength       =   20
            PasswordChar    =   "*"
            TabIndex        =   9
            Top             =   810
            Width           =   3210
         End
         Begin VB.CommandButton MmqxCommand 
            Caption         =   "取消(&C)"
            Height          =   300
            Left            =   2280
            TabIndex        =   31
            Top             =   2160
            Width           =   1125
         End
         Begin VB.CommandButton MmqdCommand 
            Caption         =   "确定(&O)"
            Height          =   300
            Left            =   1110
            TabIndex        =   11
            Top             =   2160
            Width           =   1120
         End
         Begin VB.TextBox LrText 
            Height          =   300
            IMEMode         =   3  'DISABLE
            Index           =   0
            Left            =   1110
            MaxLength       =   20
            PasswordChar    =   "*"
            TabIndex        =   8
            Top             =   420
            Width           =   3210
         End
         Begin VB.Line Line1 
            BorderColor     =   &H00FFFFFF&
            Index           =   3
            X1              =   240
            X2              =   4260
            Y1              =   1800
            Y2              =   1800
         End
         Begin VB.Label TsLabel 
            AutoSize        =   -1  'True
            Caption         =   "确认密码:"
            Height          =   180
            Index           =   16
            Left            =   240
            TabIndex        =   34
            Top             =   1260
            Width           =   810
         End
         Begin VB.Label TsLabel 
            AutoSize        =   -1  'True
            Caption         =   "新密码:"
            Height          =   180
            Index           =   15
            Left            =   240
            TabIndex        =   33
            Top             =   870
            Width           =   630
         End
         Begin VB.Label TsLabel 
            AutoSize        =   -1  'True
            Caption         =   "旧密码:"
            Height          =   180
            Index           =   14
            Left            =   240
            TabIndex        =   32
            Top             =   480
            Width           =   630
         End
         Begin VB.Line Line1 
            Index           =   2
            X1              =   240
            X2              =   4290
            Y1              =   1770
            Y2              =   1770
         End
      End
      Begin VB.Frame Frame1 
         Height          =   3255
         Index           =   1
         Left            =   -74910
         TabIndex        =   23
         Top             =   330
         Width           =   4455
         Begin VB.TextBox ServerText 
            Height          =   300
            Left            =   1800
            TabIndex        =   26
            Top             =   660
            Width           =   1905
         End
         Begin VB.CommandButton LjqdCommand 
            Caption         =   "确 定"
            Height          =   300
            Left            =   1410
            TabIndex        =   25
            Top             =   1440
            Width           =   1120
         End
         Begin VB.CommandButton LjqxCommand 
            Caption         =   "取 消"
            Height          =   300
            Left            =   2580
            TabIndex        =   24
            Top             =   1440
            Width           =   1120
         End
         Begin MSComCtl2.Animation Animation1 
            Height          =   615
            Left            =   150
            TabIndex        =   27
            Top             =   1290
            Visible         =   0   'False
            Width           =   705
            _ExtentX        =   1244
            _ExtentY        =   1085
            _Version        =   393216
            Center          =   -1  'True
            BackStyle       =   1
            FullWidth       =   47
            FullHeight      =   41
         End
         Begin VB.Label TsLabel 
            Alignment       =   1  'Right Justify
            AutoSize        =   -1  'True
            Caption         =   "数据服务器:"
            Height          =   180
            Index           =   7
            Left            =   765
            TabIndex        =   29
            Top             =   720
            Width           =   990
         End
         Begin VB.Label DdtsLabel 
            ForeColor       =   &H00FF0000&
            Height          =   255
            Left            =   1110
            TabIndex        =   28
            Top             =   2490
            Width           =   3045
         End
      End
      Begin VB.Frame Frame1 
         Height          =   3255
         Index           =   0
         Left            =   90
         TabIndex        =   13
         Top             =   330
         Width           =   4455
         Begin VB.CommandButton GgszCommand 
            Caption         =   "更改设置(&A)"
            Height          =   300
            Left            =   3210
            TabIndex        =   17
            Top             =   2430
            Width           =   1120
         End
         Begin VB.CommandButton XgmaCommand 
            Caption         =   "修改密码(&M)"
            Height          =   300
            Left            =   2040
            TabIndex        =   16
            Top             =   2430
            Width           =   1120
         End
         Begin VB.Timer Timer1 
            Interval        =   100
            Left            =   420
            Top             =   2550
         End
         Begin VB.TextBox MmText 
            Height          =   300
            IMEMode         =   3  'DISABLE
            Left            =   1050
            MaxLength       =   20
            PasswordChar    =   "*"
            TabIndex        =   5
            Top             =   1770
            Width           =   2730
         End
         Begin VB.ComboBox CzyCombo 
            Height          =   300
            Left            =   1050
            TabIndex        =   4
            Top             =   1380
            Width           =   3315
         End
         Begin VB.CommandButton Rlcommand 
            CausesValidation=   0   'False
            Height          =   300
            Left            =   4050
            Picture         =   "系统_登录窗体.frx":1096
            Style           =   1  'Graphical
            TabIndex        =   15
            Top             =   990
            Width           =   300
         End
         Begin VB.TextBox CzrqText 
            Height          =   300
            Left            =   1050
            MaxLength       =   10
            TabIndex        =   3
            Top             =   990
            Width           =   2985
         End
         Begin VB.ComboBox KjyearCombo 
            Height          =   300
            Left            =   1050
            Style           =   2  'Dropdown List
            TabIndex        =   2
            Top             =   600
            Width           =   3315
         End
         Begin VB.ComboBox ZtCombo 
            Height          =   300
            Left            =   1050
            Style           =   2  'Dropdown List
            TabIndex        =   1
            Top             =   210
            Width           =   3315
         End
         Begin VB.CommandButton QdCommand 
            Caption         =   "确定(&O)"
            Height          =   300
            Left            =   2040
            TabIndex        =   6
            Top             =   2790
            Width           =   1120
         End
         Begin VB.CommandButton QxCommand 
            Caption         =   "取消(&C)"
            Height          =   300
            Left            =   3210
            TabIndex        =   14
            Top             =   2790
            Width           =   1120
         End
         Begin VB.Image Image1 
            Height          =   480
            Left            =   3870
            Picture         =   "系统_登录窗体.frx":1420
            Top             =   1740
            Width           =   480
         End
         Begin VB.Line Line1 
            BorderColor     =   &H00FFFFFF&
            Index           =   1
            X1              =   180
            X2              =   4320
            Y1              =   2310
            Y2              =   2310
         End
         Begin VB.Line Line1 
            Index           =   0
            X1              =   180
            X2              =   4320
            Y1              =   2280
            Y2              =   2280
         End
         Begin VB.Label TsLabel 
            Caption         =   "密码:"
            Height          =   345
            Index           =   4
            Left            =   180
            TabIndex        =   22
            Top             =   1830
            Width           =   585
         End
         Begin VB.Label TsLabel 
            Alignment       =   1  'Right Justify
            AutoSize        =   -1  'True
            Caption         =   "用户名:"
            Height          =   180
            Index           =   2
            Left            =   165
            TabIndex        =   21
            Top             =   1410
            Width           =   630
         End
         Begin VB.Label TsLabel 
            Alignment       =   1  'Right Justify
            Caption         =   "公司帐套:"
            Height          =   255
            Index           =   0
            Left            =   120
            TabIndex        =   20
            Top             =   270
            Width           =   855
         End
         Begin VB.Label TsLabel 
            Alignment       =   1  'Right Justify
            Caption         =   "会计年度:"
            Height          =   345
            Index           =   1
            Left            =   150
            TabIndex        =   19
            Top             =   660
            Width           =   825
         End
         Begin VB.Label TsLabel 
            Alignment       =   1  'Right Justify
            Caption         =   "操作日期:"
            Height          =   345
            Index           =   3
            Left            =   150
            TabIndex        =   18
            Top             =   1050
            Width           =   825
         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
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 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 = 12
    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 = "15%"         '子系统菜单系统代号
    
    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.BaseInfoConnect.State = 1 Then Cw_DataEnvi.BaseInfoConnect.Close
        Cw_DataEnvi.BaseInfoConnect.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
    
    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
    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
        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
        
        CtdrCheck.Value = 1
        GgszCommand.Enabled = False
        XT_Main.Show
        
        Xt_Control.tvTreeView.Visible = False
        Xt_Control.tvTreeView.Nodes.Clear
        Xt_Control.Cshgns
        Xt_Control.tvTreeView.Refresh
        Xt_Control.tvTreeView.Visible = True
    End If
End Sub
Private Sub QxCommand_Click()                                     '取消进入系统
    If CtdrCheck.Value <> 1 Then
        Unload Me
    Else
        Me.Hide
    End If
End Sub
Private Sub Rlcommand_Click()                                     '操作日期帮助
    Call Czrqbz
End Sub
Private Sub Timer1_Timer()                                        '激活连接测试
    Timer1.Enabled = False
    
    If Ljyxxpd Then
        If Cw_DataEnvi.BaseInfoConnect.State = 1 Then Cw_DataEnvi.BaseInfoConnect.Close
        Cw_DataEnvi.BaseInfoConnect.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.BaseInfoConnect.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
    End With
End Sub
Private Sub ZtCombo_Click()
    Dim Xtztxxrec As New ADODB.Recordset        '系统帐套信息动态集
    Dim RecTemp As New ADODB.Recordset
    Dim Xt_Id As Integer                         '该模块系统的ID号
    
    On Error GoTo ErrHandle
    Set Xtztxxrec = Cw_DataEnvi.BaseInfoConnect.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 RecTemp = Cw_DataEnvi.DataConnect.Execute("Select ID From Xt_Xtgnb  Where gnbm='01'")
    If RecTemp.EOF = False Then
        Xt_Id = RecTemp.Fields("ID")
        Set Czyrec = Cw_DataEnvi.DataConnect.Execute("Select * From gy_czygl Where  right(left(AuthorityId," & Xt_Id & "),1)='1' order by czybm")
        XgmaCommand.Enabled = True
        QdCommand.Enabled = True
        CzyCombo.Enabled = True
    Else
        XgmaCommand.Enabled = False
        QdCommand.Enabled = False
        CzyCombo.Text = ""
        CzyCombo.Enabled = False
        Tsxx = "请将该系统的操作权限赋予操作员!"
        Call Xtxxts(Tsxx, 0, 4)
        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
        CzyCombo.Text = CzyCombo.List(0)
    End With
    Set Xtrlrec = Cw_DataEnvi.DataConnect.Execute("Select distinct kjyear From gy_kjrlb order by kjyear ")
    KjyearCombo.Clear
    With Xtrlrec
        Do While Not .EOF
           KjyearCombo.AddItem Trim(.Fields("kjyear"))
           .MoveNext
        Loop
    End With
    
    Set Xtrlrec = Cw_DataEnvi.DataConnect.Execute("Select top 1 kjyear From gy_kjrlb where cwzzjzbz=0 order by kjyear DESC,period ")
    If Not Xtrlrec.EOF Then
        KjyearCombo.Text = Xtrlrec.Fields("Kjyear")
    End If
   
    Call Drxtztcs             '读入系统帐套参数
  
    '[<<
    Call Drxtcs               '读入系统参数   6386086
   '>>]
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute("Select ServerDate=getdate()")
    CzrqText = Format(RecTemp.Fields("ServerDate"), "yyyy-mm-dd")
   
ErrHandle:
   
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")
    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
    
    If Trim(CzyCombo.Text) = "" Then
        Tsxx = "用户名不能为空!"
        Call Xtxxts(Tsxx, 0, 1)
        Xtyxxpd = False
        CzyCombo.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()                '修改密码
    If Trim(CzyCombo.Text) = "" Then Exit Sub
    
    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
    
    
    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
End Sub
Private Sub MmqdCommand_Click()                '修改密码完毕确定
    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
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

						