Option Explicit

'NOTE - For safety, the SQL Executes in the generated code are commented out
'Please carefully review the generated code before turning the Executes on

Sub GenSql_SqlSvr

	Dim sServer, sDatabase, sUser, sPassword

	If GetDatabaseConnection(sServer,sDatabase,sUser,sPassword) Then
		Call ProcessDatabase(sServer,sDatabase,sUser,sPassword)
	End If

End Sub

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

Private Function GetDatabaseConnection(sServer, sDatabase, sUser, sPassword)

	Dim sCon, oCon, iErr, sErr

	sServer   = "localhost"
	sDatabase = "Northwind"
	sUser     = "sa"
	sPassword = "password"

	'Get User interactions

	sServer = Inputbox ("Enter the name of your Server:", "User Input Required", sServer)
	If sServer = "" Then
		Call ExitTest()
	End If

	sDatabase = Inputbox ("Enter the name of your Database:", "User Input Required", sDatabase)
	If sDatabase = "" Then
		Call ExitTest()
	End If

	sUser = Inputbox ("Enter a Username for that database:", "User Input Required", sUser)
	If sUser = "" Then
		Call ExitTest()
	End If

	sPassword = Inputbox ("Enter a Password for that user:", "User Input Required", sPassword)
	If sPassword = "" Then
		Call ExitTest()
	End If

	'Assemble the connection string (Sql-Server-2000)
	sCon = "Driver={SQL Server};Server=" & sServer & ";Database=" & sDatabase & ";Uid=" & sUser & ";Pwd=" & sPassword & ";"

	Set oCon = CreateObject("adodb.connection")

	'Set connection timeout (default is 15 seconds)?
	'oCon.ConnectionTimeout = 1

	'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

		GetDatabaseConnection = False
		
		If iErr = -2147467259 Then
			Msgbox "SQL Server does not exist or access denied",vbCritical,"SQL-Server Connection Error:"

		ElseIf iErr = -2147217843 Then
			Msgbox "Login Failed for User - Invalid User name or Password",vbCritical,"SQL-Server Connection Error:"

		Else
			Msgbox cStr(iErr) & " - " & sErr,vbCritical,"SQL-Server Undiagnosed Connection Error:"
		End If

	Else
		GetDatabaseConnection = True
		oCon.Close
	End If

	Set oCon = Nothing

End Function

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

Private Function ProcessDatabase(sServer,sDatabase,sUser,sPassword)

	Dim sCon, oCon, asTables(49,1), asFields(49,49,3), iTableCount

	sCon = "Driver={SQL Server};Server=" & sServer & ";Database=" & sDatabase & ";Uid=" & sUser & ";Pwd=" & sPassword & ";"

	Set oCon = CreateObject("adodb.connection")

	oCon.Open sCon

	iTableCount = GetDatabaseTables(oCon,asTables)

	Call GetDatabaseFields(oCon,iTableCount,asTables,asFields)

	Call ProcessArray(iTableCount,asTables,asFields)

	oCon.Close

	Set oCon = Nothing

	Call GenerateOutput(sCon,sServer,sDatabase,iTableCount,asTables,asFields)

End Function

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

Private Function GetDatabaseTables(oCon,asTables)

	Dim oRec, sSql, iTableCount, sTable

	iTableCount = 0

	Set oRec = CreateObject("ADODB.Recordset")

	sSql = "SELECT name FROM sysobjects WHERE xtype = 'U'"

	oRec.Open sSQL, oCon

	If NOT oRec.Eof Then

		oRec.MoveFirst

		While NOT oRec.Eof

			sTable = oRec.Fields("name")

			asTables(iTableCount,0) = sTable

			iTableCount = iTableCount + 1

			oRec.MoveNext

		Wend

	End If

	oRec.Close

	Set oRec = Nothing

	GetDatabaseTables = iTableCount

End Function

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

Private Sub GetDatabaseFields(oCon,iTableCount,asTables,asFields)

	Dim iTableIndex

	For iTableIndex = 0 to iTableCount-1

		asTables(iTableIndex,1) = GetTableFields(oCon,iTableIndex,asTables,asFields)

	Next

End Sub

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

Private Function GetTableFields(oCon,iTableIndex,asTables,asFields)

	Dim sTable, oRec, sSql, iFieldCount, sFieldName, sFieldType

	sTable = asTables(iTableIndex,0)

	iFieldCount = 0

	Set oRec = CreateObject("ADODB.Recordset")

	sSql = "SELECT c.name AS fname, c.xtype AS ftype, c.status AS fstatus FROM sysobjects o JOIN syscolumns c ON c.id = o.id WHERE o.name = '" & sTable & "'"

	oRec.Open sSQL, oCon

	If NOT oRec.Eof Then

		oRec.MoveFirst

		While NOT oRec.Eof

			asFields(iTableIndex,iFieldCount,0) = oRec.Fields("fname")
			asFields(iTableIndex,iFieldCount,1) = oRec.Fields("ftype")
			asFields(iTableIndex,iFieldCount,2) = oRec.Fields("fstatus")

			iFieldCount = iFieldCount + 1

			oRec.MoveNext

		Wend

	End If

	Print "Fields Found: " & cStr(iFieldCount)

	GetTableFields = iFieldCount

	oRec.Close

	Set oRec = Nothing

