Option Explicit
'>>>>>>>>>>>>>>>>>>>>>>>>
'ResMe Converted To A Property: Const FORMCAPTION = "ODBC Logon"
'ResMe Converted To A Property: Const BUTTON1 = "&OK"
'ResMe Converted To A Property: Const BUTTON2 = "&Cancel"
'ResMe Converted To A Property: Const BUTTON3 = "&Register"
'ResMe Converted To A Property: Const FRAME1 = "Connect Values:"
'ResMe Converted To A Property: Const Label1 = "&DSN:"
'ResMe Converted To A Property: Const Label2 = "&UID:"
'ResMe Converted To A Property: Const LABEL3 = "&Password:"
'ResMe Converted To A Property: Const LABEL4 = "Data&base:"
'ResMe Converted To A Property: Const LABEL5 = "Dri&ver:"
'ResMe Converted To A Property: Const LABEL6 = "&Server:"
'ResMe Converted To A Property: Const MSG1 = "Enter ODBC Connection Parameters"
'ResMe Converted To A Property: Const MSG2 = "Opening ODBC Database"
'ResMe Converted To A Property: Const MSG3 = "Enter Driver Name:"
'ResMe Converted To A Property: Const MSG4 = "Driver Name"
'ResMe Converted To A Property: Const MSG5 = "This Datasource has not been Registered, this will now be attempted for you!"
'ResMe Converted To A Property: Const MSG7 = "Invalid Parameter(s), Please try again!"
'ResMe Converted To A Property: Const MSG8 = "Query Timeout Could not be set, default will be used!"
'ResMe Converted To A Property: Const MSG9 = "Datasource Registration Succeeded, proceed with Open."
'ResMe Converted To A Property: Const MSG10 = "Please enter a DSN!"
'ResMe Converted To A Property: Const MSG11 = "Please select a Driver!"
'ResMe Converted To A Property: Const MSG12 = "You must Close First!"
'>>>>>>>>>>>>>>>>>>>>>>>>

Dim mbBeenLoaded As Integer
Public DBOpened As Boolean

Private Declare Function SQLDataSources Lib "ODBC32.DLL" (ByVal henv&, ByVal fDirection%, ByVal szDSN$, ByVal cbDSNMax%, pcbDSN%, ByVal szDescription$, ByVal cbDescriptionMax%, pcbDescription%) As Integer
Private Declare Function SQLAllocEnv% Lib "ODBC32.DLL" (env&)
Const SQL_SUCCESS As Long = 0
Const SQL_FETCH_NEXT As Long = 1


Private Sub cboDSNList_Change()
  'WAS: If Len(cboDSNList.Text) = 0 Or cboDSNList.Text = "(None)" Then
  If Len(cboDSNList.Text) = 0 Or cboDSNList.Text = LoadResString(S6_None) Then

    txtServer.Enabled = True
    cboDrivers.Enabled = True
    lblLabels(4).Enabled = True
    lblLabels(5).Enabled = True
  Else
    txtServer.Enabled = False
    cboDrivers.Enabled = False
    lblLabels(4).Enabled = False
    lblLabels(5).Enabled = False
  End If
End Sub

Private Sub cmdCancel_Click()
  gbDBOpenFlag = False
  gsDBName = vbNullString
  DBOpened = False
  Me.Hide
End Sub

