frmlogin.frm

此为我2001年为东莞建发楦头开发的企业管理软件他们使用至今,望斑竹指教! 其他会员最好不要随意下载,需经斑竹同意或我本人同意,谢谢!

VERSION 5.00
Begin VB.Form frmlogin 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "登录对话框"
   ClientHeight    =   2895
   ClientLeft      =   2295
   ClientTop       =   2565
   ClientWidth     =   5640
   ControlBox      =   0   'False
   Icon            =   "frmlogin.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2895
   ScaleWidth      =   5640
   StartUpPosition =   2  '屏幕中心
   Begin VB.Frame Frame1 
      Caption         =   "登录信息"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   9.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00000080&
      Height          =   2055
      Left            =   120
      TabIndex        =   4
      Top             =   120
      Width           =   5295
      Begin VB.ComboBox Cmbuser 
         Height          =   300
         ItemData        =   "frmlogin.frx":0442
         Left            =   2880
         List            =   "frmlogin.frx":0444
         Style           =   2  'Dropdown List
         TabIndex        =   0
         Top             =   480
         Width           =   1575
      End
      Begin VB.TextBox txtpassword 
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   9.75
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   300
         IMEMode         =   3  'DISABLE
         Left            =   2880
         MaxLength       =   10
         PasswordChar    =   "*"
         TabIndex        =   1
         Top             =   1320
         Width           =   1572
      End
      Begin VB.Image Image1 
         Appearance      =   0  'Flat
         Height          =   975
         Left            =   240
         OLEDropMode     =   2  'Automatic
         Picture         =   "frmlogin.frx":0446
         Stretch         =   -1  'True
         Top             =   360
         Width           =   915
      End
      Begin VB.Label Label1 
         Caption         =   "用户名称："
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   11.25
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   1440
         TabIndex        =   6
         Top             =   480
         Width           =   1215
      End
      Begin VB.Label Label2 
         Caption         =   "密    码："
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   11.25
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   1440
         TabIndex        =   5
         Top             =   1320
         Width           =   1215
      End
   End
   Begin VB.CommandButton cmdcancel 
      Caption         =   "取消"
      Height          =   372
      Left            =   3120
      Picture         =   "frmlogin.frx":0888
      TabIndex        =   3
      Top             =   2400
      Width           =   1335
   End
   Begin VB.CommandButton cmdok 
      BackColor       =   &H80000017&
      Caption         =   "确定"
      Height          =   372
      Left            =   1200
      MaskColor       =   &H00FFFFC0&
      TabIndex        =   2
      Top             =   2400
      Width           =   1335
   End
End
Attribute VB_Name = "frmlogin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim optb As Recordset
Private Sub rights()
'Check User Rights
Dim i As Integer

frmain.main(1).Enabled = True
frmain.main(2).Enabled = True
frmain.main(3).Enabled = True
frmain.main(4).Enabled = True
frmain.main(5).Enabled = True
frmain.main(6).Enabled = True

For i = 25 To optb.Fields.Count
    If optb.Fields(i) = -1 Then
        If i < 35 Then frmain.base(i - 24).Enabled = True
        If i >= 35 And i < 50 Then frmain.gr(i - 34).Enabled = True
        If i >= 50 And i < 55 Then frmain.tq(i - 49).Enabled = True
        If i >= 55 And i < 65 Then frmain.cube(i - 54).Enabled = True
        If i >= 65 And i < 70 Then frmain.kf(i - 64).Enabled = True
        If i >= 70 And i < 76 Then frmain.zl(i - 69).Enabled = True
        If i >= 76 And i < 79 Then frmain.exit(i - 75).Enabled = True
        If i >= 79 And i < 88 Then frmain.Toolbar1.Buttons(i - 78).Enabled = True
    Else
        If i < 35 Then frmain.base(i - 24).Enabled = False
        If i >= 35 And i < 50 Then frmain.gr(i - 34).Enabled = False
        If i >= 50 And i < 55 Then frmain.tq(i - 49).Enabled = False
        If i >= 55 And i < 65 Then frmain.cube(i - 54).Enabled = False
        If i >= 65 And i < 70 Then frmain.kf(i - 64).Enabled = False
        If i >= 70 And i < 76 Then frmain.zl(i - 69).Enabled = False
        If i >= 76 And i < 79 Then frmain.exit(i - 75).Enabled = False
        If i >= 79 And i < 88 Then frmain.Toolbar1.Buttons(i - 78).Enabled = False
    End If