End Function

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

Private Sub ProcessArray(iTableCount,asTables,asFields)

	Dim iTableIndex, iFieldCount, iFieldIndex, sFieldName, sFieldType, sFieldStatus

	For iTableIndex = 0 to iTableCount-1

		iFieldCount = asTables(iTableIndex,1)
		For iFieldIndex = 0 to iFieldCount-1

			sFieldName = asFields(iTableIndex,iFieldIndex,0)
			sFieldType = asFields(iTableIndex,iFieldIndex,1)
			sFieldStatus = asFields(iTableIndex,iFieldIndex,2)

			Select Case sFieldType

				Case 35, 99, 167, 175, 231, 239
					asFields(iTableIndex,iFieldIndex,3) = "s" 'Strings
				Case 58, 61
					asFields(iTableIndex,iFieldIndex,3) = "d" 'Dates
				Case 60, 122
					asFields(iTableIndex,iFieldIndex,3) = "m" 'Money
				Case 104, 48, 52, 56, 59, 62, 106, 108, 127
					asFields(iTableIndex,iFieldIndex,3) = "i" 'Numerics
				Case Else
					asFields(iTableIndex,iFieldIndex,3) = "x" 'Not Handled

			End Select
		Next
	Next

End Sub

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

Private Sub GenerateOutput(sCon,sServer, sDatabase,iTableCount,asTables,asFields)

	Dim sApp, sFileName, oFso, oFile
	Const ForWriting = 2, TristateTrue = -1

	'Get the Application Mnemonic
	sApp = "App"
	sApp = Inputbox ("Enter a name for your application (3 - 4 chars are ideal):", "User Input Required", sApp)
	If sApp = "" Then
		Call ExitTest()
	End If

	'Get the User to confirm the file name
	sFileName = "C:\Program Files\HP\QuickTest Professional\Tests\" & sApp & "_" & sDatabase & "_SQL.qfl"
	sFileName = Inputbox ("Confirm generated file name:", "User Input Required", sFileName)
	If sFileName = "" Then
		Call ExitTest()
	End If

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

	'Write header
	oFile.WriteLine("Option Explicit")
	oFile.WriteLine("'--------------")
	oFile.WriteLine("") 
	oFile.WriteLine("'Database SQL Functions")
	oFile.WriteLine("")
	oFile.WriteLine("'For App      : " & sApp)
	oFile.WriteLine("'For Server   : " & sServer)
	oFile.WriteLine("'For Database : " & sDatabase)
	oFile.WriteLine("")
	oFile.WriteLine("'Automatically Generated by the Intellipro SQL Sql-Server 2000 Code Generator")
	oFile.WriteLine("")
	oFile.WriteLine("'" & String(40,"="))
	oFile.WriteLine("")

	'For each table generate the SQL
	Dim iTableIndex
	For iTableIndex = 0 to iTableCount-1
		Call GenTableOutput(sCon,oFile,sApp,sDatabase,iTableIndex,asTables,asFields)
	Next

	'Footer
	oFile.WriteLine("")
	oFile.WriteLine("'" & String(40,"#"))
	oFile.Close

End Sub

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

Private Sub GenTableOutput(sCon,oFile,sApp,sDatabase,iTableIndex,asTables,asFields)

	Call GenSqlAdd(sCon,oFile,sApp,iTableIndex,asTables,asFields)

	Call GenSqlGet(sCon,oFile,sApp,iTableIndex,asTables,asFields)

	Call GenSqlUpdate(sCon,oFile,sApp,iTableIndex,asTables,asFields)

	Call GenSqlDelete(sCon,oFile,sApp,iTableIndex,asTables,asFields)

	Call GenSqlExists(sCon,oFile,sApp,iTableIndex,asTables,asFields)

End Sub

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