Private Sub cmdOK_Click()
  On Error GoTo cmdOK_ClickErr

  Dim sConnect As String
  Dim dbTemp As Database

  MsgBar MSG2, True

  If frmMDI.mnuPOpenOnStartup.Checked Then
    Me.Refresh
  End If
  
  Screen.MousePointer = vbHourglass
  
  If Len(cboDSNList.Text) > 0 Then
    sConnect = "ODBC;DSN=" & cboDSNList.Text & ";"
  Else
    sConnect = "ODBC;Driver={" & cboDrivers.Text & "};"
    sConnect = sConnect & "Server=" & txtServer.Text & ";"
  End If
  
  sConnect = sConnect & "UID=" & txtUID.Text & ";"
  sConnect = sConnect & "PWD=" & txtPWD.Text & ";"
  If Len(txtDatabase.Text) > 0 Then
    sConnect = sConnect & "Database=" & txtDatabase.Text & ";"
  End If
  
  Set dbTemp = gwsMainWS.OpenDatabase("", 0, 0, sConnect)
  
  If gbDBOpenFlag Then
    CloseCurrentDB
    If gbDBOpenFlag Then
      Beep
      MsgBox MSG12, 48
      Me.Hide
      Exit Sub
    End If
  End If

  'success
  DBOpened = True
  'save the values
  gsODBCDatasource = cboDSNList.Text
  gsDBName = gsODBCDatasource
  gsODBCDatabase = txtDatabase.Text
  gsODBCUserName = txtUID.Text
  gsODBCPassword = txtPWD.Text
  gsODBCDriver = cboDrivers.Text
  gsODBCServer = txtServer.Text
  gsDataType = gsSQLDB

  Set gdbCurrentDB = dbTemp
  GetODBCConnectParts gdbCurrentDB.Connect

  cboDSNList.Text = gsODBCDatasource
  txtDatabase.Text = gsODBCDatabase
  txtUID.Text = gsODBCUserName
  txtPWD.Text = gsODBCPassword

  'WAS: frmMDI.Caption = "VisData:" & gsDBName & "." & gsODBCDatabase
  frmMDI.Caption = LoadResString(S586_VisData) & gsDBName & LoadResString(S14_) & gsODBCDatabase

  gdbCurrentDB.QueryTimeout = glQueryTimeout

  gbDBOpenFlag = True
  AddMRU

  Screen.MousePointer = vbDefault
  Me.Hide
   
  Exit Sub

cmdOK_ClickErr:
  Screen.MousePointer = vbDefault
  gbDBOpenFlag = False
  If Len(cboDSNList.Text) > 0 Then
    If InStr(1, Error, "ODBC--connection to '" & cboDSNList.Text & "' failed") > 0 Then
      Beep
      MsgBox MSG5, 48
      txtDatabase.Text = vbNullString
      txtUID.Text = vbNullString
      txtPWD.Text = vbNullString
      If RegisterDB((cboDSNList.Text)) Then
        MsgBox MSG9, 48
      End If
    ElseIf InStr(1, Error, "Login failed") > 0 Then
      Beep
      MsgBox MSG7, 48
    ElseIf InStr(1, Error, "QueryTimeout property") > 0 Then
      If glQueryTimeout <> 5 Then
        Beep
        MsgBox MSG8, 48
      End If
      Resume Next
    Else
      ShowError
    End If
  End If
  
  MsgBar MSG1, False
  If Err = 3059 Then
    Unload Me
  End If

End Sub

Private Sub cmdRegister_Click()
  On Error GoTo cmdRegister_ClickErr
  
  If Len(cboDSNList.Text) = 0 Then
    MsgBox MSG10, vbInformation, Me.Caption
    Exit Sub
  End If
  If Len(cboDrivers.Text) = 0 Then
    MsgBox MSG11, vbInformation, Me.Caption
    Exit Sub
  End If
  
  'try to register it
  DBEngine.RegisterDatabase cboDSNList.Text, cboDrivers.Text, False, vbNullString

  MsgBox MSG9, vbInformation
  
  Exit Sub
cmdRegister_ClickErr:
  ShowError
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
  If KeyCode = vbKeyF1 And Shift = 0 Then
    DisplayTopic 2016138
  End If
End Sub

Private Sub Form_Load()
    'ResMe autogenerated line of code to call the initialization routine that was automatically generated.
    Call frmODBCLogon_Auto_Init
  Dim i As Integer

  Me.Caption = FORMCAPTION
  cmdOK.Caption = BUTTON1
  cmdCancel.Caption = BUTTON2
  cmdRegister.Caption = BUTTON3
  fraConnection.Caption = FRAME1
  lblLabels(0).Caption = Label1
  lblLabels(1).Caption = Label2
  lblLabels(2).Caption = LABEL3
  lblLabels(3).Caption = LABEL4
  lblLabels(4).Caption = LABEL5
  lblLabels(5).Caption = LABEL6
  GetDSNsAndDrivers

  MsgBar MSG1, False
  
  cboDSNList.Text = gsODBCDatasource
  txtDatabase.Text = gsODBCDatabase
  txtUID.Text = gsODBCUserName
  txtPWD.Text = gsODBCPassword
  If Len(gsODBCDriver) > 0 Then
    For i = 0 To cboDrivers.ListCount - 1
      If cboDrivers.List(i) = gsODBCDriver Then
        cboDrivers.ListIndex = i
        Exit For
      End If
    Next
  End If
  txtServer.Text = gsODBCServer

  mbBeenLoaded = True
