log.frm

来自「这个是我以前做的一个客户管理系统.包内已经含有源码和所用到的控件.代码是用VB写」· FRM 代码 · 共 312 行

VERSION 5.00
Begin VB.Form frmLogDB 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "用户登录"
   ClientHeight    =   2220
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5790
   Icon            =   "log.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2220
   ScaleWidth      =   5790
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.TextBox txtUser 
      Height          =   270
      Left            =   1500
      TabIndex        =   2
      Top             =   1335
      Width           =   2715
   End
   Begin VB.TextBox txtServer 
      BackColor       =   &H80000018&
      Enabled         =   0   'False
      Height          =   270
      Left            =   1500
      TabIndex        =   1
      Top             =   975
      Width           =   2715
   End
   Begin VB.CommandButton cmdCancel 
      Caption         =   "取 消(&C)"
      Height          =   315
      Left            =   4500
      TabIndex        =   8
      Top             =   660
      Width           =   1125
   End
   Begin VB.CommandButton cmdOk 
      Caption         =   "确 定(&O)"
      Height          =   315
      Left            =   4500
      TabIndex        =   7
      Top             =   210
      Width           =   1125
   End
   Begin VB.TextBox txtPassword 
      Height          =   270
      IMEMode         =   3  'DISABLE
      Left            =   1500
      PasswordChar    =   "*"
      TabIndex        =   5
      Top             =   1710
      Width           =   2715
   End
   Begin VB.Image Image1 
      Height          =   480
      Left            =   300
      Picture         =   "log.frx":0442
      Top             =   120
      Width           =   480
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "输入服务器和超级用户名,并输入用户口令"
      Height          =   180
      Index           =   3
      Left            =   930
      TabIndex        =   6
      Top             =   270
      Width           =   3330
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "用户口令："
      Height          =   180
      Index           =   2
      Left            =   420
      TabIndex        =   4
      Top             =   1770
      Width           =   900
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "超级用户名："
      Height          =   180
      Index           =   1
      Left            =   240
      TabIndex        =   3
      Top             =   1380
      Width           =   1080
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "服务器名称："
      Height          =   180
      Index           =   0
      Left            =   240
      TabIndex        =   0
      Top             =   1050
      Width           =   1080
   End
End
Attribute VB_Name = "frmLogDB"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'-------------------------------------------------------------------------------------------------------
' Module Name:
'               frmLog
' Function :
'               login user
' Author:
'               Liao HongFei
' Date:
'               2000/4/7--2000/4/13
' Related Forms:
'
' Related Tables:
'               clientsys..sysdata
' Related Globals:
'               Cn - the RDO connection used by all modules
' Public Variables:
'
'-------------------------------------------------------------------------------------------------------
Option Explicit

Dim iCountPsw       As Integer          '-记录连续输入密码的次数
Private Sub mEnterApp()
'*********************************************
'
'Purpose:
'       Check Data and goto Main Control
'
'Call by:
'       cmdOk_click
'Return:
'
'
'**********************************************

   If txtServer.Text = "" Then
        MsgBox "请输入服务器名称!!"
        txtServer.SetFocus
        Exit Sub
    ElseIf txtUser.Text = "" Then
        MsgBox "请输入用户名称!!"
        txtUser.SetFocus
        Exit Sub
    End If
    
'    gSchoolCode = txtSchoolCode
    
    If Not mbVerifyInfo Then
        iCountPsw = iCountPsw + 1
        If iCountPsw >= 3 Then
            MsgBox "输入错误超过3次，将退出系统"
            Unload Me
        Else
            MsgBox "输入错误，请检查服务器，用户名及密码输入是否正确!!", vbInformation, Me.Caption
            txtPassword.Text = ""
            txtPassword.SetFocus
        End If
    Else
'        gsSvrName = txtServer
'        gsUsrName = txtUser
'        gsPassword = txtPassword
        If mbSaveServerInfo(txtServer, txtUser, txtPassword) Then
            Unload Me
            main.Show 1
        End If
    End If
        