Private Sub GenSqlAdd(sCon,oFile,sApp,iTableIndex,asTables,asFields)

	Dim sTableName, sTableNameF, sParam, iLineCount, iFieldIndex, iFieldCount, sFieldName, sFieldType, sFieldStatus, sFieldClass, sQ, bQ

	sQ = Chr(34)
	sTableName = asTables(iTableIndex,0)
	sTableNameF = GetFunctionSafeTableName(sTableName)
	iFieldCount = asTables(iTableIndex,1)

	sParam = GetParamAdd(iTableIndex,asTables,asFields)

	'Write header
	oFile.WriteLine("")
	oFile.WriteLine("Function " & sApp & "Sql_" & sTableNameF & "_Add(" & sParam & ")")
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "'Add an Entry to the " & sTableName & " table")

	'Dump what we know about the table
	Call Datadump(oFile,iTableIndex,asTables,asFields)

	oFile.WriteLine(vbTab & "Dim oCon, oRec, sSql, lIdentity")
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "lIdentity = 0")
	oFile.WriteLine("")
	
	'Code to assemble the SQL
	oFile.WriteLine(vbTab & "sSql =        " & sQ & "INSERT INTO " & sTableName & sQ)
	oFile.WriteLine(vbTab & "sSql = sSql & " & sQ & "(" & sQ)
	oFile.WriteLine("")

	'Database Fields
	iLineCount = 0
	For iFieldIndex = 0 to iFieldCount-1
		sFieldName   = asFields(iTableIndex,iFieldIndex,0)
		sFieldType   = asFields(iTableIndex,iFieldIndex,1)
		sFieldStatus = asFields(iTableIndex,iFieldIndex,2)
		sFieldClass  = asFields(iTableIndex,iFieldIndex,3)
		If (sFieldType = 56) AND (sFieldStatus = 128) Then
			'Ignore
		ElseIf sFieldClass = "x" Then
			'Ignore
		Else
			iLineCount = iLineCount + 1
			If iLineCount = 1 Then
				oFile.WriteLine(vbTab & "sSql = sSql &             " & sQ & sFieldName & sQ)
			Else
				oFile.WriteLine(vbTab & "sSql = sSql & " & sQ & "," & sQ & " &       " & sQ & sFieldName & sQ)
			End If
		End If
	Next

	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "sSql = sSql & " & sQ & ") VALUES (" & sQ)
	oFile.WriteLine("")

	'Values
	bQ = False
	iLineCount = 0
	For iFieldIndex = 0 to iFieldCount-1
		sFieldName   = asFields(iTableIndex,iFieldIndex,0)
		sFieldType   = asFields(iTableIndex,iFieldIndex,1)
		sFieldStatus = asFields(iTableIndex,iFieldIndex,2)
		sFieldClass  = asFields(iTableIndex,iFieldIndex,3)
		If (sFieldType = 56) AND (sFieldStatus = 128) Then
			'Ignore
		ElseIf sFieldClass = "x" Then
			'Ignore
		Else
			iLineCount = iLineCount + 1
			If iLineCount = 1 Then
				If sFieldClass = "s" Then
					oFile.WriteLine(vbTab & "sSql = sSql & " & sQ & "'" & sQ & "   &      " & sFieldClass & sFieldName)
					bQ = True
				Else
					oFile.WriteLine(vbTab & "sSql = sSql &         cStr(" & sFieldClass & sFieldName & ")")
					bQ = False
				End If
			Else
				If sFieldClass = "s" Then
					If bQ Then
						oFile.WriteLine(vbTab & "sSql = sSql & " & sQ & "','" & sQ & " &      " & sFieldClass & sFieldName)
					Else
						oFile.WriteLine(vbTab & "sSql = sSql & " & sQ & ",'" & sQ & "  &      " & sFieldClass & sFieldName)
					End If
					bQ = True
				Else
					If bQ Then
						oFile.WriteLine(vbTab & "sSql = sSql & " & sQ & "'," & sQ & "  & cStr(" & sFieldClass & sFieldName & ")")
					Else
						oFile.WriteLine(vbTab & "sSql = sSql & " & sQ & "," & sQ & "   & cStr(" & sFieldClass & sFieldName & ")")
					End If
					bQ = False
				End If
			End If
		End If
	Next

	oFile.WriteLine("")

	If bQ Then
		oFile.WriteLine(vbTab & "sSql = sSql & " & sQ & "')" & sQ)
	Else
		oFile.WriteLine(vbTab & "sSql = sSql & " & sQ & ")" & sQ)
	End If

	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "sSql = sSql & vbCrLf")
	oFile.WriteLine(vbTab & "sSql = sSql & " & sQ & "SELECT @@Identity" & sQ)
	oFile.WriteLine(vbTab & "sSql = sSql & vbCrLf")
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "Print sSql")
	oFile.WriteLine(vbTab & "Msgbox sSql")
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "Set oCon = CreateObject(" & sQ & "ADODB.Connection" & sQ & ")")
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "Set oRec = CreateObject(" & sQ & "ADODB.Recordset" & sQ & ")")
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "oCon.Open " & sQ & sCon & sQ)
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "'########## WARNING ##########")
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "'This code can damage your data")
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "'Review it carefully BEFORE turning the Execute ON")
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "MsgBox " & sQ & "SQL Execute is currently turned off, remove comment to activate" & sQ & ", vbExclamation, " & sQ & "Function: " & sApp & "Sql_" & sTableNameF & "_Add" & sQ)
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "'Set oRec = oCon.Execute (sSql)")
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "'Set oRec = oRec.NextRecordSet()")
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "'lIdentity = oRec(0)")
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "'oRec.Close")
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "'#############################")
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "oCon.Close")
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "Set oRec = Nothing")
	oFile.WriteLine(vbTab & "Set oCon = Nothing")
	oFile.WriteLine("")
	oFile.WriteLine( vbTab & sApp & "Sql_" & sTableNameF & "_Add = lIdentity")
	oFile.WriteLine("")
	oFile.WriteLine("End Function")
	oFile.WriteLine("")
	oFile.WriteLine("'" & String(40,"="))