End Sub

Private Sub cboDSNList_Click()
  cboDSNList_Change
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

  'WAS: cboDSNList.AddItem "(None)"
  cboDSNList.AddItem LoadResString(S6_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
        cboDrivers.AddItem sDRV
      End If
    Loop
  End If
  'remove the dupes
  If cboDSNList.ListCount > 0 Then
    With cboDrivers
      If .ListCount > 1 Then
        i = 0
        While i < .ListCount
          If .List(i) = .List(i + 1) Then
            .RemoveItem (i)
          Else
            i = i + 1
          End If
        Wend
      End If
    End With
  End If
  cboDSNList.ListIndex = 0
  
End Sub

Private Sub Form_Unload(Cancel As Integer)
  MsgBar vbNullString, False
End Sub

Private Function RegisterDB(rsDatasource As String) As Integer
   On Error GoTo RDBErr

   Dim sDriver As String

   sDriver = InputBox(MSG3, MSG4, gsDEFAULT_DRIVER)
   If sDriver <> gsDEFAULT_DRIVER Then
     DBEngine.RegisterDatabase rsDatasource, sDriver, False, vbNullString
   Else
     DBEngine.RegisterDatabase rsDatasource, sDriver, True, vbNullString
   End If

   RegisterDB = True
   Exit Function

RDBErr:
   RegisterDB = False
   
End Function


'*********************************************************************************
'**          This Section Of Code Was Automatically Generated By ResMe          **
'**                                                                             **
'** String assignments to Constants have been converted to read-only properties **
'*********************************************************************************


'This was: Const FORMCAPTION = "ODBC Logon"
Property Get FORMCAPTION As String
    'WAS: FORMCAPTION = "ODBC Logon"
    FORMCAPTION = LoadResString(S353_ODBC_Logon)

End Property

'This was: Const BUTTON1 = "&OK"
Property Get BUTTON1 As String
    BUTTON1 = "&OK"
End Property

'This was: Const BUTTON2 = "&Cancel"
Property Get BUTTON2 As String
    'WAS: BUTTON2 = "&Cancel"
    BUTTON2 = LoadResString(S84_Cancel)

End Property

'This was: Const BUTTON3 = "&Register"
Property Get BUTTON3 As String
    'WAS: BUTTON3 = "&Register"
    BUTTON3 = LoadResString(S445_Register)

End Property

'This was: Const FRAME1 = "Connect Values:"
Property Get FRAME1 As String
    'WAS: FRAME1 = "Connect Values:"
    FRAME1 = LoadResString(S107_Connect_Values)

End Property

'This was: Const Label1 = "&DSN:"
Property Get Label1 As String
    Label1 = "&DSN:"
End Property

'This was: Const Label2 = "&UID:"
Property Get Label2 As String
    Label2 = "&UID:"
End Property

'This was: Const LABEL3 = "&Password:"
Property Get LABEL3 As String
    'WAS: LABEL3 = "&Password:"
    LABEL3 = LoadResString(S407_Password)

End Property

'This was: Const LABEL4 = "Data&base:"
Property Get LABEL4 As String
    'WAS: LABEL4 = "Data&base:"
    LABEL4 = LoadResString(S145_Data_base)

End Property

'This was: Const LABEL5 = "Dri&ver:"
Property Get LABEL5 As String
    'WAS: LABEL5 = "Dri&ver:"
    LABEL5 = LoadResString(S178_Dri_ver)

End Property

'This was: Const LABEL6 = "&Server:"
Property Get LABEL6 As String
    'WAS: LABEL6 = "&Server:"
    LABEL6 = LoadResString(S494_Server)

End Property

'This was: Const MSG1 = "Enter ODBC Connection Parameters"
Property Get MSG1 As String
    'WAS: MSG1 = "Enter ODBC Connection Parameters"
    MSG1 = LoadResString(S199_Enter_ODBC_Connecti)

End Property

'This was: Const MSG2 = "Opening ODBC Database"
Property Get MSG2 As String
    'WAS: MSG2 = "Opening ODBC Database"
    MSG2 = LoadResString(S378_Opening_ODBC_Databa)

End Property

'This was: Const MSG3 = "Enter Driver Name:"
Property Get MSG3 As String
    'WAS: MSG3 = "Enter Driver Name:"
    MSG3 = LoadResString(S192_Enter_Driver_Name)

End Property

'This was: Const MSG4 = "Driver Name"
Property Get MSG4 As String
    'WAS: MSG4 = "Driver Name"
    MSG4 = LoadResString(S177_Driver_Name)

End Property

'This was: Const MSG5 = "This Datasource has not been Registered, this will now be attempted for you!"
Property Get MSG5 As String
    'WAS: MSG5 = "This Datasource has not been Registered, this will now be attempted for you!"
    MSG5 = LoadResString(S544_This_Datasource_has)

End Property

'This was: Const MSG7 = "Invalid Parameter(s), Please try again!"
Property Get MSG7 As String
    'WAS: MSG7 = "Invalid Parameter(s), Please try again!"
    MSG7 = LoadResString(S305_Invalid_Parameter_s)

End Property

'This was: Const MSG8 = "Query Timeout Could not be set, default will be used!"
Property Get MSG8 As String
    'WAS: MSG8 = "Query Timeout Could not be set, default will be used!"
    MSG8 = LoadResString(S428_Query_Timeout_Could)

End Property

'This was: Const MSG9 = "Datasource Registration Succeeded, proceed with Open."
Property Get MSG9 As String
    'WAS: MSG9 = "Datasource Registration Succeeded, proceed with Open."
    MSG9 = LoadResString(S148_Datasource_Registra)

End Property

'This was: Const MSG10 = "Please enter a DSN!"
Property Get MSG10 As String
    'WAS: MSG10 = "Please enter a DSN!"
    MSG10 = LoadResString(S414_Please_enter_a_DSN)

End Property

'This was: Const MSG11 = "Please select a Driver!"
Property Get MSG11 As String
    'WAS: MSG11 = "Please select a Driver!"
    MSG11 = LoadResString(S415_Please_select_a_Dri)

End Property

'This was: Const MSG12 = "You must Close First!"
Property Get MSG12 As String
    'WAS: MSG12 = "You must Close First!"
    MSG12 = LoadResString(S593_You_must_Close_Firs)

End Property


Private Sub frmODBCLogon_Auto_Init()
'This routine initializes all User Interface control properties on frmODBCLogon.
'This section of code was automatically generated by the ResMe String Extraction Utility.
    'WAS: Me.Caption = "ODBC Logon"
    Me.Caption = LoadResString(S353_ODBC_Logon)

    'WAS: cmdRegister.Caption = "&Register"
    cmdRegister.Caption = LoadResString(S445_Register)

    'WAS: cmdCancel.Caption = "Cancel"
    cmdCancel.Caption = LoadResString(S86_Cancel)

    'WAS: cmdOK.Caption = "&OK"
    cmdOK.Caption = LoadResString(S355_OK)

    'WAS: fraConnection.Caption = "Connection Values"
    fraConnection.Caption = LoadResString(S109_Connection_Values)

    cboDSNList.Text = "È"
    'WAS: lblLabels(0).Caption = "&DSN:"
    lblLabels(0).Caption = LoadResString(S179_DSN)

    'WAS: lblLabels(1).Caption = "&UID:"
    lblLabels(1).Caption = LoadResString(S555_UID)

    'WAS: lblLabels(2).Caption = "&Password:"
    lblLabels(2).Caption = LoadResString(S407_Password)

    'WAS: lblLabels(3).Caption = "Data&base:"
    lblLabels(3).Caption = LoadResString(S145_Data_base)

    'WAS: lblLabels(4).Caption = "Dri&ver:"
    lblLabels(4).Caption = LoadResString(S178_Dri_ver)

    'WAS: lblLabels(5).Caption = "&Server:"
    lblLabels(5).Caption = LoadResString(S494_Server)

End Sub