frmdbconfirm.frm

通用书店管理系统

VERSION 5.00
Begin VB.Form frmDBconfirm 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "数据库配置"
   ClientHeight    =   3030
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4845
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3030
   ScaleWidth      =   4845
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton cmdTest 
      Caption         =   "测试"
      Height          =   375
      Left            =   3960
      TabIndex        =   5
      Top             =   1680
      Visible         =   0   'False
      Width           =   735
   End
   Begin VB.CommandButton cmdCancel 
      Cancel          =   -1  'True
      Caption         =   "取消"
      Height          =   375
      Left            =   3960
      TabIndex        =   4
      Top             =   960
      Width           =   735
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "确定"
      Default         =   -1  'True
      Height          =   375
      Left            =   3960
      TabIndex        =   3
      Top             =   240
      Width           =   735
   End
   Begin VB.Frame fraStep3 
      Caption         =   "连接选项"
      Height          =   2680
      Index           =   0
      Left            =   120
      TabIndex        =   6
      Top             =   120
      Width           =   3645
      Begin VB.TextBox txtDatabase 
         Height          =   375
         Left            =   1080
         MaxLength       =   50
         TabIndex        =   0
         Top             =   600
         Width           =   2415
      End
      Begin VB.TextBox txtUserName 
         Height          =   375
         Left            =   1080
         MaxLength       =   50
         TabIndex        =   1
         Top             =   1380
         Width           =   2415
      End
      Begin VB.TextBox txtPassword 
         Height          =   375
         IMEMode         =   3  'DISABLE
         Left            =   1080
         MaxLength       =   50
         PasswordChar    =   "*"
         TabIndex        =   2
         Top             =   2160
         Width           =   2415
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "数据库(&D)"
         Height          =   255
         Index           =   2
         Left            =   120
         TabIndex        =   9
         Top             =   720
         Width           =   855
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "密  码(&P)"
         Height          =   255
         Index           =   4
         Left            =   120
         TabIndex        =   8
         Top             =   2280
         Width           =   855
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "用户名(&N)"
         Height          =   255
         Index           =   3
         Left            =   120
         TabIndex        =   7
         Top             =   1500
         Width           =   855
      End
   End
End
Attribute VB_Name = "frmDBconfirm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public blnopened As Boolean
Public blnmodeok As Boolean



Private Sub cbxDatabase_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Then SendKeys "{Tab}"
End Sub

Private Sub cmdOK_Click()
    Dim strKey As String
    Dim str_conPWd As String
    Dim ss As String
    Dim ret As Long
    Dim hKey As Long
    
    ss = Trim(txtDatabase.Text)
    strKey = "Software\" & App.CompanyName & "\" & App.ProductName & "\DBOption"
    If Len(Trim(txtDatabase.Text)) > 0 Then
        'Call Registry.UpdateKey(HKEY_LOCAL_MACHINE, strKey, "DataBase", Trim(txtDatabase.Text))
        ret = RegCreateKey(HKEY_LOCAL_MACHINE, strKey, hKey)
    End If
    ret = RegSetValueEx(hKey, "DataBase", 0, REG_SZ, ByVal ss, LenB(StrConv(ss, vbFromUnicode)))
        
    ss = Trim(txtUserName.Text)
    ret = RegSetValueEx(hKey, "Uid", 0, REG_SZ, ByVal ss, LenB(StrConv(ss, vbFromUnicode)))
    ss = Trim(txtPassword.Text)
    ret = RegSetValueEx(hKey, "Pwd", 0, REG_SZ, ByVal ss, LenB(StrConv(ss, vbFromUnicode)))
    
    'Call Registry.UpdateKey(HKEY_LOCAL_MACHINE, strKey, "Uid", Trim(txtUserName.Text))
    'Call Registry.UpdateKey(HKEY_LOCAL_MACHINE, strKey, "Pwd", Trim(txtPassword.Text))
    
    blnmodeok = True
    Unload Me
    MsgBox "已成功进行数据库的配置。", vbInformation
End Sub

Private Sub cmdCancel_Click()
    Unload Me
End Sub

'Private Sub cmdTest_Click()
'    On Error GoTo ConError
'    Dim i As Integer
'    TestServer.LoginTimeout = 20
'    TestServer.Connect txtServer.Text, txtUserName.Text, txtPassword.Text
'    cbxDatabase.Clear
'    For i = 1 To TestServer.Databases.Count
'        cbxDatabase.AddItem TestServer.Databases(i).Name
'    Next
'    cbxDatabase.Text = cbxDatabase.List(0)
'    TestServer.Disconnect
'    If Err.Description = "" Then
'        cmdOK.Enabled = True
'        cbxDatabase.SelLength = Len(cbxDatabase.Text)
'    End If
'    Exit Sub
'ConError:
'    MsgBox ("不能连接到此数据库,错误信息:" & Err.Description)
'End Sub

Private Sub Form_Load()
    Dim strTemp As String * 300, strKey As String
    Dim intI As Integer
    Dim strS As String
    
    strKey = "software\" & App.CompanyName & "\" & App.ProductName & "\DBOption"
    If Registry.GetKeyValue(HKEY_LOCAL_MACHINE, strKey, "DataBase", strTemp) Then
        strTemp = Trim(strTemp)
        intI = InStr(1, strTemp, Chr(0))
        If intI > 0 Then
            strS = Left(strTemp, intI - 1)
        Else
            strS = Trim(strTemp)
        End If
        Me.txtDatabase.Text = strS
    End If
    If Registry.GetKeyValue(HKEY_LOCAL_MACHINE, strKey, "Uid", strTemp) Then
        Me.txtUserName.Text = Trim(strTemp)
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    blnopened = False
End Sub

Private Sub txtPassword_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then Call EnterToTab(KeyAscii, True)
End Sub

Private Sub txtServer_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then Call EnterToTab(KeyAscii, True)
End Sub

Private Sub txtUserName_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then Call EnterToTab(KeyAscii, True)
End Sub