End Sub

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

Private Sub GenSqlGet(sCon,oFile,sApp,iTableIndex,asTables,asFields)

	Dim sTableName, sTableNameF, sParam, iLineCount, iFieldIndex, iFieldCount, sFieldName, sFieldType, sFieldStatus, sFieldClass, sQ, bQ
	Dim iKeyFieldIndex, sKeyFieldName, sKeyFieldClass, sLine, iPad

	sQ = Chr(34)
	sTableName = asTables(iTableIndex,0)
	sTableNameF = GetFunctionSafeTableName(sTableName)
	iFieldCount = asTables(iTableIndex,1)
	iPad = GetLongestFieldName(iTableIndex,asTables,asFields)
	sParam = GetParamUpdate(iTableIndex,asTables,asFields)
	iKeyFieldIndex = GetKeyFieldIndex(iTableIndex,asTables, asFields)

	If iKeyFieldIndex = -1 Then
		sKeyFieldName = "Xxxx"
		sKeyFieldClass = "x"
	Else
		sKeyFieldName = asFields(iTableIndex,iKeyFieldIndex,0)
		sKeyFieldClass = asFields(iTableIndex,iKeyFieldIndex,3)
	End If

	'Header
	oFile.WriteLine("") 
	oFile.WriteLine("Function " & sApp & "Sql_" & sTableNameF & "_Get(" & sParam & ")")
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "'Get an Entry from the " & sTableName & " table")

	'Dump what we know about the table
	Call Datadump(oFile,iTableIndex,asTables,asFields)

	oFile.WriteLine(vbTab & "Dim oCon, oRec, sSql")
	oFile.WriteLine("")

	If sKeyFieldClass = "s" Then
		oFile.WriteLine(vbTab & "sSql = " & sQ & "SELECT * FROM " & sTableName & " WHERE " & sKeyFieldName & " = '" & sQ & " & " & sKeyFieldClass & sKeyFieldName & " & " & sQ & "'" & sQ)
	Else
		oFile.WriteLine(vbTab & "sSql = " & sQ & "SELECT * FROM " & sTableName & " WHERE " & sKeyFieldName & " = " & sQ & " & cStr(" & sKeyFieldClass & sKeyFieldName & ")")
	End If

	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "Print sSql")
	oFile.WriteLine(vbTab & "Msgbox sSql")
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "Set oCon = CreateObject(" & sQ & "ADODB.Connection" & sQ & ")")
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "Set oRec = CreateObject(" & sQ & "ADODB.Recordset" & sQ & ")")
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "oCon.Open " & sQ & sCon & sQ)
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "oRec.Open sSQL,oCon")
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "If oRec.Eof Then")	
	oFile.WriteLine(vbTab & vbTab & sApp & "Sql_" & sTableName & "_Get = False")
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "Else")
	oFile.WriteLine(vbTab & vbTab & sApp & "Sql_" & sTableName & "_Get = True")
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & vbTab & "oRec.MoveFirst")
	oFile.WriteLine("")

	'Database Fields
	For iFieldIndex = 0 to iFieldCount-1

		sFieldName   = asFields(iTableIndex,iFieldIndex,0)
		sFieldType   = asFields(iTableIndex,iFieldIndex,1)
		sFieldStatus = asFields(iTableIndex,iFieldIndex,2)
		sFieldClass  = asFields(iTableIndex,iFieldIndex,3)

		If (sFieldType = 56) AND (sFieldStatus = 128) Then
			'Ignore
		ElseIf sFieldClass = "x" Then
			'Ignore
		Else

			If sFieldClass = "s" Then
				sLine = vbTab & vbTab & Left(sFieldClass & sFieldName & Space(iPad+2),iPad+2) & " = oRec.Fields(" & sQ & sFieldName & sQ & ")"
			Else
				sLine = vbTab & vbTab & Left(sFieldClass & sFieldName & Space(iPad+2),iPad+2) & " = oRec.Fields(" & sQ & sFieldName & sQ & ")"
			End If

			oFile.WriteLine(sLine)

		End If

	Next

	'Footer
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "End If")
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "oRec.Close")
	oFile.WriteLine(vbTab & "oCon.Close")
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "Set oRec = Nothing")
	oFile.WriteLine(vbTab & "Set oCon = Nothing")
	oFile.WriteLine("")
	oFile.WriteLine("End Function")
	oFile.WriteLine("")
	oFile.WriteLine("'" & String(40,"="))

End Sub

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

