Intellipro - Automating QTP Test Automation - Automate - Sql - Gen Conn V1.2

Automate - Generate Database Connection String V1.2

If you find an error, or have a suggestion for improvement, Email me and I'll fix it.

This code generates Script for connecting to a range of databases.

It currently supports SQL-Server, Oracle, MySQL, Access, PostgreSQL, DB2, Firebird and Progress.

You just save this code into a .qfl file, add it to your project and then 'Call GenConnV12' to run it.

It will ask you various questions and then generate a new .qfl file containing the connection code.

Download it Here (right-click and then save target as).

(NOTE - you can just cut & paste from below, but the formatting will have multiple spaces instead of tabs).

'=========================================================================

Option Explicit

'GenConnV12 - Generate Connection Strings for Databases

'Currently supports:
 'SQL-Server
 'Oracle
 'MySQL
 'Access
 'PostgreSQL
 'DB2
 'Firebird
 'Progress

'V1.0 - First Version
'V1.1 - Added IBM DB2, Firebird, Progress
'V1.2 - DMO support added for SQL-Svr and Bugfixes

Sub GenConnV12

 Dim sIni, sApp, aSelectableDrivers, sSelectedDriver, sCon, sFile

 sIni = "c:\Intellipro.ini"

 Call zQTP_MinimizeWindow

 Call SplashOpen(3)

 'Get a name for the AUT
 sApp = GetApp(sIni)

 'Assemble driver list
 aSelectableDrivers = AssembleDrivers

 'Get the user to choose which driver he wants...
 sSelectedDriver = zGen_GetIni(sIni, "App_" & sApp, "Drv", "")
 sSelectedDriver = GetCombo("Select the driver you want:", aSelectableDrivers, sSelectedDriver)

 'Can we handle it?
 Call ValidateChoice(sSelectedDriver,aSelectableDrivers)

 'Save the value
 Call zGen_SetIni(sIni, "App_" & sApp, "Drv", sSelectedDriver)

 'Let's do it...
 sCon = DoTheBiz(sSelectedDriver,sIni,sApp)

 'Generate an output script?
 If Msgbox("Generate a connection script?",vbQuestion+vbYesNo, "") = vbYes Then

 sFile = GenOutput(sCon,sIni,sApp)

 'Try to run it?
 'If Msgbox("Try to run it?",vbQuestion+vbYesNo, "") = vbYes Then

 'ExecuteFile sFile

 'Call App_SqlConnect

 'End If

 Else
 'Ok, just display it
 Call SplashResult(sCon)

 End If

End Sub

'========================================

Private Function GenOutput(sCon,sIni,sApp)

 Dim sFile, bProcessFile, oFso, oFile, sQ
 Const ForWriting = 2, TristateTrue = -1

 sQ = Chr(34)

 'Get Output Filename
 sFile = GetFile(sIni,sApp)

 'Detect and warn if the file exists already
 bProcessFile = False
 If zFile_Exists(sFile) Then
 If MsgBox(sFile,vbExclamation+vbYesNo,"Warning - File Exists - Overwrite?") = vbYes Then
 bProcessFile = True
 End If
 Else
 bProcessFile = True
 End If

 If bProcessFile Then

 'Open the file (in Unicode)
 Set oFso = CreateObject("Scripting.FileSystemObject")
 Set oFile = oFso.OpenTextFile(sFile, ForWriting, True, TristateTrue)

 'Write header
 oFile.WriteLine("Option Explicit")
 oFile.WriteLine("")
 oFile.WriteLine("'Database SQL Connection Function")
 oFile.WriteLine("")
 oFile.WriteLine("'For App : " & sApp)
 oFile.WriteLine("")
 oFile.WriteLine("'Automatically Generated by the Intellipro Connection Script Generator")
 oFile.WriteLine("")
 oFile.WriteLine("'" & String(40,"="))
 oFile.WriteLine("")
 oFile.WriteLine("Public Sub App_SqlConnect")
 oFile.WriteLine(vbTab & "'Print " & sQ & "<<< SqlConnect >>>" & sQ)
 oFile.WriteLine("")
 oFile.WriteLine(vbTab & "Dim oCon, sCon")
 oFile.WriteLine("")
 oFile.WriteLine(vbTab & "sCon = " & sQ & sCon & sQ)
 oFile.WriteLine("")
 oFile.WriteLine(vbTab & "Set oCon = CreateObject(" & sQ & "ADODB.Connection" & sQ & ")")
 oFile.WriteLine("")
 oFile.WriteLine(vbTab & "oCon.Open sCon")
 oFile.WriteLine("")
 oFile.WriteLine(vbTab & "Msgbox " & sQ & "Database Connected OK" & sQ & ",vbInformation")
 oFile.WriteLine("")
 oFile.WriteLine(vbTab & "oCon.Close")
 oFile.WriteLine("")
 oFile.WriteLine(vbTab & "Set oCon = Nothing")
 oFile.WriteLine("")
 oFile.WriteLine(vbTab & "'Print " & sQ & ">>> SqlConnect <<<" & sQ)
 oFile.WriteLine("End Sub")
 oFile.WriteLine("")
 oFile.WriteLine("'" & String(40,"#"))
 oFile.Close

 Set oFile = Nothing

 Set oFso = Nothing

 'Display the file with Notepad
 Call zFile_OpenWithNotepad(sFile)

 Call SplashClose

 Else

 'Ok, just display it
 Call SplashResult(sCon)

 End If

 GenOutput = sFile

End Function

'========================================

Private Function GetFile(sIni,sApp)

 Dim sFile

 sFile = "C:\Program Files\HP\QuickTest Professional\Tests\App_" & sApp & "_SQLConn.qfl"

 sFile = zGen_GetIni(sIni, "App_" & sApp, "File", sFile)

 sFile = Inputbox("Confirm generated output file name:", "User Input Required", sFile)

 If sFile = "" Then
 Call ExitTest()
 End If

 Call zGen_SetIni(sIni, "App_" & sApp, "File", sFile)

 GetFile = sFile

End Function

'========================================

Private Function AssembleDrivers

 Dim aBaseDrivers,aCurrDrivers, aXtraDrivers

 aBaseDrivers = GetBaseDrivers()

 aCurrDrivers = GetCurrDrivers()

 Call DumpOdbc(aCurrDrivers)

 aXtraDrivers = CompareDrivers(aBaseDrivers,aCurrDrivers)

 Call DisplayXtraDrivers(aXtraDrivers)

 AssembleDrivers = GenSelectableDrivers(aXtraDrivers)

End Function

'========================================

Private Sub DisplayXtraDrivers(aXtraDrivers)

 'Bugfix V1.2 - handle situation when there are no extra drivers detected

 Dim iXtraIndex, sLine

 If Ubound(aXtraDrivers) = 0 Then

 sLine = "### No Additional Drivers Detected ###"

 Else

 For iXtraIndex = 1 To Ubound(aXtraDrivers)

 sLine = sLine & aXtraDrivers(iXtraIndex) & vbcrlf

 Next

 End If

 Call zGen_PopupMsg(sLine, 5, vbInformation,"You have the following additional drivers loaded:")

End Sub

'========================================

Private Sub SplashOpen(iDelay)

 Dim sHtml

 sHtml = "<html><head></head><body>"
 sHtml = sHtml & "Welcome to: "
 sHtml = sHtml & "<h2>GenConn V1.2 by Intellipro</h2>"
 sHtml = sHtml & "For more useful things like this, go to: "
 sHtml = sHtml & "    Web: <a href=" & Chr(34) & "http://www.intellipro.co.uk" & Chr(34) & " target=" & Chr(34) & "_blank" & Chr(34) & ">http://www.intellipro.co.uk</a> "
 sHtml = sHtml & "If you have suggestions for improvements, contact me at: "
 sHtml = sHtml & "    Email: <a href=" & Chr(34) & "mailto:rossw@intellipro.co.uk" & Chr(34) & ">rossw.intellipro.co.uk</a> "
 sHtml = sHtml & "Copyright � 2009 Intellipro Services Ltd. All rights reserved"
 sHtml = sHtml & "</body></html>"

 Call Splash(sHtml, iDelay, 500, 350)

End Sub

'========================================

