frmconnect.frm

来自「一个关于电脑管理汽车的软件」· FRM 代码 · 共 349 行

VERSION 5.00
Object = "{40D97E01-4259-4398-B597-183C348B488F}#1.0#0"; "BSE.ocx"
Begin VB.Form frmConnect 
   BackColor       =   &H8000000D&
   BorderStyle     =   0  'None
   Caption         =   "登录界面"
   ClientHeight    =   3150
   ClientLeft      =   0
   ClientTop       =   -105
   ClientWidth     =   6750
   FillColor       =   &H00FFFFFF&
   Icon            =   "frmConnect.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   Picture         =   "frmConnect.frx":000C
   ScaleHeight     =   3150
   ScaleWidth      =   6750
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'CenterScreen
   Begin VB.ComboBox Combo1 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   360
      Left            =   2280
      TabIndex        =   7
      Top             =   1440
      Width           =   1815
   End
   Begin VB.TextBox txtPassword 
      Height          =   285
      IMEMode         =   3  'DISABLE
      Left            =   2280
      PasswordChar    =   "*"
      TabIndex        =   3
      Top             =   2040
      Width           =   1815
   End
   Begin VB.TextBox txtHost 
      Height          =   285
      Left            =   2280
      TabIndex        =   2
      Text            =   "192.168.1.13"
      Top             =   840
      Width           =   1815
   End
   Begin VB.CommandButton cmdExit 
      Cancel          =   -1  'True
      Caption         =   "退 出"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   4920
      TabIndex        =   1
      Top             =   2160
      Width           =   975
   End
   Begin VB.CommandButton cmdConnect 
      Caption         =   "登 录"
      Default         =   -1  'True
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   4920
      TabIndex        =   0
      Top             =   1320
      Width           =   975
   End
   Begin BSE_Engine.BSE BSE1 
      Left            =   1560
      Top             =   3480
      _ExtentX        =   6588
      _ExtentY        =   1085
   End
   Begin VB.Label Label1 
      BackColor       =   &H00E0E0E0&
      BackStyle       =   0  'Transparent
      Caption         =   "密码："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Index           =   2
      Left            =   1560
      TabIndex        =   6
      Top             =   2040
      Width           =   855
   End
   Begin VB.Label Label1 
      BackColor       =   &H00E0E0E0&
      BackStyle       =   0  'Transparent
      Caption         =   "用户："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Index           =   1
      Left            =   1560
      TabIndex        =   5
      Top             =   1440
      Width           =   855
   End
   Begin VB.Label Label1 
      BackColor       =   &H00E0E0E0&
      BackStyle       =   0  'Transparent
      Caption         =   "主机："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Index           =   0
      Left            =   1560
      TabIndex        =   4
      Top             =   840
      Width           =   855
   End
End
Attribute VB_Name = "frmConnect"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private VarCount As Integer





Private Sub cmdConnect_Click()
On Error GoTo eh
 Dim VarDatabase As String
 Dim VarRS As MYSQL_RS
 Dim TempSQL As String
 Dim i As Long
    ReDim GPopedomBS(1 To 38)
    Me.MousePointer = vbHourglass
    VarDatabase = "szjxc"
    Set gCnn = New MYSQL_CONNECTION
    Set oCnn = New ADODB.Connection
    
    gCnn.OpenConnection txtHost, "system", "shengshi981238", VarDatabase
  '  gCnn.OpenConnection txtHost, "root", , VarDatabase
    oCnn.ConnectionString = "DRIVER={MySQL ODBC 3.51 Driver};" _
        & "SERVER=" & txtHost & ";" _
        & "DATABASE=szjxc;" _
        & "UID=system;" _
        & "PWD=shengshi981238;" _
        & "OPTION=" & 1 + 2 + 8 + 32 + 2048 + 16384
   ' oCnn.ConnectionString = "DRIVER={MySQL ODBC 3.51 Driver};" _
        & "SERVER=" & txtHost & ";" _
        & "DATABASE=szjxc;" _
        & "UID=root;" _
        & "PWD=;" _
        & "OPTION=" & 1 + 2 + 8 + 32 + 2048 + 16384
    oCnn.Open
    i = oCnn.State
    Me.MousePointer = vbNormal
    If gCnn.State = MY_CONN_OPEN Then
        Set VarRS = New MYSQL_RS
        TempSQL = "Select * from operatesettable Where operatename = " & Quote(Combo1.Text) & " and password = " & Quote(txtPassword.Text)
        VarRS.OpenRs TempSQL, gCnn
        If VarRS.RecordCount > 0 Then
         With VarRS
           CurrentOperate = .Fields("operatename").Value
           For i = 1 To 38
            If Val(.Fields("qx" & i).Value) > 0 Then
             GPopedomBS(i) = True
            End If
           Next i
         End With
         VarRS.CloseRecordset
         VarRS.ReleaseMemory
         Set VarRS = Nothing
         
       '  SaveSetting App.Title, "Settings", "txtHost", txtHost
         If FindSameKey(Combo1.Text) = False Then
          SaveSetting App.Title, "Settings", "UserName" & VarCount, Combo1.Text
          Combo1.AddItem Combo1.Text
          VarCount = VarCount + 1
         End If
        ' SaveSetting App.Title, "Settings", "cmbDatabase", cmbDatabase
         'CreateTables
         If frmMain.ExistBS = False Then
          frmMain.Show 'vbModal
         Else
          frmMain.Status.Panels(2).Text = "操作员：" & CurrentOperate
          SystemSet.LoadData True
         End If
         Unload Me
        Else
         MsgBox "用户名或者密码输入不正确", vbCritical, "警告"
         txtPassword.Text = ""
         VarRS.CloseRecordset
         VarRS.ReleaseMemory
         gCnn.CloseConnection
         Set gCnn = Nothing
        End If
    Else
        MsgBox "不能建立连接，请检查你的设置重新再试", vbCritical, "警告"
        gCnn.CloseConnection
        Set gCnn = Nothing
    End If