Private Sub GenSqlUpdate(sCon,oFile,sApp,iTableIndex,asTables,asFields)

	Dim sTableName, sTableNameF, sParam, iLineCount, iFieldIndex, iFieldCount, sFieldName, sFieldType, sFieldStatus, sFieldClass, sQ, bQ
	Dim iKeyFieldIndex, sKeyFieldName, sKeyFieldClass, sLine, iPad

	sQ = Chr(34)
	sTableName = asTables(iTableIndex,0)
	sTableNameF = GetFunctionSafeTableName(sTableName)
	iFieldCount = asTables(iTableIndex,1)

	iPad = GetLongestFieldName(iTableIndex,asTables,asFields)

	sParam = GetParamUpdate(iTableIndex,asTables,asFields)

	iKeyFieldIndex = GetKeyFieldIndex(iTableIndex,asTables, asFields)

	If iKeyFieldIndex = -1 Then
		sKeyFieldName = "Xxxx"
		sKeyFieldClass = "x"
	Else
		sKeyFieldName = asFields(iTableIndex,iKeyFieldIndex,0)
		sKeyFieldClass = asFields(iTableIndex,iKeyFieldIndex,3)
	End If

	'Write header
	oFile.WriteLine("") 
	oFile.WriteLine("Sub " & sApp & "Sql_" & sTableNameF & "_Update(" & sParam & ")")
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "'Update an Entry in the " & sTableName & " table")

	'Dump what we know about the table
	Call Datadump(oFile,iTableIndex,asTables,asFields)
	
	oFile.WriteLine(vbTab & "Dim oCon, sSql")
	oFile.WriteLine("")

	'Create the SQL for the Update
	oFile.WriteLine("")
	oFile.WriteLine(vbTab   & "sSql =              " & sQ & "UPDATE " & sTableName & sQ)
	oFile.WriteLine("")
	oFile.WriteLine(  vbTab & "sSql = sSql & " & sQ & " SET " & sQ)
	oFile.WriteLine("")

	'Database Fields
	iLineCount = 0
	bQ = False
	For iFieldIndex = 0 to iFieldCount-1
		sFieldName   = asFields(iTableIndex,iFieldIndex,0)
		sFieldType   = asFields(iTableIndex,iFieldIndex,1)
		sFieldStatus = asFields(iTableIndex,iFieldIndex,2)
		sFieldClass  = asFields(iTableIndex,iFieldIndex,3)

		If (sFieldType = 56) AND (sFieldStatus = 128) Then
			'Ignore
		ElseIf sFieldClass = "x" Then
			'Ignore
		Else

			iLineCount = iLineCount + 1
			If iLineCount = 1 Then

				If sFieldClass = "s" Then
					sLine = vbTab & "sSql = sSql &              " & sQ & Left(sFieldName & sQ & Space(iPad),iPad+1)
					sLine = sLine & " & " & sQ & " = '" & sQ & " &      " & sFieldClass & sFieldName
					bQ = True
				Else
					sLine = vbTab & "sSql = sSql &              " & sQ & Left(sFieldName & sQ & Space(iPad),iPad+1)
					sLine = sLine & " & " & sQ & " = " & sQ & "  & cStr(" & sFieldClass & sFieldName & ")"
					bQ = False
				End If

			Else

				If sFieldClass = "s" Then
					If bQ Then
						sLine = vbTab & "sSql = sSql & " & sQ & "'," & sQ & " &       " & sQ & Left(sFieldName & sQ & Space(iPad),iPad+1)
						sLine = sLine & " & " & sQ & " = '" & sQ & " &      " & sFieldClass & sFieldName	
					Else
						sLine = vbTab & "sSql = sSql & " & sQ & "," & sQ & "  &       " & sQ & Left(sFieldName & sQ & Space(iPad),iPad+1)
						sLine = sLine & " & " & sQ & " = '" & sQ & " &      " & sFieldClass & sFieldName	
					End If
					bQ = True
				Else
					If bQ Then
						sLine = vbTab & "sSql = sSql & " & sQ & "'," & sQ & " &       " & sQ & Left(sFieldName & sQ & Space(iPad),iPad+1)
						sLine = sLine & " & " & sQ & " = " & sQ & "  & cStr(" & sFieldClass & sFieldName	& ")"
					Else
						sLine = vbTab & "sSql = sSql & " & sQ & "," & sQ & "  &       " & sQ & Left(sFieldName & sQ & Space(iPad),iPad+1)
						sLine = sLine & " & " & sQ & " = " & sQ & "  & cStr(" & sFieldClass & sFieldName	& ")"
					End If
					bQ = False
				End If

			End If

			oFile.WriteLine(sLine)

		End If

	Next

	oFile.WriteLine("")

	If sKeyFieldClass = "s" Then
		If bQ Then
			oFile.WriteLine(vbTab & "sSql = sSql & " & sQ & "'" & sQ & "  & " & sQ & "WHERE " & Left(sKeyFieldName & sQ & Space(iPad),iPad+1) & " & " & sQ & " = '" & sQ & " &      " & sKeyFieldClass & sKeyFieldName & " & " & sQ & "'" & sQ)
		Else
			oFile.WriteLine(vbTab & "sSql = sSql &       " & sQ & " WHERE " & Left(sKeyFieldName & sQ & Space(iPad),iPad+1) & " & " & sQ & " = '" & sQ & " &      " & sKeyFieldClass & sKeyFieldName & " & " & sQ & "'" & sQ)
		End If
	Else
		If bQ Then
			oFile.WriteLine(vbTab & "sSql = sSql & " & sQ & "' " & sQ & " & " & sQ & "WHERE " & Left(sKeyFieldName & sQ & Space(iPad),iPad+1) & " & " & sQ & " = " & sQ & "  & cStr(" & sKeyFieldClass & sKeyFieldName & ")")
		Else
			oFile.WriteLine(vbTab & "sSql = sSql & " & "       " & sQ & "WHERE " & Left(sKeyFieldName & sQ & Space(iPad),iPad+1) & " & " & sQ & " = " & sQ & "  & cStr(" & sKeyFieldClass & sKeyFieldName & ")")
		End If
	End If

	'Footer
	oFile.WriteLine("")
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "Print sSql")
	oFile.WriteLine(vbTab & "Msgbox sSql")
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "Set oCon = CreateObject(" & sQ & "ADODB.Connection" & sQ & ")")
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "oCon.Open " & sQ & sCon & sQ)
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "'########## WARNING ##########")
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "'This code can damage your data")
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "'Review it carefully BEFORE turning the Execute ON")
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "MsgBox " & sQ & "SQL Execute is currently turned off, remove comment to activate" & sQ & ", vbExclamation, " & sQ & "Function: " & sApp & "Sql_" & sTableNameF & "_Update" & sQ)
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "'oCon.Execute sSql")
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "'#############################")
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "oCon.Close")
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "Set oCon = Nothing")
	oFile.WriteLine("")
	oFile.WriteLine("End Sub")
	oFile.WriteLine("")
	oFile.WriteLine("'" & String(40,"="))

