formusr.frm

运用VB和SQL Server实现

VERSION 5.00
Begin VB.Form FormUsr 
   BackColor       =   &H00C0C0C0&
   Caption         =   "登录"
   ClientHeight    =   2805
   ClientLeft      =   4860
   ClientTop       =   3330
   ClientWidth     =   4935
   DrawStyle       =   1  'Dash
   ForeColor       =   &H00FF0000&
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   2805
   ScaleWidth      =   4935
   Begin VB.CommandButton Usr_Cancel 
      Caption         =   "退出"
      Height          =   375
      Left            =   3720
      TabIndex        =   5
      Top             =   2160
      Width           =   975
   End
   Begin VB.CommandButton Usr_Ok 
      Caption         =   "登录"
      Height          =   375
      Left            =   2280
      TabIndex        =   4
      Top             =   2160
      Width           =   975
   End
   Begin VB.TextBox Usr_PW 
      Height          =   375
      IMEMode         =   3  'DISABLE
      Left            =   3240
      PasswordChar    =   "*"
      TabIndex        =   2
      Top             =   1440
      Width           =   1455
   End
   Begin VB.TextBox Usr_Name 
      Height          =   375
      Left            =   3240
      TabIndex        =   0
      Top             =   840
      Width           =   1455
   End
   Begin VB.Image Image1 
      Height          =   1920
      Left            =   120
      Picture         =   "FormUsr.frx":0000
      Top             =   720
      Width           =   1920
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "家庭理财系统"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   18
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   -1  'True
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000080FF&
      Height          =   480
      Left            =   1320
      TabIndex        =   6
      Top             =   240
      Width           =   2370
   End
   Begin VB.Label Label2 
      BackStyle       =   0  'Transparent
      Caption         =   "密  码："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00000000&
      Height          =   255
      Left            =   2160
      TabIndex        =   3
      Top             =   1440
      Width           =   975
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "用户名："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00000000&
      Height          =   255
      Left            =   2160
      TabIndex        =   1
      Top             =   960
      Width           =   975
   End
End
Attribute VB_Name = "FormUsr"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Form_Load() '窗体加载
'判断是否已经启动过程序
If App.PrevInstance Then
    MsgBox "您已经启动过程序"
    End
End If
'连接数据库
DataIni
End Sub

Private Sub Usr_Cancel_Click()  '退出
RemoteCnn.Close     '远程连接关闭
Unload Me           '卸载本窗体
End Sub

Private Sub Usr_Ok_Click()  '登录
Dim rscheck As New adodb.Recordset

If Len(Trim(Me.Usr_Name.Text)) <= 0 Then
        MsgBox "请输入用户名"
        Exit Sub
End If

On Error GoTo Err
'打开家庭成员表
rscheck.Open "select * from Family where FamilyName='" & Trim(Me.Usr_Name.Text) & _
             "'", RemoteCnn, adOpenStatic, adLockReadOnly, -1
    If rscheck.RecordCount <= 0 Then    '是否存在该用户名
        MsgBox "没有这个用户名" & vbCrLf & "请重新输入！"
        rscheck.Close
        Exit Sub
    Else
        UserName = Trim(Me.Usr_Name.Text)
        rscheck.MoveFirst
        UserPwd = rscheck.Fields("FamilyPwd").Value
        PowerType = rscheck.Fields("FamilyType").Value
        If Me.Usr_PW.Text <> UserPwd Then   '密码核对
            MsgBox "密码错误"
            Exit Sub
        End If
    End If
rscheck.Close       '关闭家庭成员表
MDIMainForm.Show    '显示主窗体
Unload Me           '卸载本窗体
On Error GoTo 0
Exit Sub
Err:
    MsgBox "数据库错误"
    End
End Sub
Private Sub DataIni()   '连接数据库
Dim sqlstr As String
Dim ini As New adodb.Recordset
    
On Error GoTo Err
'连接本地数据库，获得连接ODBC的相关数据
sqlstr = "Provider = Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;Data Source =" & _
App.Path & "\mdb\local.mdb;Mode=ReadWrite|Share Deny None;Persist Security Info=False"
LocalCnn.Open sqlstr      '获得数据
    With ini
    .Open "select * from 初始化", LocalCnn, adOpenStatic, adLockReadOnly, -1
    MyDSN = .Fields("DSN").Value    '所连接的ODBC对象
    UID = .Fields("UID").Value      '用户名
    PWD = .Fields("PWD").Value      '用户密码
conn:
.Close
End With
LocalCnn.Close  '关闭本地连接
'连接ODBC

sqlstr = "DSN=" & Trim(MyDSN) & ";UID=" & Trim(UID) & ";PWD=" & Trim(PWD) & ";"
RemoteCnn.Open sqlstr

On Error GoTo 0
Exit Sub
Err:
If Err.Number = 94 Then GoTo conn
    MsgBox "打开数据库错误！"
    End
End Sub