Automating QTP Test Automation Home Automation Articles Downloads QTP Gotchas Links Books Contact About Site Map
Automate - SQL - Sql Server 2000 - V1.2If you find an error, or have a suggestion for improvement, Email me and I'll fix it. This code generates a function library containing SQL code for manipulating the Sql-Server 2000 database you point it at. This code has been designed for Sql-Server 2000, it might work with later versions of Sql-Server, but I haven't tried it. To function correctly, this generator must be supplied with:
The Server name For SAFETY, the generated code has all the SQL Executes commented OUT. YOU MUST review the code before turning the Executes back on.
While this generator only performs READS on a database... The code that is PRODUCED BY this generator CAN DAMAGE YOUR DATA if called incorrectly. DO NOT use this code on a LIVE database. You use this code ENTIRELY at your own risk (see the terms of use). To use, just save this code into a .qfl file, add it to your project and then 'Call GenSql_SqlSvr' to run it. It will ask you various questions and then generate a new .qfl function library file containing the SQL 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 'V1.0 - First Version 'V1.1 - Added ini file processing so app remembers user choices 'V1.2 - Use classes instead '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 sIni, sApp, sSvr, sDbf, sUsr, sPwd, sCon, oCon, sPath, iTableCount, aTables(99,1), aFields(99,99,3) sIni = "c:\Intellipro.ini" 'Hide... Call zGen_PopupMsg("I'm going to hide while I'm doing this...", 2) Call zQTP_MinimizeWindow 'Get a name for the application sApp = GetApp(sIni) 'Get Server sSvr = GetSvr(sIni,sApp) 'Get Database sDbf = GetDbf(sIni,sApp) 'Get User sUsr = GetUsr(sIni,sApp) 'Get Password sPwd = GetPwd(sIni,sApp) 'Get Output Filename sPath = GetPath(sIni,sApp) 'Assemble connection string and try to connect sCon = GetCon(sApp,sSvr,sDbf,sUsr,sPwd) 'Get the data from the database Call ProcessDatabase(sCon,iTableCount,aTables,aFields) 'Generate the output Call GenOutput(sApp,sSvr,sDbf,sCon,sPath,iTableCount,aTables,aFields) End Sub '======================================== Sub GenSql_SqlSvrIni(sApp) 'Usage: 'Call GenSql_SqlSvrIni(sAppName) Dim sSvr, sDbf, sUsr, sPwd, sPath, sCon, iTableCount, aTables(99,1), aFields(99,99,3) sSvr = zGen_GetIni("c:\Intellipro.ini", "App_" & sApp, "Svr", "localhost") sDbf = zGen_GetIni("c:\Intellipro.ini", "App_" & sApp, "Dbf", "Northwind") sUsr = zGen_GetIni("c:\Intellipro.ini", "App_" & sApp, "Usr", "sa") sPwd = zGen_GetIni("c:\Intellipro.ini", "App_" & sApp, "Pwd", "password") sPath = zGen_GetIni("c:\Intellipro.ini", "App_" & sApp, "Path", "C:\Program Files\HP\QuickTest Professional\Tests\") sCon = "Driver={SQL Server};Server=" & sSvr & ";Database=" & sDbf & ";Uid=" & sUsr & ";Pwd=" & sPwd & ";" Call ProcessDatabase(sCon,iTableCount,aTables,aFields) Call GenOutput(sApp,sSvr,sDbf,sCon,sPath,iTableCount,aTables,aFields) End Sub '======================================== Private Function GetApp(sIniFile) GetApp = GetIniCombo(sIniFile, "Enter App Name (3 - 4 characters are best)", "Apps", "App") End Function '======================================== Private Function GetSvr(sIni,sApp) Dim sSvr sSvr = zGen_GetIni(sIni, "App_" & sApp, "Svr", "localhost") 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 GetDbf(sIni,sApp) Dim sDbf sDbf = zGen_GetIni(sIni, "App_" & sApp, "Dbf", "Northwind") 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) Dim sUsr sUsr = zGen_GetIni(sIni, "App_" & sApp, "Usr", "sa") 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 sPwd sPwd = zGen_GetIni(sIni, "App_" & sApp, "Pwd", "password") sPwd = Inputbox ("Enter a Password for that user:", "User Input Required", sPwd) If sPwd = "" Then Call ExitTest() End If Call zGen_SetIni(sIni, "App_" & sApp, "Pwd", sPwd) GetPwd = sPwd End Function '======================================== Private Function GetCon(sApp,sSvr,sDbf,sUsr,sPwd) Dim sCon, oCon, iErr, sErr, sMsg Call zGen_PopupMsg("Trying Database Connection...", 2) 'Assemble the connection string (Sql-Server-2000) sCon = "Driver={SQL Server};Server=" & sSvr & ";Database=" & sDbf & ";Uid=" & sUsr & ";Pwd=" & sPwd & ";" 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 If iErr = -2147467259 Then sMsg = "SQL Server does not exist or access denied" ElseIf iErr = -2147217843 Then sMsg = "Login Failed for User - Invalid User name or Password" Else sMsg = cStr(iErr) & " - " & sErr End If Msgbox sMsg, vbCritical, "Database Connection Failed - Aborting:" Call ExitTest() End If oCon.Close Set oCon = Nothing Call zGen_PopupMsg("Database Connected OK...", 2) GetCon = sCon End Function '======================================== Private Function GetPath(sIni,sApp) Dim sPath sPath = "C:\Program Files\HP\QuickTest Professional\Tests\" sPath = zGen_GetIni(sIni, "App_" & sApp, "Path", sPath) sPath = Inputbox ("Please confirm the folder for the generated output files:", "User Input Required", sPath) If sPath = "" Then Call ExitTest() End If If Right(sPath,1) <> "\" Then sPath = sPath & "\" End If 'Check the path exists If Not zFile_FolderExists(sPath) Then Msgbox sPath, vbExclamation, "Path NOT Found - Aborting:" Call ExitTest() End If Call zGen_SetIni(sIni, "App_" & sApp, "Path", sPath) GetPath = sPath End Function '======================================== Sub GenSql_SqlSvrNow(sApp,sFile,sSvr,sDbf,sUsr,sPwd) Dim sCon, iTableCount, asTables(99,1), asFields(99,99,3) sCon = "Driver={SQL Server};Server=" & sSvr & ";Database=" & sDbf & ";Uid=" & sUsr & ";Pwd=" & sPwd & ";" Call ProcessDatabase(sCon,iTableCount,asTables,asFields) Call GenerateOutput(sApp,sFile,sCon,sSvr,sDbf,iTableCount,asTables,asFields) End Sub '======================================== Private Function ProcessDatabase(sCon,iTableCount,asTables,asFields) Dim oCon Set oCon = CreateObject("adodb.connection") oCon.Open sCon iTableCount = GetDatabaseTables(oCon,asTables) Call GetDatabaseFields(oCon,iTableCount,asTables,asFields) oCon.Close Set oCon = Nothing Call ProcessArray(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 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 Sub zGen_PopupMsg(sMsg, iDelay) Dim oShell If iDelay = 0 Then Msgbox sMsg Else Set oShell = CreateObject("Wscript.Shell") oShell.Popup sMsg, iDelay, "" Set oShell = Nothing End If End Sub '======================================== Private Sub zQTP_MinimizeWindow Dim oApp 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 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 Sub GenOutput(sApp,sSvr,sDbf,sCon,sPath,iTableCount,aTables,aFields) 'Process each table Dim iTableIndex For iTableIndex = 0 to iTableCount-1 Call GenOutputTable(sApp,sSvr,sDbf,sCon,sPath,iTableIndex,aTables,aFields) Next End Sub '======================================== Private Sub GenOutputTable(sApp,sSvr,sDbf,sCon,sPath,iTableIndex,aTables,aFields) Dim sFileName, sTableName, sTableNameF, iFieldCount, oFso, oFile Const ForWriting = 2, TristateTrue = -1 Dim sParam, iLineCount, iFieldIndex, sFieldName, sFieldType, sFieldStatus, sFieldClass, sQ, bQ Dim sClassName, iRet, bProcessFile sTableName = aTables(iTableIndex,0) sTableNameF = GetFunctionSafeTableName(sTableName) iFieldCount = aTables(iTableIndex,1) sFileName = sPath & "App_" & sApp & "_Sql_" & sTableNameF & ".qfl" sClassName = "App_" & sApp & "_Sql_" & sTableNameF bProcessFile = False 'Detect and warn if file exists already If zFile_Exists(sFileName) Then iRet = MsgBox(sFileName,vbExclamation+vbYesNo+vbDefaultButton2,"Warning - File Exists - Overwrite?") If iRet= 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(sFileName, ForWriting, True, TristateTrue) 'Write header oFile.WriteLine("Option Explicit") oFile.WriteLine("") oFile.WriteLine("'Database SQL Functions") oFile.WriteLine("") oFile.WriteLine("'For App : " & sApp) oFile.WriteLine("'For Server : " & sSvr) oFile.WriteLine("'For Database : " & sDbf) oFile.WriteLine("'For Table : " & sTableName) oFile.WriteLine("") oFile.WriteLine("'Automatically Generated by the Intellipro SQL Sql-Server 2000 Code Generator") oFile.WriteLine("") oFile.WriteLine("'The database connection and memory variables persist for the lifetime of the class") oFile.WriteLine("") oFile.WriteLine("'" & String(40,"=")) oFile.WriteLine("") oFile.WriteLine(vbTab & "Dim oCon") oFile.WriteLine("") 'Generate data structure storage area Call GenDim(oFile,iTableIndex,aTables,aFields) oFile.WriteLine("") oFile.WriteLine("'" & String(40,"/")) oFile.WriteLine("") oFile.WriteLine("Class " & sClassName) oFile.WriteLine("") oFile.WriteLine("'" & String(40,"\")) oFile.WriteLine("") Call GenInit(oFile, sCon) Call GenTerm(oFile) Call GenAdd(oFile,iTableIndex,aTables,aFields) Call GenGet(oFile,iTableIndex,aTables,aFields) Call GenUpd(oFile,iTableIndex,aTables,aFields) Call GenDel(oFile,iTableIndex,aTables,aFields) Call GenExi(oFile,iTableIndex,aTables,aFields) Call GenLets(oFile,iTableIndex,aTables,aFields) Call GenGets(oFile,iTableIndex,aTables,aFields) Call GenFunc(oFile) oFile.WriteLine("'" & String(40,"/")) oFile.WriteLine("") oFile.WriteLine("End Class '" & sClassName) oFile.WriteLine("") oFile.WriteLine("'" & String(40,"\")) oFile.WriteLine("") 'Footer oFile.WriteLine("") oFile.WriteLine("'" & String(40,"#")) oFile.Close End If End Sub '======================================== Sub GenInit(oFile, sCon) oFile.WriteLine("Private Sub Class_Initialize") oFile.WriteLine(vbTab & "'Print " & Chr(34) & "<<< Initialize >>>" & Chr(34)) oFile.WriteLine("") oFile.WriteLine(vbTab & "'This code gets executed automatically when the class object is created") oFile.WriteLine("") oFile.WriteLine(vbTab & "Set oCon=CreateObject(" & Chr(34) & "ADODB.Connection" & Chr(34) & ")") oFile.WriteLine("") oFile.WriteLine(vbTab & "oCon.Open " & Chr(34) & sCon & Chr(34)) oFile.WriteLine("") oFile.WriteLine(vbTab & "'Print " & Chr(34) & ">>> Initialize <<<" & Chr(34)) oFile.WriteLine("End Sub") oFile.WriteLine("") oFile.WriteLine("'" & String(40,"=")) oFile.WriteLine("") End Sub '======================================== Sub GenTerm(oFile) oFile.WriteLine("Private Sub Class_Terminate") oFile.WriteLine(vbTab & "'Print " & Chr(34) & "<<< Terminate >>>" & Chr(34)) oFile.WriteLine("") oFile.WriteLine(vbTab & "'This code gets executed automatically when the class object is destroyed (set to nothing)") oFile.WriteLine("") oFile.WriteLine(vbTab & "oCon.Close") oFile.WriteLine("") oFile.WriteLine(vbTab & "Set oCon = Nothing") oFile.WriteLine("") oFile.WriteLine(vbTab & "'Print " & Chr(34) & ">>> Terminate <<<" & Chr(34)) oFile.WriteLine("End Sub") oFile.WriteLine("") oFile.WriteLine("'" & String(40,"=")) oFile.WriteLine("") End Sub '======================================== Sub GenDim(oFile,iTableIndex,aTables,aFields) Dim iFieldCount, iFieldIndex, sFieldName, sFieldType, sFieldStatus, sFieldClass, iPad, sFieldTypeX iFieldCount = aTables(iTableIndex,1) iPad = GetLongestFieldName(iTableIndex,aTables,aFields) For iFieldIndex = 0 to iFieldCount-1 sFieldName = aFields(iTableIndex,iFieldIndex,0) sFieldType = aFields(iTableIndex,iFieldIndex,1) sFieldStatus = aFields(iTableIndex,iFieldIndex,2) sFieldClass = aFields(iTableIndex,iFieldIndex,3) sFieldTypeX = TranslateDataType(sFieldType) oFile.WriteLine(vbTab & "Dim " & Left(sFieldClass & sFieldName & Space(iPad+5),iPad+5) & "'" & sFieldTypeX) Next End Sub '======================================== Sub GenLets(oFile,iTableIndex,aTables,aFields) Dim iFieldCount, iFieldIndex, sFieldName, sFieldType, sFieldStatus, sFieldClass iFieldCount = aTables(iTableIndex,1) For iFieldIndex = 0 to iFieldCount-1 sFieldName = aFields(iTableIndex,iFieldIndex,0) sFieldType = aFields(iTableIndex,iFieldIndex,1) sFieldStatus = aFields(iTableIndex,iFieldIndex,2) sFieldClass = aFields(iTableIndex,iFieldIndex,3) oFile.WriteLine("Public Property Let " & sFieldName & "(sValue)") oFile.WriteLine("") oFile.WriteLine(vbTab & sFieldClass & sFieldName & " = zSql_ProtectField(sValue)") oFile.WriteLine("") oFile.WriteLine("End Property") oFile.WriteLine("") oFile.WriteLine("'" & String(40,"~")) oFile.WriteLine("") Next oFile.WriteLine("'" & String(40,"=")) oFile.WriteLine("") End Sub '======================================== Sub GenGets(oFile,iTableIndex,aTables,aFields) Dim iFieldCount, iFieldIndex, sFieldName, sFieldType, sFieldStatus, sFieldClass iFieldCount = aTables(iTableIndex,1) For iFieldIndex = 0 to iFieldCount-1 sFieldName = aFields(iTableIndex,iFieldIndex,0) sFieldType = aFields(iTableIndex,iFieldIndex,1) sFieldStatus = aFields(iTableIndex,iFieldIndex,2) sFieldClass = aFields(iTableIndex,iFieldIndex,3) 'oFile.WriteLine("Public Default Property Get " & sFieldName) oFile.WriteLine("Public Property Get " & sFieldName) oFile.WriteLine("") oFile.WriteLine(vbTab & sFieldName & " = " & sFieldClass & sFieldName) oFile.WriteLine("") oFile.WriteLine("End Property") oFile.WriteLine("") oFile.WriteLine("'" & String(40,"~")) oFile.WriteLine("") Next oFile.WriteLine("'" & String(40,"=")) oFile.WriteLine("") End Sub '======================================== Sub GenExi(oFile,iTableIndex,aTables,aFields) Dim sTableName, iKeyFieldIndex, sKeyFieldName, sKeyFieldClass, sLine sTableName = aTables(iTableIndex,0) iKeyFieldIndex = GetKeyFieldIndex(iTableIndex,aTables, aFields) If iKeyFieldIndex = -1 Then sKeyFieldName = "xxxx" sKeyFieldClass = "x" Else sKeyFieldName = aFields(iTableIndex,iKeyFieldIndex,0) sKeyFieldClass = aFields(iTableIndex,iKeyFieldIndex,3) End If oFile.WriteLine("Public Function [Exists](" & sKeyFieldClass & sKeyFieldName & ")") oFile.WriteLine(vbTab & "'Print " & Chr(34) & "<<< Exists >>>" & Chr(34)) oFile.WriteLine("") oFile.WriteLine(vbTab & "'Checks if an entry exists in the " & sTableName & " table") oFile.WriteLine("") oFile.WriteLine(vbTab & "Dim oRec, sSql") oFile.WriteLine("") oFile.WriteLine(vbTab & "Set oRec=CreateObject(" & Chr(34) & "ADODB.Recordset" & Chr(34) & ")") oFile.WriteLine("") sLine = vbTab & "sSql = " & Chr(34) & "SELECT * FROM " & sTableName & " WHERE " & sKeyFieldName & " = " & Chr(34) & " & cStr(" & sKeyFieldClass & sKeyFieldName & ")" oFile.WriteLine(sLine) oFile.WriteLine("") oFile.WriteLine(vbTab & "oRec.Open sSQL, oCon") oFile.WriteLine("") oFile.WriteLine(vbTab & "If oRec.Eof Then") oFile.WriteLine(vbTab & vbTab & "[Exists] = False") oFile.WriteLine(vbTab & "Else") oFile.WriteLine(vbTab & vbTab & "[Exists] = True") oFile.WriteLine(vbTab & "End If") oFile.WriteLine("") oFile.WriteLine(vbTab & "oRec.Close") oFile.WriteLine("") oFile.WriteLine(vbTab & "Set oRec=Nothing") oFile.WriteLine("") oFile.WriteLine(vbTab & "'Print " & Chr(34) & ">>> Exists <<<" & Chr(34)) oFile.WriteLine("End Function") oFile.WriteLine("") oFile.WriteLine("'" & String(40,"=")) oFile.WriteLine("") End Sub '======================================== Sub GenDel(oFile,iTableIndex,aTables,aFields) Dim sTableName, iKeyFieldIndex, sKeyFieldName, sKeyFieldClass, sLine, sQ sQ = Chr(34) sTableName = aTables(iTableIndex,0) iKeyFieldIndex = GetKeyFieldIndex(iTableIndex,aTables, aFields) If iKeyFieldIndex = -1 Then sKeyFieldName = "xxxx" sKeyFieldClass = "x" Else sKeyFieldName = aFields(iTableIndex,iKeyFieldIndex,0) sKeyFieldClass = aFields(iTableIndex,iKeyFieldIndex,3) End If oFile.WriteLine("Public Sub [Delete](" & sKeyFieldClass & sKeyFieldName & ")") oFile.WriteLine(vbTab & "'Print " & sQ & "<<< Delete >>>" & sQ) oFile.WriteLine("") oFile.WriteLine(vbTab & "'Deletes an entry from the " & sTableName & " table") oFile.WriteLine("") oFile.WriteLine(vbTab & "Dim sSql") oFile.WriteLine("") sLine = vbTab & "sSql = " & sQ & "DELETE FROM " & sTableName & " WHERE " & sKeyFieldName & " = " & sQ & " & cStr(" & sKeyFieldClass & sKeyFieldName & ")" oFile.WriteLine(sLine) 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: Delete " & sTableName & sQ) oFile.WriteLine("") oFile.WriteLine(vbTab & "'oCon.Execute sSql") oFile.WriteLine("") oFile.WriteLine(vbTab & "'#############################") oFile.WriteLine("") oFile.WriteLine("") oFile.WriteLine(vbTab & "'Print " & sQ & ">>> Delete <<<" & sQ) oFile.WriteLine("End Sub") oFile.WriteLine("") oFile.WriteLine("'" & String(40,"=")) oFile.WriteLine("") End Sub '======================================== Sub GenAdd(oFile,iTableIndex,aTables,aFields) Dim sTableName, sQ, iLineCount, iFieldIndex, iFieldCount, bQ Dim sFieldName, sFieldType, sFieldStatus, sFieldClass sQ = Chr(34) sTableName = aTables(iTableIndex,0) iFieldCount = aTables(iTableIndex,1) oFile.WriteLine("Public Function [Add]") oFile.WriteLine(vbTab & "'Print " & sQ & "<<< Add >>>" & sQ) oFile.WriteLine("") oFile.WriteLine(vbTab & "'Adds an entry to the " & sTableName & " table") oFile.WriteLine("") oFile.WriteLine(vbTab & "Dim sSql, oRec, 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 = aFields(iTableIndex,iFieldIndex,0) sFieldType = aFields(iTableIndex,iFieldIndex,1) sFieldStatus = aFields(iTableIndex,iFieldIndex,2) sFieldClass = aFields(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 = aFields(iTableIndex,iFieldIndex,0) sFieldType = aFields(iTableIndex,iFieldIndex,1) sFieldStatus = aFields(iTableIndex,iFieldIndex,2) sFieldClass = aFields(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 oRec = CreateObject(" & sQ & "ADODB.Recordset" & 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: Add " & sTableName & 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 & "Set oRec = Nothing") oFile.WriteLine("") oFile.WriteLine( vbTab & "[Add] = lIdentity") oFile.WriteLine("") oFile.WriteLine(vbTab & "'Print " & sQ & ">>> Add <<<" & sQ) oFile.WriteLine("End Function") oFile.WriteLine("") oFile.WriteLine("'" & String(40,"=")) oFile.WriteLine("") End Sub '======================================== Sub GenGet(oFile,iTableIndex,aTables,aFields) Dim sTableName, sQ, iKeyFieldIndex, sKeyFieldName, sKeyFieldClass, iFieldCount, iFieldIndex Dim sFieldName, sFieldType, sFieldStatus, sFieldClass, iPad, sLine sQ = Chr(34) sTableName = aTables(iTableIndex,0) iFieldCount = aTables(iTableIndex,1) iPad = GetLongestFieldName(iTableIndex,aTables,aFields) iKeyFieldIndex = GetKeyFieldIndex(iTableIndex,aTables, aFields) If iKeyFieldIndex = -1 Then sKeyFieldName = "Xxxx" sKeyFieldClass = "x" Else sKeyFieldName = aFields(iTableIndex,iKeyFieldIndex,0) sKeyFieldClass = aFields(iTableIndex,iKeyFieldIndex,3) End If oFile.WriteLine("Public Function [Get](" & sKeyFieldClass & sKeyFieldName & ")") oFile.WriteLine(vbTab & "'Print " & sQ & "<<< Get >>>" & sQ) oFile.WriteLine("") oFile.WriteLine(vbTab & "'Get an entry from the " & sTableName & " table") oFile.WriteLine("") oFile.WriteLine(vbTab & "Dim 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 oRec = CreateObject(" & sQ & "ADODB.Recordset" & sQ & ")") oFile.WriteLine("") oFile.WriteLine(vbTab & "oRec.Open sSQL, oCon") oFile.WriteLine("") oFile.WriteLine(vbTab & "If oRec.Eof Then") oFile.WriteLine(vbTab & vbTab & "[Get] = False") oFile.WriteLine("") oFile.WriteLine(vbTab & "Else") oFile.WriteLine(vbTab & vbTab & "[Get] = True") oFile.WriteLine("") oFile.WriteLine(vbTab & vbTab & "oRec.MoveFirst") oFile.WriteLine("") 'Database Fields For iFieldIndex = 0 to iFieldCount-1 sFieldName = aFields(iTableIndex,iFieldIndex,0) sFieldType = aFields(iTableIndex,iFieldIndex,1) sFieldStatus = aFields(iTableIndex,iFieldIndex,2) sFieldClass = aFields(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) & " = zSql_ProtectNull(" & Chr(34) & sFieldClass & Chr(34) & ",oRec.Fields(" & sQ & sFieldName & sQ & "))" 'Else 'sLine = vbTab & vbTab & Left(sFieldClass & sFieldName & Space(iPad+2),iPad+2) & " = zSql_ProtectNull(" & "oRec.Fields(" & sQ & sFieldName & sQ & "))" 'End If oFile.WriteLine(sLine) End If Next oFile.WriteLine("") oFile.WriteLine(vbTab & "End If") oFile.WriteLine("") oFile.WriteLine(vbTab & "Set oRec = Nothing") oFile.WriteLine("") oFile.WriteLine(vbTab & "'Print " & sQ & ">>> Get <<<" & sQ) oFile.WriteLine("End Function") oFile.WriteLine("") oFile.WriteLine("'" & String(40,"=")) oFile.WriteLine("") End Sub '======================================== Sub GenUpd(oFile,iTableIndex,aTables,aFields) Dim sTableName, sQ, iFieldCount, iPad, iKeyFieldIndex, sKeyFieldName, sKeyFieldClass Dim iLineCount, bQ, iFieldIndex, sFieldName, sFieldType, sFieldStatus, sFieldClass, sLine sQ = Chr(34) sTableName = aTables(iTableIndex,0) iFieldCount = aTables(iTableIndex,1) iPad = GetLongestFieldName(iTableIndex,aTables,aFields) iKeyFieldIndex = GetKeyFieldIndex(iTableIndex,aTables, aFields) If iKeyFieldIndex = -1 Then sKeyFieldName = "Xxxx" sKeyFieldClass = "x" Else sKeyFieldName = aFields(iTableIndex,iKeyFieldIndex,0) sKeyFieldClass = aFields(iTableIndex,iKeyFieldIndex,3) End If oFile.WriteLine("Public Sub [Update](" & sKeyFieldClass & sKeyFieldName & ")") oFile.WriteLine(vbTab & "'Print " & sQ & "<<< Update >>>" & sQ) oFile.WriteLine("") oFile.WriteLine(vbTab & "'Update an entry in the " & sTableName & " table") oFile.WriteLine("") oFile.WriteLine(vbTab & "Dim sSql") oFile.WriteLine("") 'Create the SQL for the Update 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 = aFields(iTableIndex,iFieldIndex,0) sFieldType = aFields(iTableIndex,iFieldIndex,1) sFieldStatus = aFields(iTableIndex,iFieldIndex,2) sFieldClass = aFields(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 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: Update " & sTableName & sQ) oFile.WriteLine("") oFile.WriteLine(vbTab & "'oCon.Execute sSql") oFile.WriteLine("") oFile.WriteLine(vbTab & "'#############################") oFile.WriteLine("") oFile.WriteLine(vbTab & "'Print " & sQ & ">>> Update <<<" & sQ) oFile.WriteLine("End Sub") oFile.WriteLine("") oFile.WriteLine("'" & String(40,"=")) oFile.WriteLine("") End Sub '=========================================================== Sub GenFunc(oFile) oFile.WriteLine("Private Function zSql_ProtectField(sInput)") oFile.WriteLine("") oFile.WriteLine(vbTab & "'Remove apostrophes - they're illegal in sql queries") oFile.WriteLine("") oFile.WriteLine(vbTab & "zSql_ProtectField = Replace(sInput, " & Chr(34) & "'" & Chr(34) & ", " & Chr(34) & "#" & Chr(34) & ")") oFile.WriteLine("") oFile.WriteLine("End Function") oFile.WriteLine("") oFile.WriteLine("'" & String(40,"=")) oFile.WriteLine("") oFile.WriteLine("Private Function zSql_ProtectNull(sType, byVal objField)") oFile.WriteLine("") oFile.WriteLine(vbTab & "If IsNull(objField) Then") oFile.WriteLine(vbTab & vbTab & "Select Case sType") oFile.WriteLine(vbTab & vbTab & vbTab & "Case " & Chr(34) & "i" & Chr(34) & " zSql_ProtectNull = 0") oFile.WriteLine(vbTab & vbTab & vbTab & "Case " & Chr(34) & "m" & Chr(34) & " zSql_ProtectNull = 0") oFile.WriteLine(vbTab & vbTab & vbTab & "Case " & Chr(34) & "d" & Chr(34) & " zSql_ProtectNull = 0") oFile.WriteLine(vbTab & vbTab & vbTab & "Case " & Chr(34) & "Else" & Chr(34) & " zSql_ProtectNull = "& Chr(34)& Chr(34)) oFile.WriteLine(vbTab & vbTab & "End Select") oFile.WriteLine(vbTab & "Else") oFile.WriteLine(vbTab & vbTab & "Select Case sType") oFile.WriteLine(vbTab & vbTab & vbTab & "Case " & Chr(34) & "i" & Chr(34) & " zSql_ProtectNull = cLng(objField)") oFile.WriteLine(vbTab & vbTab & vbTab & "Case " & Chr(34) & "m" & Chr(34) & " zSql_ProtectNull = cCur(objField)") oFile.WriteLine(vbTab & vbTab & vbTab & "Case " & Chr(34) & "d" & Chr(34) & " zSql_ProtectNull = cDate(objField)") oFile.WriteLine(vbTab & vbTab & vbTab & "Case " & Chr(34) & "Else" & Chr(34) & " zSql_ProtectNull = cStr(objField)") oFile.WriteLine(vbTab & vbTab & "End Select") oFile.WriteLine(vbTab & "End If") oFile.WriteLine("") oFile.WriteLine("End Function") oFile.WriteLine("") oFile.WriteLine("'" & String(40,"=")) oFile.WriteLine("") End Sub '======================================== 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 '========================================================================= |