End Sub

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

Private Sub GenSqlDelete(sCon,oFile,sApp,iTableIndex,asTables,asFields)

	Dim sTableName, sTableNameF, sKeyFieldName, iKeyFieldIndex, sKeyFieldClass, sQ

	sQ = Chr(34)
	sTableName = asTables(iTableIndex,0)
	sTableNameF = GetFunctionSafeTableName(sTableName)

	iKeyFieldIndex = GetKeyFieldIndex(iTableIndex,asTables, asFields)

	If iKeyFieldIndex = -1 Then
		sKeyFieldName = "Xxxx"
		sKeyFieldClass = "x"
	Else
		sKeyFieldName = asFields(iTableIndex,iKeyFieldIndex,0)
		sKeyFieldClass = asFields(iTableIndex,iKeyFieldIndex,3)
	End If

	'Header
	oFile.WriteLine("") 
	oFile.WriteLine("Sub " & sApp & "Sql_" & sTableNameF & "_Delete(" & sKeyFieldClass & sKeyFieldName & ")")
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "'Deletes an Entry from the " & sTableName & " table")

	Call Datadump(oFile,iTableIndex,asTables,asFields)

	oFile.WriteLine(vbTab & "Dim oCon, sSql")
	oFile.WriteLine("")

	If sKeyFieldClass = "s" Then
		oFile.WriteLine(vbTab & "sSql = " & sQ & "DELETE FROM " & sTableName & " WHERE " & sKeyFieldName & " = '" & sQ & " & " & sKeyFieldClass & sKeyFieldName & " & " & sQ & "'" & sQ)
	Else
		oFile.WriteLine(vbTab & "sSql = " & sQ & "DELETE FROM " & sTableName & " WHERE " & sKeyFieldName & " = " & sQ & " & cStr(" & sKeyFieldClass & sKeyFieldName & ")")
	End If

	'Footer
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "Print sSql")
	oFile.WriteLine(vbTab & "Msgbox sSql")
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "Set oCon = CreateObject(" & Chr(34) & "ADODB.Connection" & sQ & ")")
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "oCon.Open " & sQ & sCon & sQ)
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "'########## WARNING ##########")
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "'This code can damage your data")
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "'Review it carefully BEFORE turning the Execute ON")
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "MsgBox " & sQ & "SQL Execute is currently turned off, remove comment to activate" & sQ & ", vbExclamation, " & sQ & "Function: " & sApp & "Sql_" & sTableNameF & "_Delete" & sQ)
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "'oCon.Execute sSql")
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "'#############################")
	oFile.WriteLine("")
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "oCon.Close")
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "Set oCon = Nothing")
	oFile.WriteLine("")
	oFile.WriteLine("End Sub")
	oFile.WriteLine("")
	oFile.WriteLine("'" & String(40,"="))

End Sub

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