Next
'   '基础资料
'   If optb!client = -1 Then
'    frmain.base(1).Enabled = True
'    frmain.base(2).Enabled = True
'    frmain.base(5).Enabled = True
'    frmain.Toolbar1.Buttons(1).Enabled = True
'   Else
'    frmain.base(1).Enabled = False
'    frmain.base(2).Enabled = False
'    frmain.base(5).Enabled = False
'    frmain.Toolbar1.Buttons(1).Enabled = False
'   End If
'
'   If optb!employee = -1 Then
'     frmain.base(3).Enabled = True
'   Else
'     frmain.base(3).Enabled = False
'   End If
'
'   If optb!sn = -1 Then
'     frmain.base(4).Enabled = True
'   Else
'     frmain.base(4).Enabled = False
'   End If
'
'   If optb!Delete = -1 Then
'     frmain.base(7).Enabled = True
'     frmain.base(8).Enabled = True
'   Else
'     frmain.base(7).Enabled = False
'     frmain.base(8).Enabled = False
'   End If
'
'    If optb!sproduce1 = -1 Then
'        frmain.gr(4).Enabled = True
'        frmain.Toolbar1.Buttons(3).Enabled = True
'    Else
'        frmain.gr(4).Enabled = False
'        frmain.Toolbar1.Buttons(3).Enabled = False
'    End If
'
'    If optb!sproduce2 = -1 Then
'        frmain.gr(8).Enabled = True
'        frmain.Toolbar1.Buttons(4).Enabled = True
'    Else
'        frmain.gr(8).Enabled = False
'        frmain.Toolbar1.Buttons(4).Enabled = False
'    End If
'
'    If optb!din = -1 Then
'        frmain.gr(1).Enabled = True
'        frmain.Toolbar1.Buttons(2).Enabled = True
'    Else
'        frmain.gr(1).Enabled = False
'        frmain.Toolbar1.Buttons(2).Enabled = False
'    End If
'
'    If optb!ti = -1 Then
'        frmain.gr(12).Enabled = True
'        frmain.Toolbar1.Buttons(5).Enabled = True
'    Else
'        frmain.gr(12).Enabled = False
'        frmain.Toolbar1.Buttons(5).Enabled = False
'    End If
'
'
'    If optb!qinflag = -1 Then
'        frmain.gr(14).Enabled = True
'        frmain.gr(15).Enabled = True
'        frmain.gr(16).Enabled = True
'        frmain.Toolbar1.Buttons(7).Enabled = True
'    Else
'        frmain.gr(14).Enabled = False
'        frmain.gr(15).Enabled = False
'        frmain.gr(16).Enabled = False
'        frmain.Toolbar1.Buttons(7).Enabled = False
'    End If
'
'
'    If optb!total = -1 Then
'        frmain.gr(2).Enabled = True
'        frmain.gr(5).Enabled = True
'        frmain.gr(6).Enabled = True
'        frmain.gr(9).Enabled = True
'        frmain.gr(10).Enabled = True
'        frmain.gr(13).Enabled = True
'        frmain.gr(18).Enabled = True
'        frmain.gr(19).Enabled = True
'        frmain.gr(21).Enabled = True
'        frmain.gr(22).Enabled = True
'        frmain.gr(23).Enabled = True
'    Else
'        frmain.gr(2).Enabled = False
'        frmain.gr(5).Enabled = False
'        frmain.gr(6).Enabled = False
'        frmain.gr(9).Enabled = False
'        frmain.gr(10).Enabled = False
'        frmain.gr(13).Enabled = False
'        frmain.gr(18).Enabled = False
'        frmain.gr(19).Enabled = False
'        frmain.gr(21).Enabled = False
'        frmain.gr(22).Enabled = False
'        frmain.gr(23).Enabled = False
'    End If
'
'    If optb!everyday = -1 Then
'        frmain.cube(4).Enabled = True
'        frmain.cube(5).Enabled = True
'    Else
'        frmain.cube(4).Enabled = False
'        frmain.cube(5).Enabled = False
'    End If
'
'    If optb!sheng = -1 Then
'        frmain.cube(1).Enabled = True
'    Else
'        frmain.cube(1).Enabled = False
'    End If
'
'    If optb!stk = -1 Then
'        frmain.cube(2).Enabled = True
'        frmain.gr(24).Enabled = True
'    Else
'        frmain.cube(2).Enabled = False
'        frmain.gr(24).Enabled = False
'    End If
'
'
'    If optb!kf = -1 Then
'        frmain.kf(1).Enabled = True
'        frmain.Toolbar1.Buttons(6).Enabled = True
'    Else
'        frmain.kf(1).Enabled = False
'        frmain.Toolbar1.Buttons(6).Enabled = False
'    End If
'
'    If optb!kfmodi = -1 Then
'        frmain.kf(2).Enabled = True
'        frmain.Toolbar1.Buttons(8).Enabled = True
'    Else
'        frmain.kf(2).Enabled = False
'        frmain.Toolbar1.Buttons(8).Enabled = False
'    End If
'
'    If optb!kffind = -1 Then
'        frmain.kf(5).Enabled = True
'        frmain.kf(6).Enabled = True
'    Else
'        frmain.kf(5).Enabled = False
'        frmain.kf(6).Enabled = False
'    End If
'
'
'
End Sub
Private Sub cmdCancel_Click()
    opvalue = ""
    namevalue = ""
    passvalue = ""
    mzhiwu = ""
    frmain.main(1).Enabled = False
    frmain.main(2).Enabled = False
    frmain.main(3).Enabled = False
    frmain.main(4).Enabled = False
    frmain.main(5).Enabled = False
    frmain.main(6).Enabled = False
    
    frmain.Toolbar1.Buttons(1).Enabled = False
    frmain.Toolbar1.Buttons(2).Enabled = False
    frmain.Toolbar1.Buttons(3).Enabled = False
    frmain.Toolbar1.Buttons(4).Enabled = False
    frmain.Toolbar1.Buttons(5).Enabled = False
    frmain.Toolbar1.Buttons(6).Enabled = False
    frmain.Toolbar1.Buttons(7).Enabled = False
    frmain.Toolbar1.Buttons(8).Enabled = False
    Unload Me
