home *** CD-ROM | disk | FTP | other *** search
/ Master 95 #1 / MASTER95_1.iso / microsof / vbasic4 / vb4-6.cab / opendb.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1995-07-26  |  10.2 KB  |  311 lines
  1. VERSION 4.00
  2. Begin VB.Form frmOpenDB 
  3.    BorderStyle     =   3  'Fixed Double
  4.    Caption         =   "Open ODBC Datasource"
  5.    ClientHeight    =   2550
  6.    ClientLeft      =   2460
  7.    ClientTop       =   3855
  8.    ClientWidth     =   5070
  9.    ForeColor       =   &H00000000&
  10.    Height          =   2955
  11.    HelpContextID   =   2016138
  12.    Icon            =   "OPENDB.frx":0000
  13.    Left            =   2400
  14.    LinkTopic       =   "Form2"
  15.    LockControls    =   -1  'True
  16.    MaxButton       =   0   'False
  17.    MinButton       =   0   'False
  18.    ScaleHeight     =   2502.457
  19.    ScaleMode       =   0  'User
  20.    ScaleWidth      =   5130.082
  21.    Top             =   3510
  22.    Width           =   5190
  23.    Begin VB.ComboBox cboDatasource 
  24.       BackColor       =   &H00FFFFFF&
  25.       Height          =   300
  26.       Left            =   120
  27.       Sorted          =   -1  'True
  28.       TabIndex        =   0
  29.       Top             =   360
  30.       Width           =   2655
  31.    End
  32.    Begin VB.TextBox txtDatabase 
  33.       BackColor       =   &H00FFFFFF&
  34.       Height          =   285
  35.       Left            =   120
  36.       TabIndex        =   1
  37.       Top             =   960
  38.       Width           =   2655
  39.    End
  40.    Begin VB.TextBox txtUserName 
  41.       BackColor       =   &H00FFFFFF&
  42.       Height          =   285
  43.       Left            =   120
  44.       TabIndex        =   2
  45.       Top             =   1530
  46.       Width           =   2655
  47.    End
  48.    Begin VB.TextBox txtPassword 
  49.       BackColor       =   &H00FFFFFF&
  50.       Height          =   285
  51.       Left            =   120
  52.       PasswordChar    =   "*"
  53.       TabIndex        =   3
  54.       Top             =   2160
  55.       Width           =   2655
  56.    End
  57.    Begin VB.CommandButton cmdOK 
  58.       Caption         =   "&Open"
  59.       Default         =   -1  'True
  60.       Height          =   375
  61.       Left            =   3000
  62.       TabIndex        =   4
  63.       Top             =   360
  64.       Width           =   1935
  65.    End
  66.    Begin VB.CommandButton cmdCancel 
  67.       Cancel          =   -1  'True
  68.       Caption         =   "&Cancel"
  69.       Height          =   375
  70.       Left            =   3000
  71.       TabIndex        =   5
  72.       Top             =   840
  73.       Width           =   1935
  74.    End
  75.    Begin VB.Label lblLabels 
  76.       Height          =   1095
  77.       Index           =   0
  78.       Left            =   3000
  79.       TabIndex        =   10
  80.       Top             =   1320
  81.       Width           =   1935
  82.    End
  83.    Begin VB.Label lblLabels 
  84.       AutoSize        =   -1  'True
  85.       Caption         =   "Database: "
  86.       Height          =   195
  87.       Index           =   1
  88.       Left            =   120
  89.       TabIndex        =   9
  90.       Top             =   720
  91.       Width           =   780
  92.    End
  93.    Begin VB.Label lblLabels 
  94.       AutoSize        =   -1  'True
  95.       Caption         =   "Datasource: "
  96.       Height          =   195
  97.       Index           =   2
  98.       Left            =   120
  99.       TabIndex        =   6
  100.       Top             =   105
  101.       Width           =   915
  102.    End
  103.    Begin VB.Label lblLabels 
  104.       AutoSize        =   -1  'True
  105.       Caption         =   "User ID: "
  106.       Height          =   195
  107.       Index           =   3
  108.       Left            =   120
  109.       TabIndex        =   7
  110.       Top             =   1320
  111.       Width           =   630
  112.    End
  113.    Begin VB.Label lblLabels 
  114.       AutoSize        =   -1  'True
  115.       Caption         =   "Password: "
  116.       Height          =   195
  117.       Index           =   4
  118.       Left            =   120
  119.       TabIndex        =   8
  120.       Top             =   1890
  121.       Width           =   780
  122.    End
  123. Attribute VB_Name = "frmOpenDB"
  124. Attribute VB_Creatable = False
  125. Attribute VB_Exposed = False
  126. Option Explicit
  127. Dim mbBeenLoaded As Integer
  128. Private Sub cmdCancel_Click()
  129.   gbDBOpenFlag = False
  130.   gsDBName = gsNULL_STR
  131.   Unload Me
  132. End Sub
  133. Private Sub cboDatasource_Click()
  134.   On Error Resume Next
  135.   Dim sTmp As String
  136.   Dim x As Integer
  137.   txtDatabase.Text = gsNULL_STR
  138.   txtUserName.Text = gsNULL_STR
  139.   txtPassword.Text = gsNULL_STR
  140.   'get the datasource if there is one
  141.   sTmp = String(255, 32)
  142.   x = OSGetPrivateProfileString(cboDatasource.Text, "database", gsNULL_STR, sTmp, Len(sTmp), "ODBC.INI")
  143.   txtDatabase.Text = Mid(sTmp, 1, x)
  144.   'get the last user name is there is one
  145.   sTmp = String(255, 32)
  146.   x = OSGetPrivateProfileString(cboDatasource.Text, "lastuser", gsNULL_STR, sTmp, Len(sTmp), "ODBC.INI")
  147.   txtUserName.Text = Mid(sTmp, 1, x)
  148.   txtPassword.Text = gsNULL_STR
  149.   If Len(txtUserName.Text) > 0 Then
  150.     txtPassword.SetFocus
  151.   Else
  152.     txtDatabase.SetFocus
  153.   End If
  154. End Sub
  155. Private Sub Form_Load()
  156.   CenterMe Me, gnMDIFORM
  157.   GetDataSources cboDatasource
  158.   cboDatasource.Text = gsODBCDatasource
  159.   txtDatabase.Text = gsODBCDatabase
  160.   txtUserName.Text = gsODBCUserName
  161.   txtPassword.Text = gsODBCPassword
  162.   MsgBar "Enter ODBC Database Parameters", False
  163.   mbBeenLoaded = True
  164. End Sub
  165. Private Sub Form_Unload(Cancel As Integer)
  166.   MsgBar gsNULL_STR, False
  167. End Sub
  168. 'this routine fills a list box with all available
  169. 'ODBC data sources found in ODBC.INI
  170. Private Sub GetDataSources(rlstListObject As Object)
  171.   Dim sDataSource As String, sDescription As String
  172.   Dim nDataSourceLen As Integer, nDescriptionLen As Integer
  173.   Dim nRet As Integer
  174.   Dim lHenv As Long     'handle to the environment
  175.   If SQLAllocEnv(lHenv) <> -1 Then
  176.     sDataSource = String(32, 32)
  177.     sDescription = String(255, 32)
  178.     'get the first one
  179.     nRet = SQLDataSources(lHenv, 2, sDataSource, Len(sDataSource), nDataSourceLen, sDescription, Len(sDescription), nDescriptionLen)
  180.     While nRet = 0 Or nRet = 1
  181.       rlstListObject.AddItem Mid(sDataSource, 1, nDataSourceLen)
  182.       sDataSource = String(32, 32)
  183.       sDescription = String(255, 32)
  184.       'get all the others
  185.       nRet = SQLDataSources(lHenv, 1, sDataSource, Len(sDataSource), nDataSourceLen, sDescription, Len(sDescription), nDescriptionLen)
  186.     Wend
  187.   End If
  188. End Sub
  189. Private Sub lblLabels_DblClick(Index As Integer)
  190.   If Index > 0 Then Exit Sub
  191.   If Len(lblLabels(0).Caption) = 0 Then
  192.     lblLabels(0).Caption = "E"           'special case for RAID
  193.   Else
  194.     lblLabels(0).Caption = gsNULL_STR
  195.   End If
  196. End Sub
  197. Private Sub cmdOK_Click()
  198.    On Error GoTo OpenError
  199.    Dim sConnect As String, sDataSource As String
  200.    Dim x As Integer
  201.    Dim i As Integer
  202.    Dim sTmp1 As String, sTmp2 As String
  203.    MsgBar "Opening ODBC Database", True
  204.    If frmMDI.mnuPOpenOnStartup.Checked = True Then
  205.      Me.Refresh
  206.    End If
  207.    SetHourglass
  208.    'check for blank server name and clear other parms
  209.    If Len(cboDatasource.Text) = 0 Then
  210.      txtDatabase.Text = gsNULL_STR
  211.      txtUserName.Text = gsNULL_STR
  212.      txtPassword.Text = gsNULL_STR
  213.    End If
  214.    'build connect string
  215.    sConnect = "ODBC;"
  216.    If Len(txtUserName.Text) > 0 Then
  217.      sConnect = sConnect & "UID=" & txtUserName.Text & ";PWD=" & txtPassword.Text
  218.    End If
  219.    If Len(txtDatabase.Text) > 0 Then
  220.      sConnect = sConnect & ";DATABASE=" & txtDatabase.Text
  221.    End If
  222.    'add login timeout
  223.    sConnect = sConnect
  224.    '====================================================
  225.    'special case to make RAID databases updatable
  226.    If lblLabels(0) = "E" Then sConnect = sConnect & ";APP=Einstein"
  227.    '====================================================
  228.    sDataSource = cboDatasource.Text
  229.    'save the values
  230.    gsODBCDatasource = cboDatasource.Text
  231.    gsDBName = gsODBCDatasource
  232.    gsODBCDatabase = txtDatabase.Text
  233.    gsODBCUserName = txtUserName.Text
  234.    gsODBCPassword = txtPassword.Text
  235.    gsDataType = gsSQLDB
  236.    Me.Hide
  237.    Set gdbCurrentDB = gwsMainWS.OpenDatabase(sDataSource, False, False, sConnect)
  238.    If gbDBOpenFlag = True Then
  239.      UnloadAllForms
  240.    End If
  241.    gbTransPending = False
  242.    GetODBCConnectParts gdbCurrentDB.Connect
  243.    cboDatasource.Text = gsODBCDatasource
  244.    txtDatabase.Text = gsODBCDatabase
  245.    txtUserName.Text = gsODBCUserName
  246.    txtPassword.Text = gsODBCPassword
  247.    x = OSWritePrivateProfileString(gsDBName, "ODBCDatabase", gsODBCDatabase, "ODBC.INI")
  248.    x = OSWritePrivateProfileString(gsDBName, "LastUser", gsODBCUserName, "ODBC.INI")
  249.    frmMDI.Caption = "VisData:" & gsDBName & "." & gsODBCDatabase
  250.    gdbCurrentDB.QueryTimeout = glQueryTimeout
  251.    'success
  252.    gbDBOpenFlag = True
  253.    AddMRU
  254.    Screen.MousePointer = vbDefault
  255.    Unload Me
  256.    Exit Sub
  257. OpenError:
  258.    Screen.MousePointer = vbDefault
  259.    gbDBOpenFlag = False
  260.    If Len(cboDatasource.Text) > 0 Then
  261.      If InStr(1, Error, "ODBC--connection to '" & cboDatasource.Text & "' failed") > 0 Then
  262.        Beep
  263.        MsgBox "This Datasource has not been Registered, this will now be attempted for you!", 48
  264.        txtDatabase.Text = gsNULL_STR
  265.        txtUserName.Text = gsNULL_STR
  266.        txtPassword.Text = gsNULL_STR
  267.        If RegisterDB((cboDatasource.Text)) = True Then
  268.          MsgBox "'" & cboDatasource.Text & "' has been Registered, proceed with Open.", 48
  269.        End If
  270.      ElseIf InStr(1, Error, "Login failed") > 0 Then
  271.        Beep
  272.        MsgBox "Invalid Parameter(s), Please try again!", 48
  273.      ElseIf InStr(1, Error, "QueryTimeout property") > 0 Then
  274.        If glQueryTimeout <> 5 Then
  275.          Beep
  276.          MsgBox "Query Timeout Could not be set, default will be used!", 48
  277.        End If
  278.        Resume Next
  279.      Else
  280.        ShowError
  281.      End If
  282.    End If
  283.    MsgBar "Enter ODBC Database Parameters", False
  284.    Me.Show vbModal
  285.    Exit Sub
  286. End Sub
  287. Private Function RegisterDB(rsDatasource As String) As Integer
  288.    On Error GoTo RDBErr
  289.    Dim sDriver As String
  290.    sDriver = InputBox("Enter Driver Name from ODBCINST.INI File:", "Driver Name", gsDEFAULT_DRIVER)
  291.    If sDriver <> gsDEFAULT_DRIVER Then
  292.      DBEngine.RegisterDatabase rsDatasource, sDriver, False, gsNULL_STR
  293.    Else
  294.      DBEngine.RegisterDatabase rsDatasource, sDriver, True, gsNULL_STR
  295.    End If
  296.    RegisterDB = True
  297.    Exit Function
  298. RDBErr:
  299.    RegisterDB = False
  300.    Exit Function
  301. End Function
  302. Private Sub txtDatabase_GotFocus()
  303.   SendKeys "+{end}"
  304. End Sub
  305. Private Sub txtPassword_GotFocus()
  306.   SendKeys "+{end}"
  307. End Sub
  308. Private Sub txtUserName_GotFocus()
  309.   SendKeys "+{end}"
  310. End Sub
  311.