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

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:<br><br>"
	sHtml = sHtml & "<h2><strong>GenConn V1.2 by Intellipro</strong></h2>"
	sHtml = sHtml & "For more useful things like this, go to:<br><br>"
	sHtml = sHtml & "&nbsp;&nbsp;&nbsp;&nbsp;Web: <a href=" & Chr(34) & "http://www.intellipro.co.uk" & Chr(34) & " target=" & Chr(34) & "_blank" & Chr(34) & ">http://www.intellipro.co.uk</a><br><br>"
	sHtml = sHtml & "If you have suggestions for improvements, contact me at:<br><br>"
	sHtml = sHtml & "&nbsp;&nbsp;&nbsp;&nbsp;Email: <a href=" & Chr(34) & "mailto:rossw@intellipro.co.uk" & Chr(34) & ">rossw.intellipro.co.uk</a><br><br><br>"
	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:<br><br>"
	sHtml = sHtml & "<h2><strong>GenConn V1.2 by Intellipro</strong></h2>"
	sHtml = sHtml & "Your Connection String is:<br><br>"
	sHtml = sHtml & "&nbsp;&nbsp;&nbsp;&nbsp;" & "sCon = " & Chr(34) & sCon & Chr(34) & "<br><br><br>"
	sHtml = sHtml & "For more useful things like this, go to:<br><br>"
	sHtml = sHtml & "&nbsp;&nbsp;&nbsp;&nbsp;Web: <a href=" & Chr(34) & "http://www.intellipro.co.uk" & Chr(34) & " target=" & Chr(34) & "_blank" & Chr(34) & ">http://www.intellipro.co.uk</a><br><br>"
	sHtml = sHtml & "If you have suggestions for improvements, contact me at:<br><br>"
	sHtml = sHtml & "&nbsp;&nbsp;&nbsp;&nbsp;Email: <a href=" & Chr(34) & "mailto:rossw@intellipro.co.uk" & Chr(34) & ">rossw.intellipro.co.uk</a><br><br><br>"
	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:<br><br>"
	sHtml = sHtml & "<h2><strong>&nbsp;&nbsp;GenConn V1.2 by Intellipro</strong></h2>"
	sHtml = sHtml & "For more useful things like this, go to:<br><br>"
	sHtml = sHtml & "&nbsp;&nbsp;&nbsp;&nbsp;Web: <a href=" & Chr(34) & "http://www.intellipro.co.uk" & Chr(34) & " target=" & Chr(34) & "_blank" & Chr(34) & ">http://www.intellipro.co.uk</a><br><br>"
	sHtml = sHtml & "If you have suggestions for improvements, contact me at:<br><br>"
	sHtml = sHtml & "&nbsp;&nbsp;&nbsp;&nbsp;Email: <a href=" & Chr(34) & "mailto:rossw@intellipro.co.uk" & Chr(34) & ">rossw.intellipro.co.uk</a><br><br><br>"
	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

'########################################



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