frmdataconnecti.frm

用于SQL数据的登陆连接

VERSION 5.00
Begin VB.Form FrmDataConnecti 
   BackColor       =   &H00FFC0C0&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "数据连接设置"
   ClientHeight    =   1725
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   4680
   Icon            =   "FrmDataConnecti.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   1725
   ScaleWidth      =   4680
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton CmdExit 
      BackColor       =   &H00FFC0C0&
      Caption         =   "退出"
      Height          =   435
      Left            =   2880
      TabIndex        =   7
      Top             =   1200
      Width           =   1155
   End
   Begin VB.CommandButton CmdTestConnect 
      BackColor       =   &H00FFC0C0&
      Caption         =   "测试连接"
      Height          =   435
      Left            =   1500
      TabIndex        =   6
      Top             =   1200
      Width           =   1155
   End
   Begin VB.CommandButton CmdUpLoad 
      Caption         =   "|"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   4140
      TabIndex        =   5
      Top             =   660
      Width           =   435
   End
   Begin VB.TextBox TxtUpLoad 
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   1500
      TabIndex        =   4
      Top             =   660
      Width           =   2535
   End
   Begin VB.TextBox TxtDownLoad 
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   1500
      TabIndex        =   3
      Top             =   180
      Width           =   2535
   End
   Begin VB.CommandButton CmdDownLoad 
      Caption         =   "|"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   4140
      TabIndex        =   0
      Top             =   180
      Width           =   435
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "上载数据库路径："
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   240
      Left            =   0
      TabIndex        =   2
      Top             =   720
      Width           =   1560
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "下载数据库路径："
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   240
      Left            =   0
      TabIndex        =   1
      Top             =   240
      Width           =   1560
   End
End
Attribute VB_Name = "FrmDataConnecti"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim cnDownLoad As ADODB.Connection
Dim cnUpLoad As ADODB.Connection
Dim MSDASCObj As MSDASC.DataLinks
Dim strDownString  As String
Dim strUpString  As String
Dim bOkFlag As Boolean

Private Sub CmdDownLoad_Click()
On Error GoTo SaveDownErr
Set MSDASCObj = New MSDASC.DataLinks
Set cnDownLoad = New ADODB.Connection
cnDownLoad.ConnectionString = TxtDownLoad.Text
bOkFlag = MSDASCObj.PromptEdit(cnDownLoad)
If bOkFlag Then
    TxtDownLoad.Text = cnDownLoad.ConnectionString
    strDownString = cnDownLoad.ConnectionString
    SaveString HKEY_LOCAL_MACHINE, "SOFTWARE\SANSNETWORK\Configure", "DownLoadAdoLink", strDownString
End If
Exit Sub
SaveDownErr:
  MsgBox Err.Description & Err.Source
End Sub

Private Sub CmdExit_Click()
Unload Me
End Sub

Private Sub CmdTestConnect_Click()
On Error GoTo TestErr
Set cnDownLoad = New ADODB.Connection
cnDownLoad.ConnectionString = strDownString
cnDownLoad.Open
If Err.Number = 0 Then
    MsgBox "测试连接成功！", vbInformation, "数据连接"
End If
cnDownLoad.Close

Set cnUpLoad = New ADODB.Connection
cnUpLoad.ConnectionString = strUpString
cnUpLoad.Open
If Err.Number = 0 Then
    MsgBox "测试连接成功！", vbInformation, "数据连接"
End If
cnUpLoad.Close
Exit Sub
TestErr:
  If Not cnDownLoad Is Nothing Then cnDownLoad.Close: Set cnDownLoad = Nothing
  If Not cnUpLoad Is Nothing Then cnUpLoad.Close: Set cnUpLoad = Nothing
  MsgBox "测试连接失败！", vbCritical, "数据连接"
End Sub

Private Sub CmdUpLoad_Click()
On Error GoTo SaveUpErr
Set MSDASCObj = New MSDASC.DataLinks
Set cnUpLoad = New ADODB.Connection
cnUpLoad.ConnectionString = TxtUpLoad.Text
bOkFlag = MSDASCObj.PromptEdit(cnUpLoad)
If bOkFlag Then
    TxtUpLoad.Text = cnUpLoad.ConnectionString
    strUpString = cnUpLoad.ConnectionString
    SaveString HKEY_LOCAL_MACHINE, "SOFTWARE\SANSNETWORK\Configure", "UpLoadAdoLink", strUpString
End If
Exit Sub
SaveUpErr:
  MsgBox Err.Description & Err.Source
End Sub

Private Sub Form_Load()
strDownString = GetString(HKEY_LOCAL_MACHINE, "SOFTWARE\SANSNETWORK\Configure", "DownLoadAdoLink")
strUpString = GetString(HKEY_LOCAL_MACHINE, "SOFTWARE\SANSNETWORK\Configure", "UpLoadAdoLink")
TxtDownLoad = strDownString
TxtUpLoad = strUpString
End Sub