frmodbclogon.frm

Data monkey是一个强大的是数据传输和转换应用程序。使用DataMonkey用户可以把复杂的文本文件格式

VERSION 5.00
Begin VB.Form frmODBCLogon 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "ODBC Logon"
   ClientHeight    =   2436
   ClientLeft      =   2856
   ClientTop       =   1752
   ClientWidth     =   4824
   ControlBox      =   0   'False
   Icon            =   "frmODBCLogon.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2436
   ScaleWidth      =   4824
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton cmdCancel 
      Cancel          =   -1  'True
      Caption         =   "Cancel"
      Height          =   375
      Left            =   2760
      TabIndex        =   7
      Top             =   1920
      Width           =   855
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "&OK"
      Default         =   -1  'True
      Height          =   375
      Left            =   3840
      TabIndex        =   6
      Top             =   1920
      Width           =   855
   End
   Begin VB.Frame fraStep3 
      Caption         =   "Connection Values"
      Height          =   1575
      Index           =   0
      Left            =   120
      TabIndex        =   8
      Top             =   120
      Width           =   4575
      Begin VB.TextBox txtUID 
         Height          =   300
         Left            =   1440
         TabIndex        =   3
         Top             =   705
         Width           =   3000
      End
      Begin VB.TextBox txtPWD 
         Height          =   300
         Left            =   1440
         TabIndex        =   5
         Top             =   1035
         Width           =   3000
      End
      Begin VB.ComboBox cboDSNList 
         Height          =   315
         ItemData        =   "frmODBCLogon.frx":000C
         Left            =   1440
         List            =   "frmODBCLogon.frx":000E
         Sorted          =   -1  'True
         Style           =   2  'Dropdown List
         TabIndex        =   1
         Top             =   360
         Width           =   3000
      End
      Begin VB.Label lblStep3 
         AutoSize        =   -1  'True
         Caption         =   "ODBC Database:"
         Height          =   195
         Index           =   1
         Left            =   135
         TabIndex        =   0
         Top             =   405
         Width           =   1230
      End
      Begin VB.Label lblStep3 
         AutoSize        =   -1  'True
         Caption         =   "UserID:"
         Height          =   195
         Index           =   2
         Left            =   135
         TabIndex        =   2
         Top             =   750
         Width           =   540
      End
      Begin VB.Label lblStep3 
         AutoSize        =   -1  'True
         Caption         =   "&Password:"
         Height          =   195
         Index           =   3
         Left            =   135
         TabIndex        =   4
         Top             =   1095
         Width           =   735
      End
   End
End
Attribute VB_Name = "frmODBCLogon"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' DataMonkey Data Conversion Application. Written by Theodore L. Ward
' Copyright (C) 2002 AstroComma Incorporated.
'
' This program is free software; you can redistribute it and/or
' modify it under the terms of the GNU General Public License
' as published by the Free Software Foundation; either version 2
' of the License, or (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
' GNU General Public License for more details.
'
' You should have received a copy of the GNU General Public License
' along with this program; if not, write to the Free Software
' Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
' The author may be contacted at:
' [e-mail] or [e-mail]

Option Explicit

Private mConnectString As String
Const SQL_SUCCESS As Long = 0
Const SQL_FETCH_NEXT As Long = 1

Private Sub cmdCancel_Click()
    GFormReturnValue = vbCancel
    Unload Me
End Sub

Private Sub cmdOK_Click()
    
    Dim dbConn As String
    
    If cboDSNList.ListIndex <= 0 Then
        ' Error.
        MsgBox "You must select a valid DSN for your database. " + _
            "You can view the System DSN's from ControlPanel->ODBC", _
            vbOKOnly, "Invalid Selection"
        Exit Sub
    End If

    ' Get the UserID and password.
    dbConn = "DSN=" & cboDSNList.Text & ";"
    dbConn = dbConn & "UID=" & txtUID.Text & ";"
    dbConn = dbConn & "PWD=" & txtPWD.Text & ";"
    
    ' Set the static connect string.
    mConnectString = dbConn
    
    ' Set the global return value.
    GFormReturnValue = vbOK
    
    Me.Hide
End Sub
Public Function GetConnectString() As String
    GetConnectString = mConnectString
End Function

Private Sub Form_Load()
    mConnectString = ""
    GFormReturnValue = vbCancel
    GetDSNsAndDrivers
End Sub

Sub GetDSNsAndDrivers()
    On Error Resume Next
    
    Dim i As Integer
    Dim sDSNItem As String * 1024
    Dim sDRVItem As String * 1024
    Dim sDSN As String
    Dim sDRV As String
    Dim iDSNLen As Integer
    Dim iDRVLen As Integer
    Dim lHenv As Long         'handle to the environment

    cboDSNList.AddItem "(None)"

    'get the DSNs
    If SQLAllocEnv(lHenv) <> -1 Then
        Do Until i <> SQL_SUCCESS
            sDSNItem = Space(1024)
            sDRVItem = Space(1024)
            i = SQLDataSources(lHenv, SQL_FETCH_NEXT, sDSNItem, 1024, iDSNLen, sDRVItem, 1024, iDRVLen)
            sDSN = VBA.left(sDSNItem, iDSNLen)
            sDRV = VBA.left(sDRVItem, iDRVLen)
                
            If sDSN <> Space(iDSNLen) Then
                cboDSNList.AddItem sDSN
            End If
        Loop
    End If

    cboDSNList.ListIndex = 0
    
End Sub