End Sub
Private Function mbSaveServerInfo(svrName As String, usrName As String, usrPassword As String) As Boolean
    Dim bRet        As Long
    Dim sFile       As String
    
    sFile = App.Path & "\Lib\" & "gx.ini"
    bRet = WritePrivateProfileString("SERVER", "ServerName", svrName, sFile)
    bRet = WritePrivateProfileString("SERVER", "UserName", usrName, sFile)
    bRet = WritePrivateProfileString("SERVER", "Password", usrPassword, sFile)
    mbSaveServerInfo = True
    
End Function
Private Sub mGetServerInfo()
    Dim sFile       As String
    Dim tmpStr      As String * 100
    Dim nLen        As Long
    
'    sFile = App.Path & "\Lib\" & "gx.ini"
'
'    nLen = GetPrivateProfileString("SERVER", "ServerName", "", tmpStr, 100, sFile)
'    If nLen > 0 Then txtServer = Mid(tmpStr, 1, nLen)
'
'    nLen = GetPrivateProfileString("SERVER", "UserName", "", tmpStr, 100, sFile)
'    If nLen > 0 Then txtUser = Mid(tmpStr, 1, nLen)
'
'    nLen = GetPrivateProfileString("SERVER", "Password", "", tmpStr, 100, sFile)
'    If nLen > 0 Then txtPassword = Mid(tmpStr, 1, nLen)
    
    txtServer = "(local)"
    txtUser = "sa"
    txtPassword = ""
    
        
End Sub
Private Function mbVerifyInfo() As Boolean
'*********************************************
'
'Purpose:
'       校验服务器，用户及口令 if there have new then connect it and save it
'                               else verify it
'Return:
'       if pass verify return TRUE
'       else return FALSE
'
'**********************************************
    Dim sSQL        As String
    
    Dim RS          As New ADODB.Recordset
    Dim bBegin      As Boolean
    
'    On Error GoTo ErrVerify
    
    bBegin = False

    mbVerifyInfo = gbGetNewConnect(txtServer.Text, txtUser.Text, txtPassword.Text)
    Exit Function
ErrVerify:
    mbVerifyInfo = False
    
    MsgBox "输入错误，请检查服务器，用户名及密码输入是否正确!!", vbInformation, Me.Caption
End Function
Private Sub mInitForm()
    KeyPreview = True
    
    
    
'    center Me
'    If gbGetNewConnect("liao", "sa", "") Then
'        txtpassword.MaxLength = 20
'        txtpassword.PasswordChar = "*"
    '        iCountPsw = 0
'        Call mGetServerInfo
'    End If
End Sub

Private Sub cmdCancel_Click()
    Unload Me
End Sub

Private Sub cmdOK_Click()
    Call mEnterApp
End Sub

Private Sub Form_Activate()
    Call mGetServerInfo
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    
    If KeyCode = vbKeyReturn Then
        KeyCode = 0
        SendKeys "{Tab}"
    ElseIf KeyCode = vbKeyEscape Then
        KeyCode = 0
        Unload Me
    ElseIf KeyCode = vbKeyUp Then
        KeyCode = 0
        SendKeys "+{Tab}"
    ElseIf KeyCode = vbKeyDown Then
        KeyCode = 0
        SendKeys "{Tab}"
    End If
    
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        cmdOk.Value = True
    ElseIf KeyAscii = vbKeyEscape Then
        cmdCancel.Value = True
    End If
End Sub

Private Sub Form_Load()
    Call mInitForm
End Sub

Private Sub txtpassword_GotFocus()
'    InitTextBox txtPassword
End Sub

Private Sub txtPassword_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Then
        KeyCode = 0
        Call cmdOK_Click
    End If
End Sub

Private Sub txtServer_GotFocus()
'    InitTextBox txtServer
End Sub

Private Sub txtUser_GotFocus()
 '   InitTextBox txtUser
End Sub