Private Sub GenSqlExists(sCon,oFile,sApp,iTableIndex,asTables,asFields)

	Dim sTableName, sTableNameF, iKeyFieldIndex, sKeyFieldName, sKeyFieldClass, sQ

	sQ = Chr(34)
	sTableName  = asTables(iTableIndex,0)
	sTableNameF = GetFunctionSafeTableName(sTableName)

	iKeyFieldIndex = GetKeyFieldIndex(iTableIndex,asTables, asFields)

	If iKeyFieldIndex = -1 Then
		sKeyFieldName = "xxxx"
		sKeyFieldClass = "x"
	Else
		sKeyFieldName = asFields(iTableIndex,iKeyFieldIndex,0)
		sKeyFieldClass = asFields(iTableIndex,iKeyFieldIndex,3)
	End If

	'Header
	oFile.WriteLine("")
	oFile.WriteLine("Function " & sApp & "Sql_" & sTableNameF & "_Exists(" & sKeyFieldClass & sKeyFieldName & ")")
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "'Checks if an entry exists in the " & sTableName & " table")

	Call Datadump(oFile,iTableIndex,asTables,asFields)
	
	oFile.WriteLine(vbTab & "Dim oCon, oRec, sSql")
	oFile.WriteLine("")

	If sKeyFieldClass = "s" Then
		oFile.WriteLine(vbTab & "sSql = " & sQ & "SELECT * FROM " & sTableName & " WHERE " & sKeyFieldName & " = '" & sQ & " & " & sKeyFieldClass & sKeyFieldName & " & " & sQ & "'" & sQ)
	Else
		oFile.WriteLine(vbTab & "sSql = " & sQ & "SELECT * FROM " & sTableName & " WHERE " & sKeyFieldName & " = " & sQ & " & cStr(" & sKeyFieldClass & sKeyFieldName & ")")
	End If

	'Footer
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "Print sSql")
	oFile.WriteLine(vbTab & "Msgbox sSql")
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "Set oCon = CreateObject(" & sQ & "ADODB.Connection" & sQ & ")")
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "Set oRec = CreateObject(" & sQ & "ADODB.Recordset" & sQ & ")")
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "oCon.Open " & sQ & sCon & sQ)
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "oRec.Open sSQL,oCon")
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "If oRec.EOF Then")
	oFile.WriteLine(vbTab & vbTab & sApp & "Sql_" & sTableName & "_Exists = False")
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "Else")
	oFile.WriteLine(vbTab & vbTab & sApp & "Sql_" & sTableName & "_Exists = True")
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "End If")
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "oRec.Close")
	oFile.WriteLine(vbTab & "oCon.Close")
	oFile.WriteLine("")
	oFile.WriteLine(vbTab & "Set oRec = Nothing")
	oFile.WriteLine(vbTab & "Set oCon = Nothing")
	oFile.WriteLine("")
	oFile.WriteLine("End Function")
	oFile.WriteLine("") 
	oFile.WriteLine("'" & String(40,"="))

End Sub

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

Private Function GetFunctionSafeTableName(sInput)

	'This function converts a table name to one that is safe to use in a function name

	'Database tables can contain spaces! (I don't recommend it)

	Dim sOutput

	sOutput = Replace(sInput, " ", "_")

	'Add other adjustments here...

	GetFunctionSafeTableName = sOutput

End Function

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

Private Function GetLongestFieldName(iTableIndex,asTables, asFields)

	Dim iLongest, iFieldCount, iFieldIndex, sFieldName, iFieldNameLength

	iLongest = 0

	iFieldCount = asTables(iTableIndex,1)

	For iFieldIndex = 0 To iFieldCount-1

		sFieldName = asFields(iTableIndex,iFieldIndex,0)

		iFieldNameLength = Len(sFieldName)

		If iFieldNameLength > iLongest Then
			iLongest = iFieldNameLength
		End If

	Next

	GetLongestFieldName = iLongest

End Function

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

Private Function GetKeyFieldIndex(iTableIndex,asTables, asFields)

	'Looks for a unique identifier for deletes, gets, etc.

	'At the moment, this looks for Type=Int, Status=Identity
	'If that fails, it looks for a name suffix of ID
	'It does NOT yet work properly for compound keys and gives up

	Dim iKeyFieldIndex, iFieldCount, iFieldIndex, sFieldName, sFieldType, sFieldStatus

	'Dummy value for when we give up
	iKeyFieldIndex = -1

	iFieldCount = asTables(iTableIndex,1)

	For iFieldIndex = 0 To iFieldCount-1

		sFieldName   = asFields(iTableIndex,iFieldIndex,0)
		sFieldType   = asFields(iTableIndex,iFieldIndex,1)
		sFieldStatus = asFields(iTableIndex,iFieldIndex,2)

		If (sFieldType = 56) AND (sFieldStatus = 128) Then
			iKeyFieldIndex = iFieldIndex
			Exit For
		End If

	Next

	'If it failed try another strategy - fieldnames ending in 'ID' are a good candidate
	If iKeyFieldIndex = -1 Then
		For iFieldIndex = 0 To iFieldCount-1
			sFieldName = asFields(iTableIndex,iFieldIndex,0)
			If Right(sFieldName,2) = "ID" Then
				iKeyFieldIndex = iFieldIndex
				Exit For
			End If
		Next
	End If

	GetKeyFieldIndex = iKeyFieldIndex

End Function

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