Private Sub SplashResult(sCon)

 Dim sHtml

 sHtml = "<html><head></head><body>"
 sHtml = sHtml & "Thank you for using: "
 sHtml = sHtml & "<h2>GenConn V1.2 by Intellipro</h2>"
 sHtml = sHtml & "Your Connection String is: "
 sHtml = sHtml & "    " & "sCon = " & Chr(34) & sCon & Chr(34) & " "
 sHtml = sHtml & "For more useful things like this, go to: "
 sHtml = sHtml & "    Web: <a href=" & Chr(34) & "http://www.intellipro.co.uk" & Chr(34) & " target=" & Chr(34) & "_blank" & Chr(34) & ">http://www.intellipro.co.uk</a> "
 sHtml = sHtml & "If you have suggestions for improvements, contact me at: "
 sHtml = sHtml & "    Email: <a href=" & Chr(34) & "mailto:rossw@intellipro.co.uk" & Chr(34) & ">rossw.intellipro.co.uk</a> "
 sHtml = sHtml & "Copyright � 2009 Intellipro Services Ltd. All rights reserved"
 sHtml = sHtml & "</body></html>"

 Call Splash(sHtml, 0, 850, 450)

End Sub

'========================================

Private Sub SplashClose

 Dim sHtml

 sHtml = "<html><head></head><body>"
 sHtml = sHtml & "Thank you for using: "
 sHtml = sHtml & "<h2>  GenConn V1.2 by Intellipro</h2>"
 sHtml = sHtml & "For more useful things like this, go to: "
 sHtml = sHtml & "    Web: <a href=" & Chr(34) & "http://www.intellipro.co.uk" & Chr(34) & " target=" & Chr(34) & "_blank" & Chr(34) & ">http://www.intellipro.co.uk</a> "
 sHtml = sHtml & "If you have suggestions for improvements, contact me at: "
 sHtml = sHtml & "    Email: <a href=" & Chr(34) & "mailto:rossw@intellipro.co.uk" & Chr(34) & ">rossw.intellipro.co.uk</a> "
 sHtml = sHtml & "Copyright � 2009 Intellipro Services Ltd. All rights reserved"
 sHtml = sHtml & "</body></html>"

 Call Splash(sHtml, 0, 500, 350)

End Sub

'========================================

Private Sub Splash(sHtml, iDelay, iWidth, iHeight)

 Dim oWMIService, cItems, oItem, iScrWidth, iScrHeight, oIE

 'Get screen size
 Set oWMIService = GetObject("Winmgmts:\\.\root\cimv2")
 Set cItems = oWMIService.ExecQuery("Select * From Win32_DesktopMonitor where DeviceID = 'DesktopMonitor1'",,0)
 For Each oItem in cItems
 iScrWidth = oItem.ScreenWidth
 iScrHeight = oItem.ScreenHeight
 Next

 'Show it

 Set oIE = CreateObject("InternetExplorer.Application")

 oIE.Navigate "about:blank"

 oIE.Document.body.innerHTML = sHtml

 oIE.Toolbar = False
 oIE.StatusBar = False
 oIE.MenuBar = False

 oIE.Height = iHeight
 oIE.Width = iWidth
 oIE.Top = (iScrHeight-iHeight)/2
 oIE.Left = (iScrWidth-iWidth)/2

 oIE.Visible = True

 If iDelay > 0 Then
 Wait iDelay
 oIE.Quit
 Set oIE = Nothing
 End If

End Sub

'========================================

Private Sub DumpOdbc(aCurrDrivers)

 Dim iDrvMax, iDrvIndex
 Const ForReading = 1, ForWriting = 2, ForAppending = 8
 Dim oFso, oFile

 Set oFso = CreateObject("Scripting.FileSystemObject")
 Set oFile = oFso.OpenTextFile("C:\DumpOdbcDrivers.txt", ForWriting, True)

 iDrvMax = UBound(aCurrDrivers)

 For iDrvIndex = 0 To iDrvMax

 oFile.WriteLine aCurrDrivers(iDrvIndex)

 Next

 oFile.Close

 Set oFile = Nothing

 Set oFso = Nothing

End Sub

'========================================

Private Function DoTheBiz(sSelectedDriver,sIni,sApp)

 Dim sCon

 If sSelectedDriver = "SQL Server" Then
 sCon = DoTheBiz_SqlSvr(sIni,sApp)

 ElseIf sSelectedDriver = "Microsoft ODBC for Oracle" Then
 sCon = DoTheBiz_OracleMs(sIni,sApp)

 ElseIf InStr(sSelectedDriver,"Oracle") > 0 Then
 sCon = DoTheBiz_OracleNative(sSelectedDriver,sIni,sApp)

 ElseIf sSelectedDriver = "Microsoft Access Driver (*.mdb)" Then
 sCon = DoTheBiz_Access(sIni,sApp)

 ElseIf sSelectedDriver = "PostgreSQL ANSI" Then
 sCon = DoTheBiz_PostgreSQL(sSelectedDriver,sIni,sApp)

 ElseIf sSelectedDriver = "PostgreSQL Unicode" Then
 sCon = DoTheBiz_PostgreSQL(sSelectedDriver,sIni,sApp)

 ElseIf InStr(sSelectedDriver,"PostgreSQL") > 0 Then
 sCon = DoTheBiz_PostgreSQL(sSelectedDriver,sIni,sApp)

 ElseIf sSelectedDriver = "MySQL ODBC 5.1 Driver" Then
 sCon = DoTheBiz_MySQL(sSelectedDriver,sIni,sApp)

 ElseIf InStr(sSelectedDriver,"MySQL") > 0 Then
 sCon = DoTheBiz_MySQL(sSelectedDriver,sIni,sApp)

 ElseIf sSelectedDriver = "IBM DB2 ODBC DRIVER" Then
 sCon = DoTheBiz_DB2(sSelectedDriver,sIni,sApp)

 ElseIf InStr(sSelectedDriver,"IBM DB2") > 0 Then
 sCon = DoTheBiz_DB2(sSelectedDriver,sIni,sApp)

 ElseIf sSelectedDriver = "Firebird/InterBase(r) driver" Then
 sCon = DoTheBiz_Firebird(sSelectedDriver,sIni,sApp)

 ElseIf InStr(sSelectedDriver,"Firebird") > 0 Then
 sCon = DoTheBiz_Firebird(sSelectedDriver,sIni,sApp)

 ElseIf sSelectedDriver = "Progress OpenEdge 10.2A Driver" Then
 sCon = DoTheBiz_Progress(sSelectedDriver,sIni,sApp)

 ElseIf InStr(sSelectedDriver,"Progress") > 0 Then
 sCon = DoTheBiz_Progress(sSelectedDriver,sIni,sApp)

 Else
 sCon = DoTheBiz_WildStabInTheDark(sSelectedDriver,sIni,sApp)

 End If

 'Msgbox sCon,vbInformation,"Connection String for App - " & sApp
 Call zGen_PopupMsg(sCon, 5, vbInformation,"Connection String for App - " & sApp)

 'Save the string?
 Call zGen_SetIni(sIni, "App_" & sApp, "Con", sCon)
 Call zGen_SetIni(sIni, "App_" & sApp, "Outcome", "OK")

 DoTheBiz = sCon

End Function

'========================================

Private Function DoTheBiz_Progress(sDrv,sIni,sApp)

 Dim sCon, oCon, iErr, sErr, sMsg, sSvr, sPort, sDbf, sUsr, sPwd, sPath, sFile, iPosn

 'Get Server
 sSvr = GetSvr(sIni,sApp,"locahost")

 'Get Port
 sPort = GetPort(sIni,sApp,"20931")

 'Get Database
 sDbf = GetDbf(sIni,sApp,"sports")

 'Get User
 sUsr = GetUsr(sIni,sApp,"user")

 'Get Password
 sPwd = GetPwd(sIni,sApp)

 Call zGen_PopupMsg("Trying Progress Database Connection...", 2, vbInformation,"")

 sCon = "Driver={" & sDrv & "};HOST=" & sSvr & ";DB=" & sDbf & ";UID=" & sUsr & ";PWD=" & sPwd & ";PORT=" & sPort & ";"

 Set oCon = CreateObject("adodb.connection")

 'Try to connect
 On Error Resume Next
 oCon.Open sCon
 iErr = Err.Number
 sErr = Err.Description
 On Error GoTo 0

 'Handle Errors
 If iErr <> 0 Then

 If iErr = -2147467259 Then
 sMsg = "Progress Server does not exist, access denied or service not running"

 ElseIf iErr = -2147217843 Then

 sMsg = "Progress Login Failed for User - Invalid User name or Password"

 Else
 sMsg = cStr(iErr) & " - " & sErr

 End If

 Call zGen_PopupMsg(sMsg, 5, 48, "")
 Call zGen_PopupMsg("Progress Database Connection Failed - Aborting", 1, vbCritical,"")
 Call ExitTest()

 End If

 oCon.Close

 Set oCon = Nothing

 Call zGen_PopupMsg("Progress Database Connected OK", 2, vbInformation,"")

 DoTheBiz_Progress = sCon

