frm_odbc.frm

HRMS是一个人力资源管理系统,非常好用,功能非常强大,希望大家的支持

VERSION 5.00
Begin VB.Form frm_ODBC 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "配置ODBC"
   ClientHeight    =   2595
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5280
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2595
   ScaleWidth      =   5280
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton cmdEixt 
      Caption         =   "退出"
      Height          =   435
      Left            =   2730
      TabIndex        =   4
      Top             =   1950
      Width           =   1770
   End
   Begin VB.CommandButton cmdSTAR 
      Caption         =   "开始配置"
      Height          =   435
      Left            =   855
      TabIndex        =   3
      Top             =   1950
      Width           =   1770
   End
   Begin VB.TextBox txtDB_NAME 
      Height          =   300
      Left            =   1650
      Locked          =   -1  'True
      TabIndex        =   2
      Text            =   "RSDAGLXT"
      Top             =   945
      Width           =   3510
   End
   Begin VB.TextBox txtODBC 
      Height          =   300
      Left            =   1650
      Locked          =   -1  'True
      TabIndex        =   1
      Text            =   "RSDAGLXT"
      Top             =   1365
      Width           =   3510
   End
   Begin VB.TextBox txtUserName 
      Enabled         =   0   'False
      Height          =   300
      Left            =   1650
      Locked          =   -1  'True
      TabIndex        =   0
      Top             =   105
      Width           =   3510
   End
   Begin VB.Label Label5 
      AutoSize        =   -1  'True
      Caption         =   "SQL数据库名称："
      ForeColor       =   &H80000008&
      Height          =   180
      Left            =   75
      TabIndex        =   9
      Top             =   1005
      Width           =   1350
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      Caption         =   "ODBC数据源名称："
      ForeColor       =   &H80000008&
      Height          =   180
      Left            =   75
      TabIndex        =   8
      Top             =   1410
      Width           =   1440
   End
   Begin VB.Label Label4 
      Caption         =   "用户名："
      ForeColor       =   &H80000008&
      Height          =   225
      Left            =   75
      TabIndex        =   7
      Top             =   150
      Width           =   855
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "SQL驱动："
      ForeColor       =   &H80000008&
      Height          =   180
      Index           =   0
      Left            =   75
      TabIndex        =   6
      Top             =   600
      Width           =   810
   End
   Begin VB.Label Label1 
      BorderStyle     =   1  'Fixed Single
      Height          =   300
      Left            =   1650
      TabIndex        =   5
      Top             =   525
      Width           =   3510
   End
End
Attribute VB_Name = "frm_ODBC"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function GetVolumeInformation Lib "kernel32.dll" Alias _
    "GetVolumeInformationA" (ByVal lpRootPathName As String, _
    ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Integer, _
    lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, _
    lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, _
    ByVal nFileSystemNameSize As Long) As Long
    '创建注册表项
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias _
   "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, _
   phkResult As Long) As Long
   '设置注册表项中的值
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias _
   "RegSetValueExA" (ByVal hKey As Long, ByVal lpvaluename As String, _
   ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, _
   ByVal cbData 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 RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long

Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias _
   "RegQueryValueExA" (ByVal hKey As Long, ByVal lpvaluename As String, _
   ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Const REG_SZ = 1
Const REG_DWORD = 4
Const HKEY_CURRENT_USER = &H80000001
Dim fso, txtfile
Dim mySerial As Long
Dim mylong As Long
'提取计算机名和用户名
Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
  '提取系统目录
Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
  Dim hKey As Long
  Dim strLong As String * 256
  Dim S As String * 100
  Dim Length As Long
  Dim WinPath As String
  Dim SysPath As String
Private Sub cmdSTAR_Click()
    '向创建ODBC数据源
    Dim ret1 As Long, ret2 As Long, ret3 As Long
    ret1 = RegOpenKeyEx(HKEY_CURRENT_USER, "Software\ODBC\ODBC.INI", 0, 0, hKey)
    If ret1 <> 0 Then
      RegCreateKey HKEY_CURRENT_USER, "Software\ODBC\ODBC.INI\" & txtODBC.text, hKey
    End If
    RegSetValueEx hKey, "Database", 0, REG_SZ, ByVal txtDB_NAME.text, Len(txtDB_NAME.text)
    RegSetValueEx hKey, "Driver", 0, REG_SZ, ByVal Label1.Caption, Len(Label1.Caption)
    RegSetValueEx hKey, "LastUser", 0, REG_SZ, ByVal txtUserName.text, Len(txtUserName.text)
    RegSetValueEx hKey, "Server", 0, REG_SZ, ByVal "(local)", 7
    RegSetValueEx hKey, "Trusted_Connection", 0, REG_SZ, ByVal "Yes", 3
    '驱动Server ODBC数据源
    ret2 = RegOpenKeyEx(HKEY_CURRENT_USER, "Software\ODBC\ODBC.INI\ODBC Data Sources", 0, 0, hKey)
    If ret2 <> 0 Then
       RegCreateKey HKEY_CURRENT_USER, "Software\ODBC\ODBC.INI\ODBC Data Sources", hKey
    End If
    ret3 = RegSetValueEx(hKey, txtODBC.text, 0, REG_SZ, ByVal "SQL Server", 10)
    If ret3 = 0 Then
      MsgBox "ODBC数据源配置成功！", , "系统提示"
      Load frm_main
      frm_main.Show
      Unload Me
    End If
End Sub
Private Sub Form_Load()
  Dim cn As New ADODB.Connection
  cn.Open "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Initial Catalog=master"
  On Error GoTo dataErr
dataErr:
  If Trim(Err.Description) <> "数据库 'RSDAGLXT' 已存在。" Then
    cn.Execute ("sp_attach_db @dbname ='RSDAGLXT', @filename1 = N" & "'" & App.Path & "\RSDAGLXT_Data.MDF', @filename2 = N" & "'" & App.Path & "\RSDAGLXT_Log.LDF'")
  End If
  Dim ret As Long
  ret = RegOpenKey(HKEY_CURRENT_USER, "Software\ODBC\ODBC.INI\RSDAGLXT", hKey)
  If ret = 0 Then
    Load frm_main
    frm_main.Show
    Unload Me
  Else
  '提取SQL驱动
  Length = GetSystemDirectory(S, Len(S))
  SysPath = Left(S, Length)

  Label1.Caption = SysPath + "\sqlsrv32.dll"
     '提取计算机名称和用户名
     GetUserName strLong, 255
     txtUserName.text = "sa"
     strLong = Trim(strLong)
  End If
End Sub
Private Sub cmdEixt_Click()
  End
End Sub