Exit Sub
eh:
    MsgBox Err.Number & " " & Err.Description, vbCritical, "Error While Connecting"
    gCnn.CloseConnection
    Set gCnn = Nothing
End Sub
Private Sub cmdExit_Click()
  If frmMain.ExistBS = True Then Unload frmMain
  Unload Me
  End
End Sub





Private Sub Combo1_DropDown()
'Stop
End Sub

Private Sub Form_LoadBak()
 Dim i As Integer
 Dim TempStr As String
    
    VarInitData.InitBSE BSE1, 0
    
    VarCount = 0
    Combo1.AddItem "系统管理员"
    For i = 0 To 100
     TempStr = GetSetting(App.Title, "Settings", "UserName" & i)
     If TempStr <> "" Then
      VarCount = VarCount + 1
      Combo1.AddItem TempStr
     Else
      Exit For
     End If
    Next i
    Combo1.ListIndex = 0
  '  txtUserName = GetSetting(App.Title, "Settings", "txtUserName", "root")
    'txtPassword = GetSetting(App.Title, "Settings", "txtPassword", "")
    'cmbDatabase = GetSetting(App.Title, "Settings", "cmbDatabase", "")
End Sub
Private Sub Form_Load()
 On Error GoTo eh
 Dim VarDatabase As String
 Dim VarRS As MYSQL_RS
 Dim TempSQL As String
 Dim i As Long
    txtHost.Visible = False
    Label1(0).Visible = False
    VarDatabase = "szjxc"
    Set gCnn = New MYSQL_CONNECTION
    
    gCnn.OpenConnection txtHost, "system", "shengshi981238", VarDatabase
    
    If gCnn.State = MY_CONN_OPEN Then
     Set VarRS = New MYSQL_RS
     TempSQL = "Select coding, operatename From operatesettable "
     VarRS.OpenRs TempSQL, gCnn
     With VarRS
      Do Until .EOF
       Combo1.AddItem .Fields("operatename").Value
       .MoveNext
      Loop
      .CloseRecordset
      .ReleaseMemory
     End With
     Set VarRS = Nothing
     gCnn.CloseConnection
     Set gCnn = Nothing
    Else
     MsgBox "不能建立连接，请检查你的设置重新再试", vbCritical, "警告"
     If gCnn Is Nothing Then Exit Sub
     gCnn.CloseConnection
     Set gCnn = Nothing
    End If
 

    VarInitData.InitBSE BSE1, 0

    Combo1.ListIndex = 0
    Exit Sub
eh:
    MsgBox Err.Number & " " & Err.Description, vbCritical, "Error While Connecting"
    If gCnn Is Nothing Then Exit Sub
    gCnn.CloseConnection
    Set gCnn = Nothing
    
End Sub


Private Function FindSameKey(ByVal VarStr As String) As Boolean
 Dim i As Integer
 Dim TempCount As Integer
 FindSameKey = False
 TempCount = Combo1.ListCount
 If TempCount > 0 Then
  For i = 1 To TempCount
    If Combo1.List(i - 1) = VarStr Then
     FindSameKey = True
     Exit For
    End If
  Next i
 End If
End Function