End Function

'========================================

Private Function DoTheBiz_Firebird(sDrv,sIni,sApp)

 Dim sCon, oCon, iErr, sErr, sMsg, sSvr, sPort, sDbf, sUsr, sPwd, sPath, sFile, iPosn

 'Get Database
 sPath = "C:\Program Files\Firebird\Firebird_2_1\examples\empbuild\"
 sFile = "employee.fdb"
 sDbf = zGen_GetIni(sIni, "App_" & sApp, "Dbf", "")
 If sDbf <> "" Then
 If zFile_Exists(sDbf) Then
 iPosn = InStrRev(sDbf,"\")
 If iPosn > 0 Then
 sPath = Left(sDbf,iPosn)
 sFile = Mid(sDbf,iPosn+1)
 End If
 End If
 End If

 'Get Database File
 sDbf = zFile_GetNameDialog("Select the Firebird Database", sPath, "Firebird Databases (*.fdb)|*.fdb|All files (*.*)|*.*", sFile)

 If sDbf = "" Then
 Call zGen_PopupMsg("No firebird database selected - aborting", 2, vbCritical,"")
 Call ExitTest()
 End If

 'Save the name
 Call zGen_SetIni(sIni, "App_" & sApp, "Dbf", sDbf)

 'Get User
 sUsr = GetUsr(sIni,sApp,"SYSDBA")

 'Get Password
 'For special passwords - save to ini to get picked up later
 Call zGen_SetIni(sIni, "App_" & sApp, "Pwd", "masterkey")
 sPwd = GetPwd(sIni,sApp)

 Call zGen_PopupMsg("Trying Firebird Database Connection...", 2, vbInformation,"")

 sCon = "Driver={" & sDrv & "};Uid=" & sUsr & ";Pwd=" & sPwd & ";DbName=" & sDbf & ";"

 Set oCon = CreateObject("adodb.connection")

 'Try to connect
 On Error Resume Next
 oCon.Open sCon
 iErr = Err.Number
 sErr = Err.Description
 On Error GoTo 0

 'Handle Errors
 If iErr <> 0 Then

 If iErr = -2147467259 Then
 sMsg = "Firebird Server does not exist, access denied or service not running"

 ElseIf iErr = -2147217843 Then

 sMsg = "Firebird Login Failed for User - Invalid User name or Password"

 Else
 sMsg = cStr(iErr) & " - " & sErr

 End If

 Call zGen_PopupMsg(sMsg, 5, 48, "")
 Call zGen_PopupMsg("Firebird Database Connection Failed - Aborting", 1, vbCritical,"")
 Call ExitTest()

 End If

 oCon.Close

 Set oCon = Nothing

 Call zGen_PopupMsg("Firebird Database Connected OK", 2, vbInformation,"")

 DoTheBiz_Firebird = sCon

End Function

'========================================

Private Function DoTheBiz_DB2(sSelectedDriver,sIni,sApp)

 Dim sCon, oCon, iErr, sErr, sMsg, sSvr, sPort, sDbf, sUsr, sPwd

 'Get Server
 sSvr = GetSvr(sIni,sApp,"DB2")

 'Get Port
 sPort = GetPort(sIni,sApp,"50000")

 'Get Database
 sDbf = GetDbf(sIni,sApp,"SAMPLE")

 'Get User
 sUsr = GetUsr(sIni,sApp,"db2admin")

 'Get Password
 sPwd = GetPwd(sIni,sApp)

 Call zGen_PopupMsg("Trying DB2 Database Connection...", 2, vbInformation,"")

 sCon = "Driver={" & sSelectedDriver & "};Server=" & sSvr & ";Port=" & sPort & ";Database=" & sDbf & ";Uid=" & sUsr & ";Pwd=" & sPwd & ";"

 Set oCon = CreateObject("adodb.connection")

 'Try to connect
 On Error Resume Next
 oCon.Open sCon
 iErr = Err.Number
 sErr = Err.Description
 On Error GoTo 0

 'Handle Errors
 If iErr <> 0 Then

 If iErr = -2147467259 Then
 sMsg = "DB2 Server does not exist, access denied or service not running"

 ElseIf iErr = -2147217843 Then

 sMsg = "DB2 Login Failed for User - Invalid User name or Password"

 Else
 sMsg = cStr(iErr) & " - " & sErr

 End If

 Call zGen_PopupMsg(sMsg, 5, 48, "")
 Call zGen_PopupMsg("DB2 Database Connection Failed - Aborting", 1, vbCritical,"")
 Call ExitTest()

 End If

 oCon.Close

 Set oCon = Nothing

 Call zGen_PopupMsg("DB2 Database Connected OK", 2, vbInformation,"")

 DoTheBiz_DB2 = sCon

End Function

'========================================

Private Function DoTheBiz_WildStabInTheDark(sSelectedDriver,sIni,sApp)

 Dim sCon, oCon, iErr, sErr, sMsg, sSvr, sPort, sDbf, sUsr, sPwd, iPosn, sTitle

 sTitle = "Trying a wild stab in the dark..."

 Call zGen_PopupMsg("ok, here we go...", 3, vbInformation,sTitle)

 'Get Server
 Call zGen_PopupMsg("Servers are often called 'localhost'", 3, vbInformation, sTitle)
 sSvr = GetSvr(sIni,sApp,"localhost")

 'Get Port
 Call zGen_PopupMsg("Who knows a good port number?, taking a wild guess here...", 3, vbInformation, sTitle)
 sPort = GetPort(sIni,sApp,"3306")

 'Get Database
 Call zGen_PopupMsg("Databases are often named after the product...", 3, vbInformation, sTitle)
 iPosn = InStr(sSelectedDriver," ")
 If iPosn>0 Then
 sDbf = Left(sSelectedDriver,iPosn-1)
 Else
 sDbf = sSelectedDriver
 End If
 sDbf = GetDbf(sIni,sApp,sDbf)

 'Get User
 Call zGen_PopupMsg("DBA's like to use something simple...", 3, vbInformation, sTitle)
 sUsr = GetUsr(sIni,sApp,"sa")

 'Get Password - password is always a good guess
 Call zGen_PopupMsg("This one is always worth a try...", 3, vbInformation, sTitle)
 sPwd = GetPwd(sIni,sApp)

 Call zGen_PopupMsg("Ok, the moment of truth...", 3, vbInformation, sTitle)

 sCon = "Driver={" & sSelectedDriver & "};Server=" & sSvr & ";Port=" & sPort & ";Database=" & sDbf & ";Uid=" & sUsr & ";Pwd=" & sPwd & ";"

 Set oCon = CreateObject("adodb.connection")

 'Try to connect
 On Error Resume Next
 oCon.Open sCon
 iErr = Err.Number
 sErr = Err.Description
 On Error GoTo 0

 'Handle Errors
 If iErr <> 0 Then

 If iErr = -2147467259 Then
 sMsg = "You're close, but no cigar - Server does not exist, access denied or service not running"
 Call zGen_PopupMsg(sMsg, 8, vbInformation, sTitle)

 ElseIf iErr = -2147217843 Then
 sMsg = "It's definitely worth trying again - Login Failed for User - Invalid User name or Password"
 Call zGen_PopupMsg(sMsg, 8, vbInformation, sTitle)

 Else
 sMsg = cStr(iErr) & " - " & sErr
 Call zGen_PopupMsg(sMsg, 5, vbCritical, sTitle)
 Call zGen_PopupMsg("Sorry, it didn't work out - Database Connection Failed - Aborting", 3, vbCritical,"Trying a wild stab in the dark...")
 Call zGen_PopupMsg("Email me, and I'll add it to my list", 3, vbInformation, sTitle)
 Call SplashClose
 End If

 Call ExitTest()

 End If

 oCon.Close

 Set oCon = Nothing

 Call zGen_PopupMsg("Wow! - Good Call - Database Connected OK", 5, vbExclamation, sTitle)

 DoTheBiz_WildStabInTheDark = sCon

End Function

'========================================

Private Function DoTheBiz_MySQL(sSelectedDriver,sIni,sApp)

 Dim sCon, oCon, iErr, sErr, sMsg, sSvr, sPort, sDbf, sUsr, sPwd

 'Get Server
 sSvr = GetSvr(sIni,sApp,"localhost")

 'Get Port
 sPort = GetPort(sIni,sApp,"3306")

 'Get Database
 sDbf = GetDbf(sIni,sApp,"mysql")

 'Get User
 sUsr = GetUsr(sIni,sApp,"root")

 'Get Password
 sPwd = GetPwd(sIni,sApp)

 Call zGen_PopupMsg("Trying MySQL Database Connection...", 2, vbInformation,"")

 sCon = "Driver={" & sSelectedDriver & "};Server=" & sSvr & ";Port=" & sPort & ";Database=" & sDbf & ";Uid=" & sUsr & ";Pwd=" & sPwd & ";"

 Set oCon = CreateObject("adodb.connection")

 'Try to connect
 On Error Resume Next
 oCon.Open sCon
 iErr = Err.Number
 sErr = Err.Description
 On Error GoTo 0

 'Handle Errors
 If iErr <> 0 Then

 If iErr = -2147467259 Then
 sMsg = "MySQL Server does not exist, access denied or service not running"

 ElseIf iErr = -2147217843 Then

 sMsg = "MySQL Login Failed for User - Invalid User name or Password"

 Else
 sMsg = cStr(iErr) & " - " & sErr

 End If

 Call zGen_PopupMsg(sMsg, 5, 48, "")
 Call zGen_PopupMsg("MySQL Database Connection Failed - Aborting", 1, vbCritical,"")
 Call ExitTest()

 End If

 oCon.Close

 Set oCon = Nothing

 Call zGen_PopupMsg("MySQL Database Connected OK", 2, vbInformation,"")

 DoTheBiz_MySQL = sCon

End Function

'========================================

Private Function DoTheBiz_PostgreSQL(sSelectedDriver,sIni,sApp)

 Dim sCon, oCon, iErr, sErr, sMsg, sSvr, sPort, sDbf, sUsr, sPwd

 'Get Server
 sSvr = GetSvr(sIni,sApp,"localhost")

 'Get Port
 sPort = GetPort(sIni,sApp,"5432")

 'Get Database
 sDbf = GetDbf(sIni,sApp,"postgres")

 'Get User
 sUsr = GetUsr(sIni,sApp,"postgres")

 'Get Password
 sPwd = GetPwd(sIni,sApp)

 Call zGen_PopupMsg("Trying PostgreSQL Database Connection...", 2, vbInformation,"")

 sCon = "Driver={" & sSelectedDriver & "};Server=" & sSvr & ";Port=" & sPort & ";Database=" & sDbf & ";Uid=" & sUsr & ";Pwd=" & sPwd & ";"

 Set oCon = CreateObject("adodb.connection")

 'Try to connect
 On Error Resume Next
 oCon.Open sCon
 iErr = Err.Number
 sErr = Err.Description
 On Error GoTo 0

 'Handle Errors
 If iErr <> 0 Then

 If iErr = -2147467259 Then
 sMsg = "PostgresSQL Server does not exist, access denied or service not running"

 ElseIf iErr = -2147217843 Then

 sMsg = "PostgreSQL Login Failed for User - Invalid User name or Password"

 Else
 sMsg = cStr(iErr) & " - " & sErr

 End If

 Call zGen_PopupMsg(sMsg, 5, 48, "")
 Call zGen_PopupMsg("PostgreSQL Database Connection Failed - Aborting", 1, vbCritical,"")
 Call ExitTest()

 End If

 oCon.Close

 Set oCon = Nothing

 Call zGen_PopupMsg("PostgreSQL Database Connected OK", 2, vbInformation,"")

 DoTheBiz_PostgreSQL = sCon

End Function

'========================================

Private Function DoTheBiz_Access(sIni,sApp)

 Dim sCon, oCon, iErr, sErr, sMsg, sDriver, sUsr, sPwd, sDbf, sPath, sFile, iPosn

 'Get Database
 sPath = "C:\"
 sFile = ""
 sDbf = zGen_GetIni(sIni, "App_" & sApp, "Dbf", "")
 If sDbf <> "" Then
 If zFile_Exists(sDbf) Then
 iPosn = InStrRev(sDbf,"\")
 If iPosn > 0 Then
 sPath = Left(sDbf,iPosn)
 sFile = Mid(sDbf,iPosn+1)
 End If
 End If
 End If

 'Get Database File
 sDbf = zFile_GetNameDialog("Select the Access Database", sPath, "Access Databases (*.mdb)|*.mdb|All files (*.*)|*.*", sFile)

 If sDbf = "" Then
 Call zGen_PopupMsg("No database selected - aborting", 2, vbCritical,"")
 Call ExitTest()
 End If

 'Save the name
 Call zGen_SetIni(sIni, "App_" & sApp, "Dbf", sDbf)

 'Assemble the connection string
 sCon = "Driver={Microsoft Access Driver (*.mdb)};Dbq=" & sDbf & ";Uid=Admin;Pwd=;"

 Call zGen_PopupMsg("Trying Access Database Connection...", 2, vbInformation,"")

 Set oCon = CreateObject("adodb.connection")

 'Try to connect
 On Error Resume Next
 oCon.Open sCon
 iErr = Err.Number
 sErr = Err.Description
 On Error GoTo 0

 'Handle Errors
 If iErr <> 0 Then

 sMsg = cStr(iErr) & " - " & sErr

 Call zGen_PopupMsg(sMsg, 5, 48, "")
 Call zGen_PopupMsg("Access Database Connection Failed - Aborting", 1, vbCritical,"")
 Call ExitTest()

 End If

 oCon.Close

 Set oCon = Nothing

 Call zGen_PopupMsg("Access Database Connected OK", 2, vbInformation,"")

 DoTheBiz_Access = sCon

End Function

'========================================

Private Function DoTheBiz_SqlSvr(sIni,sApp)

 Dim sSvr, sDbf, sUsr, sPwd, sCon, oCon, iErr, sErr, sMsg

 'Get Server...
 If zFile_Exists("C:\Program Files\Microsoft SQL Server\80\Tools\Binn\sqldmo.dll") Then
 If Msgbox("Do you want me to search for Servers?",vbQuestion+vbYesNo, "You appear to have DMO installed...") = vbYes Then
 sSvr = GetSvrSqlSvr(sIni,sApp,"localhost")
 Else
 sSvr = GetSvr(sIni,sApp,"localhost")
 End If
 Else
 sSvr = GetSvr(sIni,sApp,"localhost")
 End If
 'sSvr = GetSvr(sIni,sApp,"localhost")

 'Get Database
 If zFile_Exists("C:\Program Files\Microsoft SQL Server\80\Tools\Binn\sqldmo.dll") Then
 If Msgbox("Do you want me to search for Databases (you will need an sa password)?",vbQuestion+vbYesNo, "You appear to have DMO installed...") = vbYes Then
 sDbf = GetDbfSqlSvr(sIni,sApp,sSvr,"Northwind")
 Else
 sDbf = GetDbf(sIni,sApp,"Northwind")
 End If
 Else
 sDbf = GetDbf(sIni,sApp,"Northwind")
 End If
 'sDbf = GetDbf(sIni,sApp,"Northwind")

 'Get User
 sUsr = GetUsr(sIni,sApp,"sa")

 'Get Password
 sPwd = GetPwd(sIni,sApp)

 sCon = "Driver={SQL Server};Server=" & sSvr & ";Database=" & sDbf & ";Uid=" & sUsr & ";Pwd=" & sPwd & ";"

 Call zGen_PopupMsg("Trying SQL Server Database Connection...", 2, vbInformation,"")

 Set oCon = CreateObject("adodb.connection")

 'Try to connect
 On Error Resume Next
 oCon.Open sCon
 iErr = Err.Number
 sErr = Err.Description
 On Error GoTo 0

 'Handle Errors
 If iErr <> 0 Then

 If iErr = -2147467259 Then
 sMsg = "SQL Server does not exist or access denied"

 ElseIf iErr = -2147217843 Then
 sMsg = "SQL Server Login Failed for User - Invalid User name or Password"

 Else
 sMsg = cStr(iErr) & " - " & sErr

 End If

 Call zGen_PopupMsg(sMsg, 5, 48, "")
 Call zGen_PopupMsg("SQL Server Database Connection Failed - Aborting", 1, vbCritical,"")
 Call ExitTest()

 End If

 oCon.Close

 Set oCon = Nothing

 Call zGen_PopupMsg("SQL Server Database Connected OK...", 2, vbInformation, "")

 DoTheBiz_SqlSvr = sCon

End Function

'========================================

Private Function DoTheBiz_OracleMs(sIni,sApp)

 Dim sCon, oCon, iErr, sErr, sMsg, sDriver, sUsr, sPwd

 'Get User
 sUsr = GetUsr(sIni,sApp,"SYSTEM")

 'Get Password
 sPwd = GetPwd(sIni,sApp)

 Call zGen_PopupMsg("Trying Oracle Database Connection...", 2, vbInformation,"")

 sCon = "Driver={Microsoft ODBC for Oracle};Uid=" & sUsr & ";Pwd=" & sPwd & ";"

 Set oCon = CreateObject("adodb.connection")

 'Try to connect
 On Error Resume Next
 oCon.Open sCon
 iErr = Err.Number
 sErr = Err.Description
 On Error GoTo 0

 'Handle Errors
 If iErr <> 0 Then

 If iErr = -2147467259 Then
 sMsg = "Oracle Server does not exist, access denied or service not running"

 ElseIf iErr = -2147217843 Then

 sMsg = "Oracle Login Failed for User - Invalid User name or Password"

 Else
 sMsg = cStr(iErr) & " - " & sErr

 End If

 Call zGen_PopupMsg(sMsg, 5, 48, "")
 Call zGen_PopupMsg("Oracle Database Connection Failed - Aborting", 1, vbCritical, "")
 Call ExitTest()

 End If

 oCon.Close

 Set oCon = Nothing

 Call zGen_PopupMsg("Oracle Database Connected OK", 2, vbInformation,"")

 DoTheBiz_OracleMs = sCon

End Function

'========================================

Private Function DoTheBiz_OracleNative(sSelectedDriver,sIni,sApp)

 Dim sCon, oCon, iErr, sErr, sMsg, sDriver, sSvr, sDbf, sUsr, sPwd

 'Get Database
 sDbf = GetDbf(sIni,sApp,"HR")

 'Get User
 sUsr = GetUsr(sIni,sApp,"SYSTEM")

 'Get Password
 sPwd = GetPwd(sIni,sApp)

 Call zGen_PopupMsg("Trying Oracle Database Connection...", 2, vbInformation,"")

 sCon = "Driver={" & sSelectedDriver & "};Server=" & sDbf & ";Uid=" & sUsr & ";Pwd=" & sPwd & ";"

 Set oCon = CreateObject("adodb.connection")

 'Try to connect
 On Error Resume Next
 oCon.Open sCon
 iErr = Err.Number
 sErr = Err.Description
 On Error GoTo 0

 'Handle Errors
 If iErr <> 0 Then

 If iErr = -2147467259 Then
 sMsg = "Oracle Server does not exist, access denied or service not running"

 ElseIf iErr = -2147217843 Then

 sMsg = "Oracle Login Failed for User - Invalid User name or Password"

 Else
 sMsg = cStr(iErr) & " - " & sErr

 End If

 Call zGen_PopupMsg(sMsg, 5, 48, "")
 Call zGen_PopupMsg("Oracle Database Connection Failed - Aborting", 1, vbCritical, "")
 Call ExitTest()

 End If

 oCon.Close

 Set oCon = Nothing

 Call zGen_PopupMsg("Oracle Database Connected OK", 2, vbInformation,"")

 DoTheBiz_OracleNative = sCon

End Function

'========================================

Private Sub ValidateChoice(sSelectedDriver,aSelectableDrivers)

 'Do they have the driver (or have they typed something in?)
 If ArrayScanForNewEntry(aSelectableDrivers,sSelectedDriver) Then
 Call zGen_PopupMsg("You don't have that driver loaded...", 5, vbExclamation,"")
 End If

 'Which drivers do we support?

 If sSelectedDriver = "SQL Server" Then
 Call zGen_PopupMsg("Ok, I can handle that one...", 2, vbInformation,"")

 ElseIf sSelectedDriver = "Microsoft ODBC for Oracle" Then
 Call zGen_PopupMsg("Ok, I can handle that but have you installed the client?", 5, vbInformation,"")

 ElseIf Left(sSelectedDriver,10) = "Oracle in " Then
 Call zGen_PopupMsg("Ok, I can take a stab at that one...", 5, vbInformation,"")

 ElseIf sSelectedDriver = "Microsoft Access Driver (*.mdb)" Then
 Call zGen_PopupMsg("Ok, I can handle that one...", 2, vbInformation,"")

 ElseIf sSelectedDriver = "PostgreSQL ANSI" Then
 Call zGen_PopupMsg("Ok, I can handle that one...", 2, vbInformation,"")

 ElseIf sSelectedDriver = "MySQL ODBC 5.1 Driver" Then
 Call zGen_PopupMsg("Ok, I can handle that one...", 2, vbInformation,"")

 ElseIf sSelectedDriver = "IBM DB2 ODBC DRIVER" Then
 Call zGen_PopupMsg("Ok, I can handle that one...", 2, vbInformation,"")

 ElseIf sSelectedDriver = "Firebird/InterBase(r) driver" Then
 Call zGen_PopupMsg("Ok, I can handle that one...", 2, vbInformation,"")

 ElseIf sSelectedDriver = "PostgreSQL Unicode" Then
 Call zGen_PopupMsg("Ok, I can take a stab at that one...", 5, vbInformation,"")

 ElseIf InStr(sSelectedDriver,"Oracle") > 0 Then
 Call zGen_PopupMsg("Ok, I can take a stab at that one...", 5, vbInformation,"")

 ElseIf InStr(sSelectedDriver,"PostgreSQL") > 0 Then
 Call zGen_PopupMsg("Ok, I can take a stab at that one...", 5, vbInformation,"")

 ElseIf InStr(sSelectedDriver,"MySQL") > 0 Then
 Call zGen_PopupMsg("Ok, I can take a stab at that one...", 5, vbInformation,"")

 ElseIf InStr(sSelectedDriver,"IBM DB2") > 0 Then
 Call zGen_PopupMsg("Ok, I can take a stab at that one...", 5, vbInformation,"")

 ElseIf InStr(sSelectedDriver,"Firebird") > 0 Then
 Call zGen_PopupMsg("Ok, I can take a stab at that one...", 5, vbInformation,"")

 ElseIf sSelectedDriver = "Progress OpenEdge 10.2A Driver" Then
 Call zGen_PopupMsg("Ok, I can take a stab at that one...", 5, vbInformation,"")

 ElseIf InStr(sSelectedDriver,"Progress") > 0 Then
 Call zGen_PopupMsg("Ok, I can take a stab at that one...", 5, vbInformation,"")

 Else

 If Msgbox("I can take a wild stab at that one - do you want me to try?",vbQuestion+vbYesNo, "") <> vbYes Then

 'Not yet supported
 Call zGen_PopupMsg("Ok, Email me, and I'll add it to my list", 5, vbInformation,"")
 Call SplashClose
 Call ExitTest()

 'Sybase Advantage Server
 'Sybase Adaptive Server
 'Informix
 'Paradox
 'AS/400
 'Interbase
 'Ingres
 'Mimer SQL
 'Lightbase
 'Pervasive
 'SQLBase
 'Cache
 'Teradata
 'VistaDB
 'DBMaker
 'Netezza DBMS
 'Valentina
 'Visual FoxPro
 'SQLite
 'Filemaker

 End If

 End If

End Sub

'========================================

Private Function GetApp(sIniFile)

 GetApp = GetIniCombo(sIniFile, "Enter App Name (3 - 4 characters are best)", "Apps", "App")

End Function

'========================================

Private Function GetSvrSqlSvr(sIni,sApp,sDefaultServer)

 Dim sSvr, oDMO, oSrvList, iSvrCount, iSvrList, aSvrs

 'Try using DMO to get a list of servers

 Set oDMO = CreateObject("SQLDMO.Application")

 Set oSrvList = oDMO.ListAvailableSQLServers()

 iSvrCount = oSrvList.Count

 If iSvrCount > 0 Then

 Call zGen_PopupMsg("Ok, I found " & cStr(iSvrCount) & " Servers", 2, vbInformation,"")
 ReDim aSvrs(iSvrCount)
 For iSvrList = 0 To iSvrCount-1
 aSvrs(iSvrList) = oSrvList.Item(iSvrList)
 Next

 aSvrs(iSvrCount) = sDefaultServer

 sSvr = GetCombo("Select Server:", aSvrs, sDefaultServer)

 Else

 Call zGen_PopupMsg("Sorry, I didn't find any more servers...", 2, vbInformation,"")

 sSvr = zGen_GetIni(sIni, "App_" & sApp, "Svr", sDefaultServer)

 sSvr = Inputbox ("Enter the name of your Server:", "User Input Required", sSvr)

 If sSvr = "" Then
 Call ExitTest()
 End If

 End If

 Call zGen_SetIni(sIni, "App_" & sApp, "Svr", sSvr)

 GetSvrSqlSvr = sSvr

End Function

'========================================

Private Function GetSvr(sIni,sApp,sDefaultServer)

 Dim sSvr

 sSvr = zGen_GetIni(sIni, "App_" & sApp, "Svr", sDefaultServer)

 sSvr = Inputbox ("Enter the name of your Server:", "User Input Required", sSvr)

 If sSvr = "" Then
 Call ExitTest()
 End If

 Call zGen_SetIni(sIni, "App_" & sApp, "Svr", sSvr)

 GetSvr = sSvr

End Function

'========================================

Private Function GetPort(sIni,sApp,sDefaultPort)

 Dim sPort

 sPort = zGen_GetIni(sIni, "App_" & sApp, "Port", sDefaultPort)

 sPort = Inputbox ("Enter the port of your Database:", "User Input Required", sPort)

 If sPort = "" Then
 Call ExitTest()
 End If

 Call zGen_SetIni(sIni, "App_" & sApp, "Port", sPort)

 GetPort = sPort

End Function

'========================================

Private Function GetDbfSqlSvr(sIni,sApp,sSvr,sDefaultDbf)

 Dim sUsr, sPwd, oDMO, oDbfList, iDbfList, iDbfCount, aDbfs, sDbf, database, iErr, sErr, sMsg

 'Get sa User
 sUsr = GetUsr(sIni,sApp,"sa")
 'Get sa Password
 sPwd = GetPwd(sIni,sApp)

 'Use DMO to get a list of databases...
 Set oDMO = CreateObject("SQLDMO.SQLServer")
 'oDMO.LoginSecure = True
 oDMO.LoginSecure = False
 oDMO.Login = sUsr
 oDMO.Password = sPwd

 On Error Resume Next
 oDMO.Connect sSvr
 iErr = Err.Number
 sErr = Err.Description
 On Error GoTo 0

 'Handle Errors
 If iErr <> 0 Then
 Call zGen_PopupMsg("Sorry, I couldn't get logged on", 2, vbInformation,"")

 Else
 Set oDbfList = oDMO.Databases
 iDbfCount = oDbfList.Count
 If iDbfCount > 0 Then
 Call zGen_PopupMsg("Ok, I found " & cStr(iDbfCount) & " Databases", 2, vbInformation,"")
 ReDim aDbfs(iDbfCount-1)
 For Each database In oDbfList
 aDbfs(iDbfList) = database.name
 iDbfList = iDbfList + 1
 Next
 sDbf = GetCombo("Select Your Database:", aDbfs, sDefaultDbf)
 Call zGen_SetIni(sIni, "App_" & sApp, "Dbf", sDbf)
 GetDbfSqlSvr = sDbf
 Exit Function
 Else
 Call zGen_PopupMsg("Sorry, I didn't find any databases...", 2, vbInformation,"")
 End If
 End If

 sDbf = zGen_GetIni(sIni, "App_" & sApp, "Dbf", sDefaultDbf)

 sDbf = Inputbox ("Enter the name of your Database:", "User Input Required", sDbf)

 If sDbf = "" Then
 Call ExitTest()
 End If

 Call zGen_SetIni(sIni, "App_" & sApp, "Dbf", sDbf)

 GetDbfSqlSvr = sDbf

End Function

'========================================

Private Function GetDbf(sIni,sApp,sDefaultDbf)

 Dim sDbf

 sDbf = zGen_GetIni(sIni, "App_" & sApp, "Dbf", sDefaultDbf)

 sDbf = Inputbox ("Enter the name of your Database:", "User Input Required", sDbf)

 If sDbf = "" Then
 Call ExitTest()
 End If

 Call zGen_SetIni(sIni, "App_" & sApp, "Dbf", sDbf)

 GetDbf = sDbf

End Function

'========================================

Private Function GetUsr(sIni,sApp,sDefaultUser)

 Dim sUsr

 sUsr = zGen_GetIni(sIni, "App_" & sApp, "Usr", sDefaultUser)

 sUsr = Inputbox ("Enter a Username for that database:", "User Input Required", sUsr)

 If sUsr = "" Then
 Call ExitTest()
 End If

 Call zGen_SetIni(sIni, "App_" & sApp, "Usr", sUsr)

 GetUsr = sUsr

End Function

'========================================

Private Function GetPwd(sIni,sApp)

 Dim aPwds, sPwd, bNewLocalPwd, aLocalPwds, iLocalPwdCount

 aPwds = GetTotalPasswords(sIni, sApp)

 sPwd = GetCombo("Enter a Password for that user:", aPwds, "")

 If sPwd = "" Then
 Call ExitTest()
 End If

 'If the password is completely new, add it to the local password list (even if its in the common list)
 aLocalPwds = GetLocalPwdList(sIni)
 bNewLocalPwd = ArrayScanForNewEntry(aLocalPwds,sPwd)
 If bNewLocalPwd Then
 iLocalPwdCount = cInt(zGen_GetIni(sIni, "LocalPasswords", "PwdCount" , "0"))
 iLocalPwdCount = iLocalPwdCount + 1
 Call zGen_SetIni(sIni, "LocalPasswords", "PwdCount", cStr(iLocalPwdCount))
 Call zGen_SetIni(sIni, "LocalPasswords", "Pwd" & Right("00" & cStr(iLocalPwdCount),2),sPwd)
 End If

 'Set the global default password
 Call zGen_SetIni(sIni, "LocalPasswords", "Pwd", sPwd)

 'Save the password for this application
 Call zGen_SetIni(sIni, "App_" & sApp, "Pwd", sPwd)

 GetPwd = sPwd

End Function

'========================================

Private Function GenSelectableDrivers(aXtraDrivers)

 'Bugfix V1.2 - handle if no extra drivers

 Dim aSelectableDrivers, iMax, iLoop

 If UBound(aXtraDrivers) = 0 Then

 ReDim aSelectableDrivers(2)
 aSelectableDrivers(0) = "SQL Server"
 aSelectableDrivers(1) = "Microsoft Access Driver (*.mdb)"
 aSelectableDrivers(2) = "Microsoft ODBC for Oracle"

 Else

 iMax = UBound(aXtraDrivers)
 ReDim aSelectableDrivers(iMax+2)

 For iLoop = 0 to iMax-1
 aSelectableDrivers(iLoop) = aXtraDrivers(iLoop+1)
 Next

 aSelectableDrivers(iMax) = "SQL Server"
 aSelectableDrivers(iMax+1) = "Microsoft Access Driver (*.mdb)"
 aSelectableDrivers(iMax+2) = "Microsoft ODBC for Oracle"

 End If

 GenSelectableDrivers = aSelectableDrivers

End Function

'========================================

Private Function CompareDrivers(aBaseDrivers,aCurrDrivers)

 'Bugfix - V1.2 - zeroth entry now reserved for empty array indicator

 'Returns an array of added drivers - drivers in aCurrDrivers NOT in aBaseDrivers

 Dim iBaseMax, iCurrMax, iBaseIndex, iCurrIndex, bMatchFound, aXtraDrivers, iCount

 Call zGen_PopupMsg("Comparing Lists...", 2, vbInformation,"")

 iCount = 0
 iBaseMax = UBound(aBaseDrivers)
 iCurrMax = UBound(aCurrDrivers)
 ReDim aXtraDrivers(0)

 'Read through current array
 For iCurrIndex = 0 to iCurrMax

 bMatchFound = False

 'Read through base array
 For iBaseIndex = 0 to iBaseMax

 If aCurrDrivers(iCurrIndex) = aBaseDrivers(iBaseIndex) Then
 bMatchFound = True
 Exit For
 End If

 Next

 If Not bMatchFound Then

 iCount = iCount + 1
 ReDim Preserve aXtraDrivers(iCount)
 aXtraDrivers(iCount) = aCurrDrivers(iCurrIndex)
 'iCount = iCount + 1 'Bugfix V1.2 - moved to before redim

 End If

 Next

 CompareDrivers = aXtraDrivers

End Function

'========================================

Private Function GetTotalPasswords(sIni, sApp)

 Dim aLocalPwds, aCommonPwds, aTotalPwds, bMatchFound, iTotalMax
 Dim iLocalMax, iCommonMax, iLocalIndex, iCommonIndex, sLocalPwd, sCommonPwd

 aLocalPwds = GetLocalPasswords(sIni, sApp)
 aCommonPwds = GetCommonPasswords

 iLocalMax = Ubound(aLocalPwds)
 iCommonMax = Ubound(aCommonPwds)

 'Merge
 iTotalMax = iLocalMax
 aTotalPwds = aLocalPwds

 For iCommonIndex = 0 To iCommonMax

 sCommonPwd = aCommonPwds(iCommonIndex)
 bMatchFound = False

 For iLocalIndex = 0 to iLocalMax

 sLocalPwd = aLocalPwds(iLocalIndex)

 If sCommonPwd = sLocalPwd Then
 bMatchFound = True
 Exit For
 End If

 Next

 If Not bMatchFound Then
 iTotalMax = iTotalMax + 1
 ReDim Preserve aTotalPwds(iTotalMax)
 aTotalPwds(iTotalMax) = sCommonPwd
 End If

 Next

 GetTotalPasswords = aTotalPwds

End Function

'========================================

Private Function GetLocalPwdList(sIni)

 Dim aPwds, iPwdCount, iPwdIndex, sKey, sPwd

 Redim aPwds(0)

 'Get the count
 iPwdCount = cInt(zGen_GetIni(sIni, "LocalPasswords", "PwdCount" , "0"))

 If iPwdCount > 0 Then

 'Populate the array
 For iPwdIndex = 1 to iPwdCount

 sKey = "Pwd" & Right("00" & cStr(iPwdIndex),2)

 sPwd = zGen_GetIni(sIni, "LocalPasswords", sKey , "password")

 Redim Preserve aPwds(iPwdIndex-1)
 aPwds(iPwdIndex-1) = sPwd

 Next

 End If

 GetLocalPwdList = aPwds

End Function

'========================================

Private Function GetLocalPasswords(sIni, sApp)

 Dim sPwd, aPwds, iPwdCount, iPwdIndex, sKey

 'Call zGen_PopupMsg("Loading Local Passwords...", 2, vbInformation,"")

 'Get the last app specific password if any
 sPwd = zGen_GetIni(sIni, "App_" & sApp, "Pwd", "")

 If sPwd <> "" Then

 ReDim aPwds(0)
 'Put the app specific password at the top of the array
 aPwds(0) = sPwd

 'Get the last generally used password if any
 sPwd = zGen_GetIni(sIni, "LocalPasswords", "Pwd", "password")

 'Append it to the array
 aPwds = ArrayAppendUnique(aPwds,sPwd)

 Else
 'Get the last generally used password if any
 sPwd = zGen_GetIni(sIni, "LocalPasswords", "Pwd", "password")
 'Put it at the top of the array
 ReDim aPwds(0)
 aPwds(0) = sPwd

 End If

 'Get the count
 iPwdCount = cInt(zGen_GetIni(sIni, "LocalPasswords", "PwdCount" , "0"))

 If iPwdCount > 0 Then

 'Populate the array
 For iPwdIndex = 1 to iPwdCount
 sKey = "Pwd" & Right("00" & cStr(iPwdIndex),2)
 sPwd = zGen_GetIni(sIni, "LocalPasswords", sKey , "password")
 aPwds = ArrayAppendUnique(aPwds,sPwd)

 Next

 End If

 GetLocalPasswords = aPwds

End Function

'========================================

Private Function ArrayScanForNewEntry(aList,sValue)

 'This function checks if an entry exists in an array

 Dim iListIndex, iListMax, bMatch

 iListMax = Ubound(aList)
 bMatch = False

 For iListIndex = 0 to iListMax

 If aList(iListIndex) = sValue Then
 bMatch = True
 Exit For
 End If

 Next

 If bMatch Then
 ArrayScanForNewEntry = False

 Else
 ArrayScanForNewEntry = True

 End If

End Function

'========================================

Private Function ArrayAppendUnique(aList,sValue)

 'This function adds an entry onto the end of a dynamic array if not already present

 Dim iListIndex, iListMax, bMatch

 iListMax = Ubound(aList)
 bMatch = False

 For iListIndex = 0 to iListMax

 If aList(iListIndex) = sValue Then
 bMatch = True
 Exit For
 End If

 Next

 If Not bMatch Then

 ReDim Preserve aList(iListMax+1)

 aList(iListMax+1) = sValue

 End If

 ArrayAppendUnique = aList

End Function

'========================================

Private Function GetCommonPasswords

 Dim aPwds

 'Call zGen_PopupMsg("Loading Common Passwords...", 2, vbInformation,"")

 ReDim aPwds(9)

 aPwds(0) = "password"
 aPwds(1) = "123456"
 aPwds(2) = "12345678"
 aPwds(3) = "1234"
 aPwds(4) = "pussy"
 aPwds(5) = "12345"
 aPwds(6) = "dragon"
 aPwds(7) = "qwerty"
 aPwds(8) = "696969"
 aPwds(9) = "sa"

 GetCommonPasswords = aPwds

End Function

'========================================

Private Function GetBaseDrivers

 Dim aBaseDrivers

 Call zGen_PopupMsg("Loading Baseline Drivers...", 2, vbInformation,"")

 ReDim aBaseDrivers(21)

 aBaseDrivers(00) = "SQL Server"
 aBaseDrivers(01) = "Microsoft Access Driver (*.mdb)"
 aBaseDrivers(02) = "Microsoft Text Driver (*.txt; *.csv)"
 aBaseDrivers(03) = "Microsoft Excel Driver (*.xls)"
 aBaseDrivers(04) = "Microsoft dBase Driver (*.dbf)"
 aBaseDrivers(05) = "Microsoft Paradox Driver (*.db )"
 aBaseDrivers(06) = "Microsoft Visual FoxPro Driver"
 aBaseDrivers(07) = "Microsoft FoxPro VFP Driver (*.dbf)"
 aBaseDrivers(08) = "Microsoft dBase VFP Driver (*.dbf)"
 aBaseDrivers(09) = "Microsoft Access-Treiber (*.mdb)"
 aBaseDrivers(10) = "Microsoft Text-Treiber (*.txt; *.csv)"
 aBaseDrivers(11) = "Microsoft Excel-Treiber (*.xls)"
 aBaseDrivers(12) = "Microsoft dBase-Treiber (*.dbf)"
 aBaseDrivers(13) = "Microsoft Paradox-Treiber (*.db )"
 aBaseDrivers(14) = "Microsoft Visual FoxPro-Treiber"
 aBaseDrivers(15) = "Driver do Microsoft Access (*.mdb)"
 aBaseDrivers(16) = "Driver da Microsoft para arquivos texto (*.txt; *.csv)"
 aBaseDrivers(17) = "Driver do Microsoft Excel(*.xls)"
 aBaseDrivers(18) = "Driver do Microsoft dBase (*.dbf)"
 aBaseDrivers(19) = "Driver do Microsoft Paradox (*.db )"
 aBaseDrivers(20) = "Driver para o Microsoft Visual FoxPro"
 aBaseDrivers(21) = "Microsoft ODBC for Oracle"

 GetBaseDrivers = aBaseDrivers

End Function

'========================================

Private Function GetCurrDrivers()

 Dim oReg, sKeyPath, aNames, aTypes

 Const HKLM = &H80000002

 Call zGen_PopupMsg("Loading Current Drivers...", 2, vbInformation,"")

 Set oReg = GetObject("winmgmts:\\.\root\default:StdRegProv")

 sKeyPath = "SOFTWARE\ODBC\ODBCINST.INI\ODBC Drivers"

 oReg.EnumValues HKLM, sKeyPath, aNames, aTypes

 GetCurrDrivers = aNames

End Function

'========================================

Private Sub zGen_PopupMsg(sMsg, iDelay, iStyle, sTitle)

 Dim oShell

 If iDelay = 0 Then
 Msgbox sMsg

 Else

 Set oShell = CreateObject("Wscript.Shell")

 oShell.Popup sMsg, iDelay, sTitle, iStyle

 Set oShell = Nothing

 End If

End Sub

'========================================

Private Sub zQTP_MinimizeWindow

 Dim oApp

 Call zGen_PopupMsg("Clear the decks...", 1, vbInformation,"")

 Set oApp = GetObject("","QuickTest.Application")

 oApp.WindowState = "Minimized"

 Set oApp = Nothing

End Sub

'========================================

Private Function zGen_GetIni(sIniFile, sSection, sKey, sDefault)

 Dim iRet, sReturnString

 Extern.Declare micLong, "GetPrivateProfileString", "kernel32.dll", "GetPrivateProfileStringA", micString, micString, micString, micString + micByRef, micDWord, micString

 iRet = Extern.GetPrivateProfileString(sSection, sKey, sDefault, sReturnString, 256, sIniFile)

 If iRet > 0 Then
 zGen_GetIni = sReturnString
 Else
 zGen_GetIni = sDefault
 End If

End Function

'========================================

Private Sub zGen_SetIni(sIniFile, sSection, sKey, sValue)

 Dim iRet

 Extern.Declare micLong, "WritePrivateProfileString", "kernel32.dll", "WritePrivateProfileStringA", micString, micString, micString, micString

 iRet = Extern.WritePrivateProfileString(sSection, sKey, sValue, sIniFile)

End Sub

'========================================

Private Function GetCombo(sTitle, aList, sListDefault)

 Dim iListMax, iListIndex, iCount, sValue, sReply, oFrm, oBtn, oCbo, x, y, posn, iReply, sDrv

 'Set up a screen with a combobox

 Set oFrm = DotNetFactory.CreateInstance("System.Windows.Forms.Form", "System.Windows.Forms")
 Set oBtn = DotNetFactory.CreateInstance("System.Windows.Forms.Button", "System.Windows.Forms")
 Set oCbo = DotNetFactory.CreateInstance("System.Windows.Forms.ComboBox", "System.Windows.Forms")

 x = 10
 y = 10

 Set posn = DotNetFactory.CreateInstance("System.Drawing.Point", "System.Drawing", x, y)

 'sDrv = zGen_GetIni(sIni, "App_" & sApp, "Drv", "")

 iListMax = Ubound(aList)

 'Populate the combo
 For iListIndex = 0 to iListMax
 oCbo.Items.Add aList(iListIndex)
 'Set the default value
 If sListDefault = aList(iListIndex) Then
 oCbo.Text = aList(iListIndex)
 ElseIf iListIndex = 0 Then
 oCbo.Text = aList(iListIndex)
 End If
 Next

 oCbo.Location = posn
 oCbo.Width = 400
 posn.X = 60
 posn.Y = 30
 oBtn.Text = "OK"
 posn.Y = CInt(oCbo.Height) + 20
 oBtn.Location = posn
 oFrm.AcceptButton = oBtn
 oFrm.CancelButton = oBtn
 oFrm.Controls.Add(oBtn)
 oFrm.Controls.Add(oCbo)
 oFrm.Width = 500
 oFrm.Text = sTitle
 oFrm.Topmost = True

 oFrm.ShowDialog

 sReply = oCbo.Text

 If sReply = "" Then
 'User Abort...
 Call ExitTest()
 End If

 'Save the value for next time?

 'Return the value
 GetCombo = sReply

End Function

'========================================

Private Function GetIniCombo(sIniFile, sTitle, sSection, sKey)

 Dim iCount, sValue, sReply, oFrm, oBtn, oCbo, x, y, posn, iLoop, asList(100), iReply
 Dim sGenKey, sGenData

 'Get the last general reference if any
 sValue = zGen_GetIni(sIniFile, sSection, sKey, sKey)

 'Get the count
 iCount = cInt(zGen_GetIni(sIniFile, sSection, sKey & "Count" , "0"))

 If iCount = 0 Then

 'A new case, use an input box

 sReply = Inputbox (sTitle, "User Input Required", sValue)

 If sReply = "" Then
 'User Abort...
 Call ExitTest()
 End If

 'Start populating the list
 Call zGen_SetIni(sIniFile, sSection, sKey & "Count", "01")
 Call zGen_SetIni(sIniFile, sSection, sKey & "01", sReply)

 Else

 'Set up a screen with a combobox

 Set oFrm = DotNetFactory.CreateInstance("System.Windows.Forms.Form", "System.Windows.Forms")
 Set oBtn = DotNetFactory.CreateInstance("System.Windows.Forms.Button", "System.Windows.Forms")
 Set oCbo = DotNetFactory.CreateInstance("System.Windows.Forms.ComboBox", "System.Windows.Forms")

 x = 10
 y = 10

 Set posn = DotNetFactory.CreateInstance("System.Drawing.Point", "System.Drawing", x, y)

 'Populate the array and combo
 For iLoop = 1 to iCount
 sGenKey = sKey & Right("00" & cStr(iLoop),2)
 sGenData = zGen_GetIni(sIniFile, sSection, sGenKey , "Gen")
 asList(iLoop) = sGenData
 oCbo.Items.Add sGenData
 If sGenData = sValue Then
 'Set the default value to the value the user chose last time
 oCbo.Text = sGenData
 End If
 Next

 oCbo.Location = posn
 posn.X = 60
 posn.Y = 30
 oBtn.Text = "OK"
 posn.Y = CInt(oCbo.Height) + 20
 oBtn.Location = posn
 oFrm.AcceptButton = oBtn
 oFrm.CancelButton = oBtn
 oFrm.Controls.Add(oBtn)
 oFrm.Controls.Add(oCbo)
 oFrm.Width = 500
 oFrm.Text = sTitle
 oFrm.Topmost = True

 oFrm.ShowDialog

 sReply = oCbo.Text

 If sReply = "" Then
 'User Abort...
 Call ExitTest()
 End If

 'Has the user chosen from the list or entered a new value?

 'Scan the array
 iReply = 0
 For iLoop = 1 to iCount
 If sReply = asList(iLoop) Then
 iReply = iLoop
 Exit For
 End If
 Next

 If iReply = 0 Then
 'User has entered a new value, add it to the list
 Call zGen_SetIni(sIniFile, sSection, sKey & "Count", cStr(iCount+1))
 Call zGen_SetIni(sIniFile, sSection, sKey & Right("00" & cStr(iCount+1),2),sReply)

 'Else
 'User has chosen an existing value - no action required

 End If

 End If

 'Save the value for future defaults
 Call zGen_SetIni(sIniFile, sSection, sKey, sReply)

 'Return the value
 GetIniCombo = sReply

End Function

'========================================

Private Function zFile_FolderExists(sFolder)

 Dim oFso

 Set oFso = CreateObject("Scripting.FileSystemObject")

 If oFso.FolderExists(sFolder) Then

 zFile_FolderExists = True

 Else

 zFile_FolderExists = False

 End If

 Set oFso = Nothing

End Function

'========================================

Private Function zFile_Exists(sFileName)

 Dim oFso

 Set oFso = CreateObject("Scripting.FileSystemObject")

 If oFso.FileExists(sFileName) Then

 zFile_Exists = True

 Else

 zFile_Exists = False

 End If

 Set oFso = Nothing

End Function

'========================================

Private Sub zFile_OpenWithNotepad(sFile)

 SystemUtil.Run "C:\WINDOWS\system32\notepad.exe", sFile

End Sub

'========================================

Private Function zFile_GetNameDialog(sTitle, sInitialDir, sFilter, sFile)

 Dim oFd, iRet

 Set oFd = DotNetFactory.CreateInstance("System.Windows.Forms.OpenFileDialog", "System.Windows.Forms")

 oFd.InitialDirectory = sInitialDir

 oFd.Title = sTitle

 If sFile <> "" Then
 oFd.FileName = sFile
 End If

 oFd.Filter = sFilter

 oFd.RestoreDirectory = True

 oFd.FilterIndex = 1

 iRet = oFd.ShowDialog()

 zFile_GetNameDialog = oFd.Filename

End Function

'=========================================================================