End Sub

Private Sub cmdok_Click()
On Error Resume Next
    Dim sql As String
    
    sql = "select * from op where " & "name=" & "'" & Cmbuser.Text & "'" & " and " & "psd=" & "'" & txtpassword.Text & "'"
    Set optb = New Recordset
    optb.Open sql, db, adOpenStatic, adLockOptimistic
    If optb.RecordCount > 0 Then
        opvalue = ""
        namevalue = ""
        passvalue = ""
        mzhiwu = ""
        opvalue = optb!op
        namevalue = optb!name
        passvalue = optb!Psd
        PcheckStk = optb!Find
        Pdelete = optb!Pdelete
        If IsNull(optb!zhiwu) = False Then mzhiwu = optb!zhiwu
        
        frmain.Show
        
        frmain.Caption = "进销存电脑管理信息系统   操作员:" & namevalue & "  今天是:" & Format(Date, "dddddd") _
        & "     现在时间:" & Format(Time, "h:mm")

        rights
        Unload Me
    Else
        MsgBox "用户名或密码不正确,请核对！！！", vbCritical, "提示信息"
        txtpassword.Text = ""
        Cmbuser.SetFocus
    End If
End Sub

Private Sub cmbuser_Change()
    txtpassword.SetFocus
End Sub

Private Sub cmbuser_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then txtpassword.SetFocus
End Sub

Private Sub Form_Activate()
    Cmbuser.SetFocus
End Sub

Private Sub Form_Load()


    SqlConn = "PROVIDER=MSDASQL;driver={SQL Server};server=server;uid=sa;pwd=;database=jfdata;"
    SqlConn1 = "PROVIDER=MSDataShape;Data PROVIDER=MSDASQL;driver={SQL Server};server=server;uid=sa;pwd=;database=jfdata"
    Set db = New Connection
    db.CursorLocation = adUseClient
    db.Open SqlConn
    '2002-10-19 As No input password , can use other module ,mask frmain
'    frmain.Show
    
    Dim optb As Recordset
    Set optb = New Recordset
    optb.Open "select * from op", db, adOpenStatic, adLockOptimistic
    If optb.RecordCount = 0 Then
        optb.AddNew
        optb!op = "999"
        optb!name = "system"
        optb!Psd = ""
        optb!client = -1
        optb!sproduce1 = -1
        optb!sproduce2 = -1
        optb!total = -1
        optb!Delete = -1
        optb!employee = -1
    End If

    Dim i As Integer
    optb.MoveFirst
    For i = 1 To optb.RecordCount
        If IsNull(optb!name) = False Then Cmbuser.AddItem optb!name
        optb.MoveNext
    Next
    Cmbuser.ListIndex = 0
End Sub

Private Sub Form_Resize()
'On Error Resume Next
'Me.Top = 0
'Me.Left = 50
End Sub

Private Sub txtpassword_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then cmdok_Click
End Sub