frmodbclogon.frm

金算盘软件代码

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmODBCLogon 
   AutoRedraw      =   -1  'True
   BackColor       =   &H80000013&
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Oracle连接"
   ClientHeight    =   2475
   ClientLeft      =   2850
   ClientTop       =   1755
   ClientWidth     =   4860
   ControlBox      =   0   'False
   Icon            =   "frmODBCLogon.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2475
   ScaleWidth      =   4860
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.ComboBox cboConnect 
      Height          =   300
      Left            =   1500
      TabIndex        =   1
      Text            =   "Combo1"
      Top             =   420
      Width           =   3165
   End
   Begin VB.CommandButton cmdCancel 
      Cancel          =   -1  'True
      Caption         =   "取消"
      Height          =   390
      Left            =   2670
      TabIndex        =   7
      Top             =   1980
      Width           =   1320
   End
   Begin VB.CommandButton cmdConnect 
      Caption         =   "连接(&C)"
      Default         =   -1  'True
      Height          =   390
      Left            =   840
      TabIndex        =   6
      Top             =   1968
      Width           =   1245
   End
   Begin VB.Frame fraStep3 
      BackColor       =   &H80000013&
      Caption         =   "连接信息"
      Height          =   1644
      Index           =   0
      Left            =   120
      TabIndex        =   8
      Top             =   180
      Width           =   4620
      Begin VB.TextBox txtPass 
         Height          =   300
         IMEMode         =   3  'DISABLE
         Left            =   1368
         MaxLength       =   8
         PasswordChar    =   "*"
         TabIndex        =   5
         Top             =   1152
         Width           =   3180
      End
      Begin VB.ComboBox txtDriver 
         Height          =   300
         Left            =   1365
         TabIndex        =   3
         Text            =   "用于 Oracle 的微软 ODBC 驱动器"
         Top             =   720
         Width           =   3195
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "连接口令："
         Height          =   180
         Index           =   2
         Left            =   144
         TabIndex        =   4
         Top             =   1200
         Width           =   900
      End
      Begin VB.Label Label1 
         Caption         =   "ODBC驱动程序："
         Height          =   255
         Index           =   1
         Left            =   120
         TabIndex        =   2
         Top             =   750
         Width           =   1305
      End
      Begin VB.Label Label1 
         Caption         =   "连接串："
         Height          =   255
         Index           =   0
         Left            =   135
         TabIndex        =   0
         Top             =   330
         Width           =   975
      End
   End
   Begin MSComctlLib.Toolbar Toolbar1 
      Align           =   1  'Align Top
      Height          =   540
      Left            =   0
      TabIndex        =   9
      Top             =   0
      Width           =   4860
      _ExtentX        =   8573
      _ExtentY        =   953
      ButtonWidth     =   609
      ButtonHeight    =   794
      Appearance      =   1
      _Version        =   393216
   End
End
Attribute VB_Name = "frmODBCLogon"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

' Reg Data Types...
Const REG_SZ = 1                         ' Unicode空终结字符串
Const REG_EXPAND_SZ = 2                  ' Unicode空终结字符串
Const REG_DWORD = 4                      ' 32-bit 数字
 
 Const DEFAULT_ODBC_DRIVER = "用于 Oracle 的微软 ODBC 驱动器"
 Const HKEY_LOCAL_MACHINE = &H80000002
 Const KEY_QUERY_VALUE = &H1
 Const ERROR_SUCCESS = 0&
 Const KEY_CREATE_LINK = &H20
 Const KEY_CREATE_SUB_KEY = &H4
 Const KEY_ENUMERATE_SUB_KEYS = &H8
 Const KEY_NOTIFY = &H10
 Const KEY_SET_VALUE = &H2
 Const STANDARD_RIGHTS_ALL = &H1F0000
 Const SYNCHRONIZE = &H100000
 Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or _
                                KEY_QUERY_VALUE Or _
                                KEY_SET_VALUE Or _
                                KEY_CREATE_SUB_KEY Or _
                                KEY_ENUMERATE_SUB_KEYS Or _
                                KEY_NOTIFY Or _
                                KEY_CREATE_LINK) And (Not SYNCHRONIZE))

Dim b_blnSuss As Boolean
Dim sUserName As String, sConnect As String, sDriver As String, sPassword As String

Private Declare Function RegCloseKey Lib "advapi32" (ByVal HKEY As Long) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias _
   "RegOpenKeyExA" _
      (ByVal HKEY As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _
       ByVal samDesired As Long, phkResult As Long) As Long

Private Declare Function RegEnumKey Lib "advapi32.dll" Alias _
   "RegEnumKeyA" _
      (ByVal HKEY As Long, ByVal dwIndex As Long, ByVal lpName As String, _
       ByVal cbName As Long) As Long
Private Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal HKEY As Long, ByVal dwIndex As Long, ByVal lpName As String, lpcbName As Long, ByVal lpReserved As Long, ByVal lpClass As String, lpcbClass As Long, lpftLastWriteTime As FILETIME) As Long
Private Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
End Type
Private Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal HKEY As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, lpData As Byte, lpcbData As Long) As Long
Private Declare Function RegQueryValue Lib "advapi32.dll" Alias "RegQueryValueA" (ByVal HKEY As Long, ByVal lpSubKey As String, ByVal lpValue As String, lpcbValue As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal HKEY As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long

'Private WithEvents mclsMainControl As MainControl               '主控对象
#If conWan = 0 Then
    Const AppTitle = "Gold Abacus Oracle Base"
#Else
    Const AppTitle = "Winner Oracle Base"
#End If

Public Function OpenBase(ByRef sUID As String, ByRef strConnectString As String, ByRef strDriver As String, Optional ByVal blnShowWindow As Boolean = False, Optional ByRef strPassWord As String) As Boolean
    Dim strLeft As String
    Dim strRight As String
    
    strConnectString = GetSetting(AppTitle, "Login", "ConnectString", "")
    strDriver = GetSetting(AppTitle, "Login", "OdbcDriver", "") ' "用于 Oracle 的微软 ODBC 驱动器")
    strPassWord = Security(GetSetting(AppTitle, "Login", "PassWord", ""))
'    If strPassWord = "" Then
'        strPassWord = "gold"
'    End If
'    strPassWord = Trim(strPassWord)
    If sUID = "" Then
        sUID = GetSetting(AppTitle, "Login", "UID", "")
    Else
        SaveSetting AppTitle, "Login", "UID", sUID
    End If
    
    If blnShowWindow = False Then
        If sUID <> "" And strConnectString <> "" And (strDriver = "Microsoft ODBC for Oracle" Or strDriver = DEFAULT_ODBC_DRIVER) Then
            If strDriver = "Oracle ODBC Driver" Then
            Else
                OpenBase = True
                Exit Function
            End If
        End If
    End If
    cboConnect.Text = strConnectString
    txtDriver.Text = strDriver
    txtPass.Text = strPassWord & Space(IIf(8 - StrLen(strPassWord) >= 0, 8 - StrLen(strPassWord), ""))
    
            Dim DriverList As Variant
            Dim DriverCount As Integer
            Dim blnDriverFind As Boolean
           
            DriverList = GetOdbcDriver
            txtDriver.Clear
         'old----------------------------------------------------------
'            For DriverCount = 1 To UBound(DriverList)
'                If DriverList(DriverCount) = "Oracle ODBC Driver" Then
'                Else
'                    txtDriver.AddItem DriverList(DriverCount)
'                End If