Private Function TranslateDataType(iDateType)

	'These are all the datatypes I know about

	Select Case iDateType
		Case 034 TranslateDataType = "Image           "
		Case 035 TranslateDataType = "Text            "
		Case 036 TranslateDataType = "UniqueIdentifier"
		Case 048 TranslateDataType = "TinyInt         "
		Case 052 TranslateDataType = "SmallInt        "
		Case 056 TranslateDataType = "Int             "
		Case 058 TranslateDataType = "SmallDatetime   "
		Case 059 TranslateDataType = "Real            "
		Case 060 TranslateDataType = "Money           "
		Case 061 TranslateDataType = "Datetime        "
		Case 062 TranslateDataType = "Float           "
		Case 098 TranslateDataType = "Sql_Variant     "
		Case 099 TranslateDataType = "nText           "
		Case 104 TranslateDataType = "Bit             "
		Case 106 TranslateDataType = "Decimal         "
		Case 108 TranslateDataType = "Numeric         "
		Case 122 TranslateDataType = "SmallMoney      "
		Case 127 TranslateDataType = "BigInt          "
		Case 165 TranslateDataType = "VarBinary       "
		Case 167 TranslateDataType = "VarChar         "
		Case 173 TranslateDataType = "Binary          "
		Case 175 TranslateDataType = "Char            "
		Case 189 TranslateDataType = "Timestamp       "
		Case 231 TranslateDataType = "nVarChar        "
		Case 231 TranslateDataType = "SysName         "
		Case 239 TranslateDataType = "nChar           "
		Case 241 TranslateDataType = "Xml             "
		Case Else  TranslateDataType = "Unknown Datatype"
	End Select

End Function

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

Private Sub DataDump(oFile,iTableIndex,asTables,asFields)

	Dim iFieldCount,iFieldIndex,sFieldName,sFieldType,sFieldStatus,sFieldClass,sFieldTypeX,iPad

	iPad = GetLongestFieldName(iTableIndex,asTables,asFields)

	iFieldCount = asTables(iTableIndex,1)

	oFile.WriteLine("") 
	oFile.WriteLine(vbTab & "'" & String(30,"-"))

	For iFieldIndex = 0 To iFieldCount-1

		sFieldName   = Left(asFields(iTableIndex,iFieldIndex,0) & Space(iPad), iPad)
		sFieldType   = asFields(iTableIndex,iFieldIndex,1)
		sFieldStatus = asFields(iTableIndex,iFieldIndex,2)
		sFieldClass  = asFields(iTableIndex,iFieldIndex,3)
		sFieldTypeX  = TranslateDataType(sFieldType)

		oFile.WriteLine(vbTab & "'" & sFieldName & " - " & sFieldClass  & " - " & sFieldTypeX & " - " & sFieldType & " - " & sFieldStatus)

	Next

	oFile.WriteLine(vbTab & "'" & String(30,"-"))
	oFile.WriteLine("")

End Sub

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

Private Function GetParamUpdate(iTableIndex,asTables,asFields)

	'This generates the parameter list for an Update

	Dim iFieldCount, iFieldIndex, sFieldName, sFieldType, sFieldStatus, sFieldClass, sParam, bSuppress

	sParam = ""
	iFieldCount = asTables(iTableIndex,1)

	For iFieldIndex = 0 To iFieldCount-1

		sFieldName = asFields(iTableIndex,iFieldIndex,0)
		sFieldType = asFields(iTableIndex,iFieldIndex,1)
		sFieldStatus = asFields(iTableIndex,iFieldIndex,2)
		sFieldClass  = asFields(iTableIndex,iFieldIndex,3)

		bSuppress = False

		If sFieldClass = "x" Then
			'Field type not handled
			bSuppress = True
		End If

		If NOT bSuppress Then
			sParam = sParam & sFieldClass & sFieldName & ","
		End If

	Next

	'Remove comma on last parameter
	sParam = Left(sParam,Len(sParam)-1)

	GetParamUpdate = sParam

End Function

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

Private Function GetParamAdd(iTableIndex,asTables,asFields)

	Dim iFieldCount, iFieldIndex, sFieldName, sFieldType, sFieldStatus, sFieldClass, sParam, bSuppress

	sParam = ""

	iFieldCount = asTables(iTableIndex,1)

	For iFieldIndex = 0 To iFieldCount-1

		sFieldName   = asFields(iTableIndex,iFieldIndex,0)
		sFieldType   = asFields(iTableIndex,iFieldIndex,1)
		sFieldStatus = asFields(iTableIndex,iFieldIndex,2)
		sFieldClass  = asFields(iTableIndex,iFieldIndex,3)

		bSuppress = False

		If (sFieldType = 56) And (sFieldStatus = 128) Then
			'Identity field
			bSuppress = True
		End If

		If sFieldClass = "x" Then
			'Field type not handled
			bSuppress = True
		End If

		If NOT bSuppress Then
			sParam = sParam & sFieldClass & sFieldName & ","
		End If

	Next

	'Remove comma from last parameter
	sParam = Left(sParam,Len(sParam)-1)

	GetParamAdd = sParam

End Function

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