home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 4_2005-2006.ISO / data / Zips / SQL_Genera1975452222006.psc / modMain.bas < prev   
BASIC Source File  |  2005-11-21  |  64KB  |  1,418 lines
  1. Attribute VB_Name = "modMain"
  2. Option Explicit
  3. Option Base 0
  4. Option Compare Text
  5.  
  6. '
  7. 'SQL Code Generator
  8. '
  9. 'This program requests an input file, which must be an XML schema file, and
  10. 'which must contain a schema definition of one or more database tables.
  11. 'The schema will be read into the tables of this program, and used, along
  12. 'with a template code file, to generate a VB code module with routines that
  13. 'are capable of performing SQL operations on the above tables.
  14. '
  15. Private Enum enumQueryLine
  16.     OrderByField = 1
  17.     QueryField = 2
  18.     QueryFieldFixed = 3
  19.     SetField = 4
  20.     SetFieldFixed = 5
  21.     Conjunction = 6
  22.     Parenthesis = 7
  23. End Enum
  24.  
  25. Private Enum enumQueryType
  26.     DeleteQuery = 1
  27.     SelectQuery = 2
  28.     SetQuery = 3
  29.     UpdateQuery = 4
  30. End Enum
  31.  
  32. Private Type typConnection
  33.     strName As String
  34. End Type
  35. Public g_recConnection() As typConnection
  36.  
  37. Private Type typTable
  38.     strNameExternal As String
  39.     strNameInternal As String
  40.     strConnection As String
  41.     intFieldCount As Integer
  42.     intFieldPtr As Integer
  43.     intBuffers As Integer
  44.     blnCreateTable As Boolean
  45.     blnNoAdd As Boolean
  46.     blnNoModify As Boolean
  47.     blnNoDelete As Boolean
  48. End Type
  49. Public g_recTable() As typTable
  50.  
  51. Private Type typField
  52.     strNameExternal As String
  53.     strNameInternal As String
  54.     strType As String
  55.     strTypeADO As String
  56.     blnAutoKey As Boolean
  57.     blnIndex As Boolean
  58.     blnPrimary As Boolean
  59.     blnUnique As Boolean
  60.     lngLength As Long
  61. End Type
  62. Public g_recField() As typField
  63.  
  64. Private Type typQuery
  65.     intQueryType As Integer
  66.     strQueryName As String
  67.     strQueryConnection As String
  68.     strQueryTableExternal As String
  69.     strQueryTableInternal As String
  70.     intQueryTableBuffer As Integer
  71.     intQueryLineCount As Integer
  72.     intQueryLinePtr As Integer
  73. End Type
  74. Public g_recQuery() As typQuery
  75.  
  76. Private Type typQueryLine
  77.     intQueryLineType As Integer
  78.     lngFieldLength As Long
  79.     strFieldName As String
  80.     strFieldType As String
  81.     strFieldValue As String
  82.     strFormat As String
  83.     strOperator As String
  84. End Type
  85. Public g_recQueryLine() As typQueryLine
  86.  
  87. Public Const enumInsertConnectionName As String = "connectionname"
  88. Public Const enumInsertFieldAdoType As String = "fieldadotype"
  89. Public Const enumInsertFieldAutoKey As String = "fieldautokey"
  90. Public Const enumInsertFieldClear As String = "fieldclear"
  91. Public Const enumInsertFieldComma As String = "fieldcomma"
  92. Public Const enumInsertFieldIndex As String = "fieldindex"
  93. Public Const enumInsertFieldLength As String = "fieldlength"
  94. Public Const enumInsertFieldNameExternal As String = "fieldnameexternal"
  95. Public Const enumInsertFieldNameInternal As String = "fieldnameinternal"
  96. Public Const enumInsertFieldPrimary As String = "fieldprimary"
  97. Public Const enumInsertFieldType As String = "fieldtype"
  98. Public Const enumInsertFieldTypeActual As String = "fieldtypeactual"
  99. Public Const enumInsertFieldUnique As String = "fieldunique"
  100. Public Const enumInsertOutputName As String = "outputname"
  101. Public Const enumInsertQueryConnection As String = "queryconnection"
  102. Public Const enumInsertQueryBufferID As String = "querybufferid"
  103. Public Const enumInsertQueryName As String = "queryname"
  104. Public Const enumInsertQueryParam As String = "queryparam"
  105. Public Const enumInsertQueryString As String = "querystring"
  106. Public Const enumInsertQueryTableNameExternal As String = "querytablenameexternal"
  107. Public Const enumInsertQueryTableNameInternal As String = "querytablenameinternal"
  108. Public Const enumInsertTableBufferID As String = "tablebufferid"
  109. Public Const enumInsertTableConnection As String = "tableconnection"
  110. Public Const enumInsertTableNameExternal As String = "tablenameexternal"
  111. Public Const enumInsertTableNameExternalLC As String = "tablenameexternallc"
  112. Public Const enumInsertTableNameInternal As String = "tablenameinternal"
  113. Public Const enumInsertTableNameInternalLC As String = "tablenameinternallc"
  114.  
  115. Public Const enumOptionAddnew As String = "addnew"
  116. Public Const enumOptionClear As String = "clear"
  117. Public Const enumOptionCompactRepair As String = "compactrepair"
  118. Public Const enumOptionDelete As String = "delete"
  119. Public Const enumOptionDeleteFrom As String = "deletefrom"
  120. Public Const enumOptionInsert As String = "insert"
  121. Public Const enumOptionParameter As String = "parameter"
  122. Public Const enumOptionRecordCount As String = "recordcount"
  123. Public Const enumOptionSearch As String = "search"
  124. Public Const enumOptionTransaction As String = "transaction"
  125. Public Const enumOptionUpdate As String = "update"
  126. Public Const enumOptionUpdateInto As String = "updateinto"
  127. Public Const enumOptionVB6 As String = "vb6"
  128. Public Const enumOptionVBA As String = "vba"
  129. Public Const enumOptionVBNet As String = "vbnet"
  130.  
  131. Public Const enumSchemaConnection As String = "<connection "
  132. Public Const enumSchemaConnectionEnd As String = "</connection>"
  133. Public Const enumSchemaTable As String = "<table "
  134. Public Const enumSchemaTableEnd As String = "</table>"
  135. Public Const enumSchemaOption As String = "<option "
  136. Public Const enumSchemaOutput As String = "<output "
  137. Public Const enumSchemaQueryConnection As String = "<queryconnection "
  138. Public Const enumSchemaQueryConnectionEnd As String = "</queryconnection>"
  139. Public Const enumSchemaQueryEnd As String = "</query>"
  140. Public Const enumSchemaQueryDelete As String = "<querydelete "
  141. Public Const enumSchemaQuerySelect As String = "<queryselect "
  142. Public Const enumSchemaQuerySet As String = "<queryset "
  143. Public Const enumSchemaQueryUpdate As String = "<queryupdate "
  144. Public Const enumSchemaXML As String = "<?xml "
  145.  
  146. Public Const enumTemplateBuffer As String = "<buffer>"
  147. Public Const enumTemplateBufferEnd As String = "</buffer>"
  148. Public Const enumTemplateConnection As String = "<connection>"
  149. Public Const enumTemplateConnectionEnd As String = "</connection>"
  150. Public Const enumTemplateField As String = "<field>"
  151. Public Const enumTemplateFieldEnd As String = "</field>"
  152. Public Const enumTemplateFieldAutoKey As String = "<fieldautokey>"
  153. Public Const enumTemplateFieldAutoKeyEnd As String = "</fieldautokey>"
  154. Public Const enumTemplateFieldNotAutoKey As String = "<fieldnotautokey>"
  155. Public Const enumTemplateFieldNotAutoKeyEnd As String = "</fieldnotautokey>"
  156. Public Const enumTemplateFieldType As String = "<fieldtype>"
  157. Public Const enumTemplateFieldTypeEnd As String = "</fieldtype>"
  158. Public Const enumTemplateLogic As String = "<logic>"
  159. Public Const enumTemplateLogicEnd As String = "</logic>"
  160. Public Const enumTemplateOption As String = "<option>"
  161. Public Const enumTemplateOptionEnd As String = "</option>"
  162. Public Const enumTemplateQueryDelete As String = "<querydelete>"
  163. Public Const enumTemplateQueryDeleteEnd As String = "</querydelete>"
  164. Public Const enumTemplateQuerySelect As String = "<queryselect>"
  165. Public Const enumTemplateQuerySelectEnd As String = "</queryselect>"
  166. Public Const enumTemplateQuerySet As String = "<queryset>"
  167. Public Const enumTemplateQuerySetEnd As String = "</queryset>"
  168. Public Const enumTemplateQueryUpdate As String = "<queryupdate>"
  169. Public Const enumTemplateQueryUpdateEnd As String = "</queryupdate>"
  170. Public Const enumTemplateTable As String = "<table>"
  171. Public Const enumTemplateTableEnd As String = "</table>"
  172.  
  173. Public g_strModuleFile As String
  174. Public g_strTemplateFile As String
  175. Public g_strXMLFile As String
  176.  
  177. Private m_blnComment As Boolean
  178. Private m_blnProcessLine As Boolean
  179. Private m_blnVBA As Boolean
  180. Private m_blnVBNet As Boolean
  181. Private m_intConnectionCount As Integer
  182. Private m_intConnectionIndex As Integer
  183. Private m_intFieldCount As Integer
  184. Private m_intFieldIndex As Integer
  185. Private m_intFileNoXML As Integer
  186. Private m_intFileNoModule As Integer
  187. Private m_intFileNoTemplate As Integer
  188. Private m_intOptionNested As Integer
  189. Private m_intQueryCount As Integer
  190. Private m_intQueryIndex As Integer
  191. Private m_intQueryLineCount As Integer
  192. Private m_intTableBuffer As Integer
  193. Private m_intTableCount As Integer
  194. Private m_intTableIndex As Integer
  195. Private m_lngCount As Long
  196. Private m_strArray() As String
  197. Private m_strCurrentConnection As String
  198. Private m_strCurrentQueryConnection As String
  199. Private m_strLine As String
  200. Private m_strLines() As String
  201. Private m_strOptionArray() As String
  202.  
  203. Public Sub Main()
  204. '
  205. '   Initialization
  206. '
  207.     Call UtilityInitialize
  208.     frmGenerator.Show
  209. End Sub
  210.  
  211. Public Sub Process()
  212. '
  213. '   Main processing routine
  214. '
  215.     Dim intLineIndex As Integer
  216.     Dim intX As Integer
  217.     Dim strFileName As String
  218.     
  219.     On Error Resume Next
  220.     Err.Clear
  221.     m_intFileNoXML = FreeFile
  222.     Open g_strXMLFile For Input As #m_intFileNoXML
  223.     If Err <> 0 Then
  224.         MsgBox "Unable to open the XML file '" & g_strXMLFile & "'", vbCritical
  225.         End
  226.     End If
  227.     m_intConnectionCount = 0
  228.     m_intTableCount = 0
  229.     m_intFieldCount = 0
  230.     m_strCurrentConnection = ""
  231.     ReDim m_strOptionArray(0)
  232.     
  233.     'Read in the XML schema file
  234.     Do Until EOF(m_intFileNoXML)
  235.         If ProcessSchemaLine Then
  236.             If InStr(LCase$(m_strLine), enumSchemaTable) <> 0 Then
  237.                 Call ProcessSchemaTable
  238.             ElseIf InStr(LCase$(m_strLine), enumSchemaQueryDelete) <> 0 Then
  239.                 Call ProcessSchemaQuery(enumQueryType.DeleteQuery)
  240.             ElseIf InStr(LCase$(m_strLine), enumSchemaQuerySelect) <> 0 Then
  241.                 Call ProcessSchemaQuery(enumQueryType.SelectQuery)
  242.             ElseIf InStr(LCase$(m_strLine), enumSchemaQuerySet) <> 0 Then
  243.                 Call ProcessSchemaQuery(enumQueryType.SetQuery)
  244.             ElseIf InStr(LCase$(m_strLine), enumSchemaQueryUpdate) <> 0 Then
  245.                 Call ProcessSchemaQuery(enumQueryType.UpdateQuery)
  246.             ElseIf InStr(LCase$(m_strLine), enumSchemaQueryConnection) <> 0 Then
  247.                 Call ProcessSchemaQueryConnection
  248.             ElseIf InStr(LCase$(m_strLine), enumSchemaQueryConnectionEnd) <> 0 Then
  249.                 m_strCurrentQueryConnection = ""
  250.             ElseIf InStr(LCase$(m_strLine), enumSchemaConnection) <> 0 Then
  251.                 Call ProcessSchemaConnection
  252.             ElseIf InStr(LCase$(m_strLine), enumSchemaConnectionEnd) <> 0 Then
  253.                 m_strCurrentConnection = ""
  254.             ElseIf InStr(LCase$(m_strLine), enumSchemaOption) <> 0 Then
  255.                 Call ProcessSchemaOption
  256.             ElseIf InStr(LCase$(m_strLine), enumSchemaOutput) <> 0 Then
  257.                 Call ProcessSchemaOutput
  258.             End If
  259.         End If
  260.     Loop
  261.     Close #m_intFileNoXML
  262.     If g_strModuleFile = "" Then
  263.         MsgBox "No '" & enumSchemaOutput & "' statement was included in the schema file to specify the output module name", vbCritical
  264.         End
  265.     End If
  266.     If m_blnVBNet Then
  267.         g_strTemplateFile = SetSlash(App.Path) & "SQLCodeVBNet.txt"
  268.     Else
  269.         g_strTemplateFile = SetSlash(App.Path) & "SQLCodeVB6.txt"
  270.     End If
  271.     If Not FileExists(g_strTemplateFile) Then
  272.         MsgBox "The template file '" & g_strTemplateFile & "' does not exist", vbCritical
  273.         End
  274.     End If
  275.     
  276.     'Load the template file into memory
  277.     m_intFileNoTemplate = FreeFile
  278.     Open g_strTemplateFile For Input As #m_intFileNoTemplate
  279.     If Err.Number <> 0 Then
  280.         MsgBox "Unable to open the template file '" & g_strTemplateFile & "'", vbCritical
  281.         End
  282.     End If
  283.     If m_intConnectionCount = 0 Then
  284.         ReDim Preserve g_recConnection(0)
  285.         g_recConnection(0).strName = ""
  286.         m_intConnectionCount = 1
  287.     End If
  288.     m_blnProcessLine = True
  289.     m_intOptionNested = 0
  290.     ReDim m_strLines(0)
  291.     intLineIndex = 0
  292.     Do Until EOF(m_intFileNoTemplate)
  293.         Line Input #m_intFileNoTemplate, m_strLine
  294.         If InStr(LCase$(m_strLine), enumTemplateOption) <> 0 Then
  295.             If m_blnProcessLine Then
  296.                 m_blnProcessLine = ProcessOutputOption()
  297.             Else
  298.                 m_intOptionNested = m_intOptionNested + 1
  299.             End If
  300.         ElseIf InStr(LCase$(m_strLine), enumTemplateOptionEnd) <> 0 Then
  301.             If m_intOptionNested > 0 Then
  302.                 m_intOptionNested = m_intOptionNested - 1
  303.             Else
  304.                 m_blnProcessLine = True
  305.             End If
  306.         ElseIf m_blnProcessLine Then
  307.             intLineIndex = intLineIndex + 1
  308.             ReDim Preserve m_strLines(intLineIndex)
  309.             m_strLines(intLineIndex - 1) = m_strLine
  310.         End If
  311.     Loop
  312.     Close #m_intFileNoTemplate
  313.     intLineIndex = 0
  314.     
  315.     'Output the module file
  316.     strFileName = SetSlash(GetFilePath(g_strXMLFile)) & g_strModuleFile
  317.     m_intFileNoModule = FreeFile
  318.     Open strFileName For Output As #m_intFileNoModule
  319.     If Err <> 0 Then
  320.         MsgBox "Unable to open the output module file '" & g_strModuleFile & "'", vbCritical
  321.         End
  322.     End If
  323.     Do Until intLineIndex >= UBound(m_strLines)
  324.         m_strLine = m_strLines(intLineIndex)
  325.         If InStr(LCase$(m_strLine), enumTemplateTable) <> 0 Then
  326.             Call ProcessOutputTable(intLineIndex)
  327.             Call ProcessOutputReposition(intLineIndex, enumTemplateTableEnd)
  328.         ElseIf InStr(LCase$(m_strLine), enumTemplateConnection) <> 0 Then
  329.             Call ProcessOutputConnection(intLineIndex)
  330.             Call ProcessOutputReposition(intLineIndex, enumTemplateConnectionEnd)
  331.         ElseIf InStr(LCase$(m_strLine), enumTemplateQueryDelete) <> 0 Then
  332.             Call ProcessOutputQuery(intLineIndex, enumQueryType.DeleteQuery)
  333.             Call ProcessOutputReposition(intLineIndex, enumTemplateQueryDeleteEnd)
  334.         ElseIf InStr(LCase$(m_strLine), enumTemplateQuerySelect) <> 0 Then
  335.             Call ProcessOutputQuery(intLineIndex, enumQueryType.SelectQuery)
  336.             Call ProcessOutputReposition(intLineIndex, enumTemplateQuerySelectEnd)
  337.         ElseIf InStr(LCase$(m_strLine), enumTemplateQuerySet) <> 0 Then
  338.             Call ProcessOutputQuery(intLineIndex, enumQueryType.SetQuery)
  339.             Call ProcessOutputReposition(intLineIndex, enumTemplateQuerySetEnd)
  340.         ElseIf InStr(LCase$(m_strLine), enumTemplateQueryUpdate) <> 0 Then
  341.             Call ProcessOutputQuery(intLineIndex, enumQueryType.UpdateQuery)
  342.             Call ProcessOutputReposition(intLineIndex, enumTemplateQueryUpdateEnd)
  343.         Else
  344.             Call ProcessOutputInsert
  345.             Print #m_intFileNoModule, m_strLine
  346.         End If
  347.         intLineIndex = intLineIndex + 1
  348.     Loop
  349.     Close #m_intFileNoModule
  350.     Err.Clear
  351.     End
  352. End Sub
  353.  
  354. Private Sub ProcessOutputConnection(intLineIndexCurrent As Integer)
  355. '
  356. '   Emits code for a Connection loop
  357. '
  358.     Dim intLineIndex As Integer
  359.     Dim intLineIndexStart As Integer
  360.     
  361.     For m_intConnectionIndex = 0 To m_intConnectionCount - 1
  362.         For intLineIndex = intLineIndexCurrent + 1 To UBound(m_strLines) - 1
  363.             m_strLine = m_strLines(intLineIndex)
  364.             If InStr(LCase$(m_strLine), enumTemplateConnection) <> 0 Then
  365.                 intLineIndexStart = intLineIndex
  366.                 For m_intTableIndex = 0 To m_intTableCount - 1
  367.                     If g_recTable(m_intTableIndex).strConnection = g_recConnection(m_intConnectionIndex).strName Then
  368.                         intLineIndex = intLineIndexStart
  369.                         Do
  370.                             intLineIndex = intLineIndex + 1
  371.                             If intLineIndex >= UBound(m_strLines) Then
  372.                                 MsgBox "A '" & enumTemplateConnectionEnd & "' line is missing from the template file", vbCritical
  373.                                 End
  374.                             End If
  375.                             m_strLine = m_strLines(intLineIndex)
  376.                             If InStr(LCase$(m_strLine), enumTemplateConnectionEnd) <> 0 Then
  377.                                 Exit Do
  378.                             ElseIf InStr(LCase$(m_strLine), enumTemplateField) <> 0 Then
  379.                                 Call ProcessOutputField(intLineIndex)
  380.                                 Call ProcessOutputReposition(intLineIndex, enumTemplateFieldEnd)
  381.                             Else
  382.                                 Call ProcessOutputInsert
  383.                                 Print #m_intFileNoModule, m_strLine
  384.                             End If
  385.                         Loop
  386.                     End If
  387.                 Next
  388.             ElseIf InStr(LCase$(m_strLine), enumTemplateConnectionEnd) <> 0 Then
  389.                 Exit For
  390.             Else
  391.                 Call ProcessOutputInsert
  392.                 Print #m_intFileNoModule, m_strLine
  393.             End If
  394.         Next
  395.     Next
  396. End Sub
  397.  
  398. Private Sub ProcessOutputField(intLineIndexCurrent As Integer)
  399. '
  400. '   Emits code for a field loop
  401. '
  402.     Dim intX As Integer
  403.     Dim intLineIndex As Integer
  404.     
  405.     For m_intFieldIndex = g_recTable(m_intTableIndex).intFieldPtr To g_recTable(m_intTableIndex).intFieldPtr + g_recTable(m_intTableIndex).intFieldCount - 1
  406.         intLineIndex = intLineIndexCurrent
  407.         Do
  408.             intLineIndex = intLineIndex + 1
  409.             If intLineIndex >= UBound(m_strLines) Then
  410.                 MsgBox "A '" & enumTemplateFieldEnd & "' line is missing from the template file", vbCritical
  411.                 End
  412.             End If
  413.             m_strLine = m_strLines(intLineIndex)
  414.             If InStr(LCase$(m_strLine), enumTemplateFieldEnd) <> 0 Then
  415.                 Exit Do
  416.             End If
  417.             If InStr(LCase$(m_strLine), enumTemplateFieldAutoKey) <> 0 Then
  418.                 If Not g_recField(m_intFieldIndex).blnAutoKey Then
  419.                     Call ProcessOutputReposition(intLineIndex, enumTemplateFieldAutoKeyEnd)
  420.                 End If
  421.             ElseIf InStr(LCase$(m_strLine), enumTemplateFieldNotAutoKey) <> 0 Then
  422.                 If g_recField(m_intFieldIndex).blnAutoKey Then
  423.                     Call ProcessOutputReposition(intLineIndex, enumTemplateFieldNotAutoKeyEnd)
  424.                 End If
  425.             ElseIf InStr(LCase$(m_strLine), enumTemplateFieldType) <> 0 Then
  426.                 intX = InStr(LCase$(m_strLine), enumTemplateFieldType)
  427.                 If Not ProcessOutputFieldType(Mid$(m_strLine, intX + Len(enumTemplateFieldType))) Then
  428.                     Call ProcessOutputReposition(intLineIndex, enumTemplateFieldTypeEnd)
  429.                 End If
  430.             ElseIf InStr(LCase$(m_strLine), enumTemplateFieldAutoKeyEnd) = 0 _
  431.                 And InStr(LCase$(m_strLine), enumTemplateFieldNotAutoKeyEnd) = 0 _
  432.                 And InStr(LCase$(m_strLine), enumTemplateFieldTypeEnd) = 0 Then
  433.                 Call ProcessOutputInsert
  434.                 Print #m_intFileNoModule, m_strLine
  435.             End If
  436.         Loop
  437.     Next
  438. End Sub
  439.  
  440. Private Function ProcessOutputFieldType(strLine As String) As Boolean
  441. '
  442. '   Check a field type to see if code should be emitted for it
  443. '
  444.     Dim blnNot As Boolean
  445.     Dim blnResult As Boolean
  446.     Dim intX As Integer
  447.     
  448.     blnNot = False
  449.     blnResult = False
  450.     m_strArray = Split(strLine, " ")
  451.     For intX = 0 To UBound(m_strArray)
  452.         If LCase$(m_strArray(intX)) = "not" Then
  453.             blnNot = True
  454.         Else
  455.             If LCase$(g_recField(m_intFieldIndex).strType) = LCase$(m_strArray(intX)) Then
  456.                 blnResult = True
  457.                 Exit For
  458.             End If
  459.         End If
  460.     Next
  461.     If blnNot Then
  462.         blnResult = Not blnResult
  463.     End If
  464.     ProcessOutputFieldType = blnResult
  465. End Function
  466.  
  467. Private Sub ProcessOutputInsert()
  468. '
  469. '   Checks for insert parameters and replaces them with values
  470. '
  471.     Dim intBegin As Integer
  472.     Dim intEnd As Integer
  473.     Dim intLength As Integer
  474.     Dim intParam As Integer
  475.     Dim intX As Integer
  476.     Dim strOrderBy As String
  477.     Dim strSet As String
  478.     Dim strSetWhereClause As String
  479.     Dim strString As String
  480.     Dim strValue As String
  481.     
  482.     Do
  483.         intBegin = InStr(m_strLine, "[{")
  484.         If intBegin = 0 Then
  485.             Exit Do
  486.         End If
  487.         intEnd = InStr(intBegin, m_strLine, "}]")
  488.         If intEnd = 0 Then
  489.             MsgBox "An '}]' tag is missing from a line in the template file", vbCritical
  490.             End
  491.         End If
  492.         intLength = intEnd - intBegin + 2
  493.         Select Case LCase$(Mid$(m_strLine, intBegin + 2, intLength - 4))
  494.             Case Is = enumInsertConnectionName
  495.                 strValue = g_recConnection(m_intConnectionIndex).strName
  496.             Case Is = enumInsertFieldAdoType
  497.                 strValue = g_recField(m_intFieldIndex).strTypeADO
  498.             Case Is = enumInsertFieldAutoKey
  499.                 strValue = IIf(g_recField(m_intFieldIndex).blnAutoKey, "True", "False")
  500.             Case Is = enumInsertFieldClear
  501.                 Select Case LCase$(g_recField(m_intFieldIndex).strType)
  502.                     Case Is = "boolean"
  503.                         strValue = "False"
  504.                     Case Is = "memo", "string"
  505.                         strValue = """" & """"
  506.                     Case Else
  507.                         strValue = "0"
  508.                 End Select
  509.             Case Is = enumInsertFieldComma
  510.                 If m_intFieldIndex <= g_recTable(m_intTableIndex).intFieldPtr Then
  511.                     strValue = ""
  512.                 Else
  513.                     strValue = ", "
  514.                 End If
  515.             Case Is = enumInsertFieldIndex
  516.                 strValue = IIf(g_recField(m_intFieldIndex).blnIndex, "True", "False")
  517.             Case Is = enumInsertFieldLength
  518.                 strValue = CStr(g_recField(m_intFieldIndex).lngLength)
  519.             Case Is = enumInsertFieldNameExternal
  520.                 strValue = g_recField(m_intFieldIndex).strNameExternal
  521.             Case Is = enumInsertFieldNameInternal
  522.                 strValue = g_recField(m_intFieldIndex).strNameInternal
  523.             Case Is = enumInsertFieldPrimary
  524.                 strValue = IIf(g_recField(m_intFieldIndex).blnPrimary, "True", "False")
  525.             Case Is = enumInsertFieldType
  526.                 strValue = IIf(LCase$(g_recField(m_intFieldIndex).strType) = "memo", "String", g_recField(m_intFieldIndex).strType)
  527.             Case Is = enumInsertFieldTypeActual
  528.                 strValue = g_recField(m_intFieldIndex).strType
  529.             Case Is = enumInsertFieldUnique
  530.                 strValue = IIf(g_recField(m_intFieldIndex).blnUnique, "True", "False")
  531.             Case Is = enumInsertOutputName
  532.                 strValue = GetFileName(g_strModuleFile, True)
  533.             Case Is = enumInsertQueryConnection
  534.                 strValue = g_recQuery(m_intQueryIndex).strQueryConnection
  535.             Case Is = enumInsertQueryBufferID
  536.                 strValue = IIf(g_recQuery(m_intQueryIndex).intQueryTableBuffer <= 1, "", "_" & Format$(g_recQuery(m_intQueryIndex).intQueryTableBuffer))
  537.             Case Is = enumInsertQueryName
  538.                 strValue = g_recQuery(m_intQueryIndex).strQueryName
  539.             Case Is = enumInsertQueryParam
  540.                 intParam = 0
  541.                 strValue = ""
  542.                 For intX = g_recQuery(m_intQueryIndex).intQueryLinePtr To g_recQuery(m_intQueryIndex).intQueryLinePtr + g_recQuery(m_intQueryIndex).intQueryLineCount - 1
  543.                     If g_recQueryLine(intX).intQueryLineType = enumQueryLine.QueryField _
  544.                         Or g_recQueryLine(intX).intQueryLineType = enumQueryLine.SetField Then
  545.                         intParam = intParam + 1
  546.                         strValue = strValue & _
  547.                             IIf(strValue = "", "", ", ") & _
  548.                             g_recQueryLine(intX).strFieldName & "_" & Format$(intParam) & " As " & IIf(LCase$(g_recQueryLine(intX).strFieldType) = "memo", "String", g_recQueryLine(intX).strFieldType)
  549.                     End If
  550.                 Next
  551.                 If strValue <> "" Then
  552.                     strValue = strValue & ", "
  553.                 End If
  554.             Case Is = enumInsertQueryString
  555.                 intParam = 0
  556.                 strOrderBy = ""
  557.                 strSet = ""
  558.                 strValue = ""
  559.                 For intX = g_recQuery(m_intQueryIndex).intQueryLinePtr To g_recQuery(m_intQueryIndex).intQueryLinePtr + g_recQuery(m_intQueryIndex).intQueryLineCount - 1
  560.                     Select Case g_recQueryLine(intX).intQueryLineType
  561.                         Case Is = enumQueryLine.Conjunction, enumQueryLine.Parenthesis
  562.                             strValue = strValue & _
  563.                                 IIf(strValue = "", "", " & _" & vbCrLf & Space$(intBegin - 1)) & _
  564.                                 """ " & _
  565.                                 g_recQueryLine(intX).strFieldName & _
  566.                                 """"
  567.                         Case Is = enumQueryLine.QueryFieldFixed
  568.                             strValue = strValue & _
  569.                                 IIf(strValue = "", "", " & _" & vbCrLf & Space$(intBegin - 1)) & _
  570.                                 """ " & _
  571.                                 g_recQueryLine(intX).strFieldName & _
  572.                                 " " & _
  573.                                 g_recQueryLine(intX).strOperator & _
  574.                                 " " & _
  575.                                 g_recQueryLine(intX).strFieldValue & _
  576.                                 """"
  577.                         Case Is = enumQueryLine.SetFieldFixed
  578.                             strSet = strSet & _
  579.                                 IIf(strSet = "", "", " & "","" & _" & vbCrLf & Space$(intBegin - 1)) & _
  580.                                 """ " & _
  581.                                 g_recQueryLine(intX).strFieldName & _
  582.                                 " " & _
  583.                                 g_recQueryLine(intX).strOperator & _
  584.                                 " " & _
  585.                                 g_recQueryLine(intX).strFieldValue & _
  586.                                 """"
  587.                         Case Is = enumQueryLine.OrderByField
  588.                             strOrderBy = strOrderBy & _
  589.                                 IIf(strOrderBy = "", "", ", ") & _
  590.                                 g_recQueryLine(intX).strFieldName & _
  591.                                 IIf(g_recQueryLine(intX).strFieldValue = "", "", " " & g_recQueryLine(intX).strFieldValue)
  592.                         Case Is = enumQueryLine.QueryField, enumQueryLine.SetField
  593.                             intParam = intParam + 1
  594.                             strString = """ " & _
  595.                                 g_recQueryLine(intX).strFieldName & _
  596.                                 " " & _
  597.                                 g_recQueryLine(intX).strOperator & _
  598.                                 " """ & " & "
  599.                             Select Case g_recQueryLine(intX).strFieldType
  600.                                 Case Is = "Boolean"
  601.                                     strString = strString & _
  602.                                         "IIf(" & g_recQueryLine(intX).strFieldName & _
  603.                                         "_" & CStr(intParam) & _
  604.                                         ", " & """true""" & ", " & """false""" & ")"
  605.                                 Case Is = "Date"
  606.                                     strString = strString & _
  607.                                         "SQLFieldEmitDate(" & _
  608.                                         g_recQueryLine(intX).strFieldName & _
  609.                                         "_" & CStr(intParam) & _
  610.                                         ", g_recConnection" & g_recQuery(m_intQueryIndex).strQueryConnection & ".strDatabaseSystem" & _
  611.                                         ")"
  612.                                 Case Is = "Integer", "Long", "Double", "Single", "Currency"
  613.                                     If g_recQueryLine(intX).strFormat = "" Then
  614.                                         strString = strString & _
  615.                                             "CStr(" & _
  616.                                             g_recQueryLine(intX).strFieldName & _
  617.                                             "_" & Format$(intParam) & _
  618.                                             ")"
  619.                                     Else
  620.                                         strString = strString & _
  621.                                             "Format$(" & _
  622.                                             g_recQueryLine(intX).strFieldName & _
  623.                                             "_" & Format$(intParam) & _
  624.                                             "," & g_recQueryLine(intX).strFormat & _
  625.                                             ")"
  626.                                     End If
  627.                                 Case Is = "String", "Memo"
  628.                                     strString = strString & _
  629.                                         """'""" & _
  630.                                         " & SQLFieldEmitString(" & _
  631.                                         g_recQueryLine(intX).strFieldName & _
  632.                                         "_" & CStr(intParam) & _
  633.                                         ", " & CStr(g_recQueryLine(intX).lngFieldLength) & _
  634.                                         ", " & "g_recConnection" & g_recQuery(m_intQueryIndex).strQueryConnection & ".strEscapeQuote" & _
  635.                                         ") & " & _
  636.                                         """'"""
  637.                             End Select
  638.                             If g_recQueryLine(intX).intQueryLineType = enumQueryLine.SetField Then
  639.                                 strSet = strSet & _
  640.                                     IIf(strSet = "", "", " & "","" & _" & vbCrLf & Space$(intBegin - 1)) & _
  641.                                     strString
  642.                             Else
  643.                                 strValue = strValue & _
  644.                                     IIf(strValue = "", "", " & _" & vbCrLf & Space$(intBegin - 1)) & _
  645.                                     strString
  646.                             End If
  647.                     End Select
  648.                 Next
  649.                 If strOrderBy <> "" Then
  650.                     strValue = strValue & _
  651.                         IIf(strValue = "", "", " & _" & vbCrLf & Space$(intBegin - 1)) & _
  652.                         """" & _
  653.                         " ORDER BY " & strOrderBy & _
  654.                         """"
  655.                 ElseIf strSet <> "" Then
  656.                     strSetWhereClause = strValue
  657.                     strValue = """" & _
  658.                         " UPDATE " & _
  659.                         g_recQuery(m_intQueryIndex).strQueryTableExternal & _
  660.                         " SET" & """" & " & _" & vbCrLf & Space$(intBegin - 1) & _
  661.                         strSet
  662.                         If strSetWhereClause <> "" Then
  663.                             strValue = strValue & _
  664.                                 " & _" & vbCrLf & _
  665.                                 Space$(intBegin - 1) & """" & _
  666.                                 " WHERE" & _
  667.                                 """" & " & _" & vbCrLf & Space$(intBegin - 1) & _
  668.                                 strSetWhereClause
  669.                         End If
  670.                 End If
  671.             Case Is = enumInsertQueryTableNameExternal
  672.                 strValue = g_recQuery(m_intQueryIndex).strQueryTableExternal
  673.             Case Is = enumInsertQueryTableNameInternal
  674.                 strValue = g_recQuery(m_intQueryIndex).strQueryTableInternal
  675.             Case Is = enumInsertTableBufferID
  676.                 strValue = IIf(m_intTableBuffer <= 1, "", "_" & Format$(m_intTableBuffer))
  677.             Case Is = enumInsertTableConnection
  678.                 strValue = g_recTable(m_intTableIndex).strConnection
  679.             Case Is = enumInsertTableNameExternal
  680.                 strValue = g_recTable(m_intTableIndex).strNameExternal
  681.             Case Is = enumInsertTableNameExternalLC
  682.                 strValue = LCase$(g_recTable(m_intTableIndex).strNameExternal)
  683.             Case Is = enumInsertTableNameInternal
  684.                 strValue = g_recTable(m_intTableIndex).strNameInternal
  685.             Case Is = enumInsertTableNameInternalLC
  686.                 strValue = LCase$(g_recTable(m_intTableIndex).strNameInternal)
  687.             Case Else
  688.                 MsgBox "An invalid insert tag was detected in the template file - '" & Mid$(m_strLine, intBegin, intLength) & "'", vbCritical
  689.                 End
  690.         End Select
  691.         m_strLine = Left$(m_strLine, intBegin - 1) & strValue & Mid$(m_strLine, intBegin + intLength)
  692.     Loop
  693. End Sub
  694.  
  695. Private Function ProcessOutputOption() As Boolean
  696. '
  697. '   Determine if code will be included
  698. '
  699.     Dim blnNot As Boolean
  700.     Dim blnResult As Boolean
  701.     Dim intX As Integer
  702.     Dim intY As Integer
  703.         
  704.     blnResult = False
  705.     blnNot = False
  706.     intX = InStr(LCase$(m_strLine), enumTemplateOption)
  707.     If intX <> 0 Then
  708.         m_strArray = Split(LCase$(Mid$(m_strLine, intX + Len(enumSchemaOption))), " ")
  709.         For intY = 0 To UBound(m_strArray)
  710.             If m_strArray(intY) = "not" Then
  711.                 blnNot = True
  712.             Else
  713.                 For intX = 0 To UBound(m_strOptionArray) - 1
  714.                     If LCase$(m_strOptionArray(intX)) = m_strArray(intY) Then
  715.                         If Not blnNot Then
  716.                             blnResult = True
  717.                         End If
  718.                         Exit For
  719.                     End If
  720.                 Next
  721.                 If blnNot And intX >= UBound(m_strOptionArray) Then
  722.                     blnResult = Not blnResult
  723.                 End If
  724.                 blnNot = False
  725.             End If
  726.         Next
  727.     End If
  728.     ProcessOutputOption = blnResult
  729. End Function
  730.  
  731. Private Sub ProcessOutputReposition(intLineIndex As Integer, strEndKey As String)
  732. '
  733. '   Move through the memory version of the template file contents
  734. '
  735.     Do Until intLineIndex >= UBound(m_strLines)
  736.         If InStr(LCase$(m_strLines(intLineIndex)), strEndKey) <> 0 Then
  737.             Exit Do
  738.         End If
  739.         intLineIndex = intLineIndex + 1
  740.     Loop
  741.     If intLineIndex >= UBound(m_strLines) Then
  742.         MsgBox "A '" & strEndKey & "' line was not found in the template file", vbCritical
  743.         End
  744.     End If
  745. End Sub
  746.  
  747. Private Sub ProcessOutputQuery(intLineIndexCurrent As Integer, intQueryType As Integer)
  748. '
  749. '   Emits code for a series of queries
  750. '
  751.     Dim intLineIndex As Integer
  752.     Dim intLineIndexStart As Integer
  753.     Dim intX As Integer
  754.     Dim strIO As String
  755.     
  756.     For m_intQueryIndex = 0 To m_intQueryCount - 1
  757.         If g_recQuery(m_intQueryIndex).intQueryType = intQueryType Then
  758.             For intLineIndex = intLineIndexCurrent + 1 To UBound(m_strLines) - 1
  759.                 m_strLine = m_strLines(intLineIndex)
  760.                 If InStr(LCase$(m_strLine), enumTemplateQueryDeleteEnd) <> 0 _
  761.                     Or InStr(LCase$(m_strLine), enumTemplateQuerySelectEnd) <> 0 _
  762.                     Or InStr(LCase$(m_strLine), enumTemplateQuerySetEnd) <> 0 _
  763.                     Or InStr(LCase$(m_strLine), enumTemplateQueryUpdateEnd) <> 0 Then
  764.                     Exit For
  765.                 End If
  766.                 Call ProcessOutputInsert
  767.                 Print #m_intFileNoModule, m_strLine
  768.             Next
  769.         End If
  770.     Next
  771. End Sub
  772.  
  773. Private Sub ProcessOutputTable(intLineIndexCurrent As Integer)
  774. '
  775. '   Emits code for a table loop
  776. '
  777.     Dim intLineIndex As Integer
  778.     Dim intLineIndexStart As Integer
  779.     Dim intX As Integer
  780.     Dim strIO As String
  781.     Dim strLine As String
  782.     
  783.     For m_intTableIndex = 0 To m_intTableCount - 1
  784.         For intLineIndex = intLineIndexCurrent + 1 To UBound(m_strLines) - 1
  785.             m_strLine = m_strLines(intLineIndex)
  786.             If InStr(LCase$(m_strLine), enumTemplateLogic) <> 0 Then
  787.                 intX = InStr(LCase$(m_strLine), enumTemplateLogic)
  788.                 strIO = LCase$(Trim$(Mid$(m_strLine, intX + Len(enumTemplateLogic))))
  789.                 If (strIO = "add" And g_recTable(m_intTableIndex).blnNoAdd) _
  790.                     Or (strIO = "modify" And g_recTable(m_intTableIndex).blnNoModify) _
  791.                     Or (strIO = "addmodify" And g_recTable(m_intTableIndex).blnNoAdd And g_recTable(m_intTableIndex).blnNoModify) _
  792.                     Or (strIO = "delete" And g_recTable(m_intTableIndex).blnNoDelete) _
  793.                     Or (strIO = "create" And Not g_recTable(m_intTableIndex).blnCreateTable) Then
  794.                     Do
  795.                         intLineIndex = intLineIndex + 1
  796.                         If intLineIndex >= UBound(m_strLines) Then
  797.                             MsgBox "A '" & enumTemplateLogicEnd & "' line is missing from the template file", vbCritical
  798.                             End
  799.                         End If
  800.                         m_strLine = m_strLines(intLineIndex)
  801.                         If InStr(LCase$(m_strLine), enumTemplateLogicEnd) <> 0 Then
  802.                             Exit Do
  803.                         End If
  804.                     Loop
  805.                 End If
  806.             ElseIf InStr(LCase$(m_strLine), enumTemplateBuffer) <> 0 Then
  807.                 intLineIndexStart = intLineIndex
  808.                 For m_intTableBuffer = 1 To g_recTable(m_intTableIndex).intBuffers
  809.                     intLineIndex = intLineIndexStart
  810.                     Do
  811.                         intLineIndex = intLineIndex + 1
  812.                         If intLineIndex >= UBound(m_strLines) Then
  813.                             MsgBox "A '" & enumTemplateBufferEnd & "' line is missing from the template file", vbCritical
  814.                             End
  815.                         End If
  816.                         m_strLine = m_strLines(intLineIndex)
  817.                         If InStr(LCase$(m_strLine), enumTemplateBufferEnd) <> 0 Then
  818.                             Exit Do
  819.                         End If
  820.                         If InStr(LCase$(m_strLine), enumTemplateField) <> 0 Then
  821.                             Call ProcessOutputField(intLineIndex)
  822.                             Call ProcessOutputReposition(intLineIndex, enumTemplateFieldEnd)
  823.                         Else
  824.                             Call ProcessOutputInsert
  825.                             Print #m_intFileNoModule, m_strLine
  826.                         End If
  827.                     Loop
  828.                 Next
  829.             ElseIf InStr(LCase$(m_strLine), enumTemplateField) <> 0 Then
  830.                 Call ProcessOutputField(intLineIndex)
  831.                 Call ProcessOutputReposition(intLineIndex, enumTemplateFieldEnd)
  832.             ElseIf InStr(LCase$(m_strLine), enumTemplateLogicEnd) <> 0 Then
  833.             ElseIf InStr(LCase$(m_strLine), enumTemplateTableEnd) <> 0 Then
  834.                 Exit For
  835.             Else
  836.                 Call ProcessOutputInsert
  837.                 Print #m_intFileNoModule, m_strLine
  838.             End If
  839.         Next
  840.     Next
  841. End Sub
  842.  
  843. Private Sub ProcessSchemaConnection()
  844.     '
  845.     '   Scans and parses a Connection definition
  846.     '
  847.     Dim intX As Integer
  848.     Dim strLine As String
  849.         
  850.     intX = InStr(LCase$(m_strLine), enumSchemaConnection)
  851.     If intX > 0 Then
  852.         strLine = Trim$(Mid$(m_strLine, intX + Len(enumSchemaConnection)))
  853.         If Right$(strLine, 1) = ">" Then
  854.             strLine = Left$(strLine, Len(strLine) - 1)
  855.         End If
  856.         If strLine = "" Then
  857.             Call ProcessSchemaError("Connection line contains no connection name value")
  858.         End If
  859.         m_strArray = Split(strLine, " ")
  860.         m_strCurrentConnection = m_strArray(0)
  861.     Else
  862.         Exit Sub
  863.     End If
  864.     For intX = 1 To Len(m_strCurrentConnection)
  865.         If InStr("abcdefghijklmnopqrstuvwxyz0123456789_", LCase$(Mid$(m_strCurrentConnection, intX, 1))) = 0 Then
  866.             Mid$(m_strCurrentConnection, intX, 1) = "_"
  867.         End If
  868.     Next
  869.     ReDim Preserve g_recConnection(m_intConnectionCount + 1)
  870.     g_recConnection(m_intConnectionCount).strName = m_strCurrentConnection
  871.     m_intConnectionCount = m_intConnectionCount + 1
  872. End Sub
  873.  
  874. Private Sub ProcessSchemaError(strError As String)
  875. '
  876. '   Display an error message and terminate
  877. '
  878.     MsgBox strError & " at XML schema line# " & CStr(m_lngCount) & vbCrLf & vbCrLf & _
  879.         "The schema line was:" & vbCrLf & m_strLine, vbCritical
  880.     End
  881. End Sub
  882.  
  883. Private Function ProcessSchemaLine() As Boolean
  884. '
  885. '   Read and pre-process a line read from the schema file
  886. '
  887.     Dim blnProcess As Boolean
  888.     Dim intX As Integer
  889.     
  890.     Line Input #m_intFileNoXML, m_strLine
  891.     m_strLine = Replace(m_strLine, vbTab, " ")
  892.     m_lngCount = m_lngCount + 1
  893.     If InStr(m_strLine, "<!--") <> 0 Then
  894.         m_blnComment = True
  895.     End If
  896.     For intX = 1 To Len(m_strLine)
  897.         If Mid$(m_strLine, intX, 1) <> " " Then
  898.             Exit For
  899.         End If
  900.     Next
  901.     blnProcess = Not m_blnComment
  902.     If blnProcess Then
  903.         If intX > Len(m_strLine) Then
  904.             blnProcess = False
  905.         ElseIf InStr("';", Mid$(m_strLine, intX, 1)) > 0 Then
  906.             blnProcess = False
  907.         End If
  908.     End If
  909.     If m_blnComment Then
  910.         If InStr(m_strLine, "-->") <> 0 Then
  911.             m_blnComment = False
  912.         End If
  913.     End If
  914.     ProcessSchemaLine = blnProcess
  915. End Function
  916.  
  917. Private Function ProcessSchemaField() As Boolean
  918. '
  919. '   Process the field data type value
  920. '
  921.     Dim blnResult As Boolean
  922.     
  923.     blnResult = True
  924.     Select Case LCase$(g_recField(m_intFieldCount).strType)
  925.         Case Is = "boolean"
  926.             g_recField(m_intFieldCount).lngLength = 2
  927.             g_recField(m_intFieldCount).strTypeADO = "adTinyInt"
  928.         Case Is = "byte"
  929.             g_recField(m_intFieldCount).lngLength = 2
  930.             g_recField(m_intFieldCount).strTypeADO = "adByte"
  931.         Case Is = "currency"
  932.             g_recField(m_intFieldCount).lngLength = 16
  933.             g_recField(m_intFieldCount).strTypeADO = "adLongInt"
  934.             If m_blnVBNet Then
  935.                 g_recField(m_intFieldCount).strType = "Long"
  936.             End If
  937.         Case Is = "date"
  938.             g_recField(m_intFieldCount).lngLength = 16
  939.             g_recField(m_intFieldCount).strTypeADO = "adDBTimeStamp"
  940.         Case Is = "double"
  941.             g_recField(m_intFieldCount).lngLength = 16
  942.             g_recField(m_intFieldCount).strTypeADO = "adDouble"
  943.         Case Is = "integer"
  944.             If m_blnVBNet Then
  945.                 g_recField(m_intFieldCount).lngLength = 8
  946.                 g_recField(m_intFieldCount).strTypeADO = "adInteger"
  947.             Else
  948.                 g_recField(m_intFieldCount).lngLength = 4
  949.                 g_recField(m_intFieldCount).strTypeADO = "adSmallInt"
  950.             End If
  951.         Case Is = "int8"
  952.             g_recField(m_intFieldCount).lngLength = 2
  953.             g_recField(m_intFieldCount).strTypeADO = "adTinyInt"
  954.             g_recField(m_intFieldCount).strType = "Byte"
  955.         Case Is = "int16"
  956.             g_recField(m_intFieldCount).lngLength = 4
  957.             g_recField(m_intFieldCount).strTypeADO = "adSmallInt"
  958.             If m_blnVBNet Then
  959.                 g_recField(m_intFieldCount).strType = "Short"
  960.             Else
  961.                 g_recField(m_intFieldCount).strType = "Integer"
  962.             End If
  963.         Case Is = "int32"
  964.             g_recField(m_intFieldCount).lngLength = 8
  965.             g_recField(m_intFieldCount).strTypeADO = "adInteger"
  966.             If m_blnVBNet Then
  967.                 g_recField(m_intFieldCount).strType = "Integer"
  968.             Else
  969.                 g_recField(m_intFieldCount).strType = "Long"
  970.             End If
  971.         Case Is = "int64"
  972.             g_recField(m_intFieldCount).lngLength = 16
  973.             g_recField(m_intFieldCount).strTypeADO = "adLongInt"
  974.             If m_blnVBNet Then
  975.                 g_recField(m_intFieldCount).strType = "Long"
  976.             Else
  977.                 g_recField(m_intFieldCount).strType = "Currency"
  978.             End If
  979.         Case Is = "long"
  980.             If m_blnVBNet Then
  981.                 g_recField(m_intFieldCount).lngLength = 16
  982.                 g_recField(m_intFieldCount).strTypeADO = "adLongInt"
  983.             Else
  984.                 g_recField(m_intFieldCount).lngLength = 8
  985.                 g_recField(m_intFieldCount).strTypeADO = "adInteger"
  986.             End If
  987.         Case Is = "memo"
  988.             g_recField(m_intFieldCount).strTypeADO = "adLongVarChar"
  989.         Case Is = "short"
  990.             g_recField(m_intFieldCount).lngLength = 4
  991.             g_recField(m_intFieldCount).strTypeADO = "adSmallInt"
  992.             If Not m_blnVBNet Then
  993.                 g_recField(m_intFieldCount).strType = "Integer"
  994.             End If
  995.         Case Is = "single"
  996.             g_recField(m_intFieldCount).lngLength = 8
  997.             g_recField(m_intFieldCount).strTypeADO = "adSingle"
  998.         Case Is = "string"
  999.             g_recField(m_intFieldCount).strTypeADO = "adVarChar"
  1000.         Case Else
  1001.             blnResult = False
  1002.     End Select
  1003.     ProcessSchemaField = blnResult
  1004. End Function
  1005.  
  1006. Private Sub ProcessSchemaOption()
  1007. '
  1008. '   Scans and parses the Option line
  1009. '
  1010.     Dim intX As Integer
  1011.     Dim strLine As String
  1012.     Dim strOption As String
  1013.         
  1014.     intX = InStr(LCase$(m_strLine), enumSchemaOption)
  1015.     If intX <> 0 Then
  1016.         strLine = LCase$(Trim$(Mid$(m_strLine, intX + Len(enumSchemaOption))))
  1017.         If Right$(strLine, 1) = ">" Then
  1018.             strLine = Left$(strLine, Len(strLine) - 1)
  1019.         End If
  1020.         m_strArray = Split(strLine, " ")
  1021.         For intX = 0 To UBound(m_strArray)
  1022.             strOption = LCase$(m_strArray(intX))
  1023.             If strOption <> "" Then
  1024.                 If strOption <> enumOptionAddnew _
  1025.                     And strOption <> enumOptionClear _
  1026.                     And strOption <> enumOptionCompactRepair _
  1027.                     And strOption <> enumOptionDelete _
  1028.                     And strOption <> enumOptionDeleteFrom _
  1029.                     And strOption <> enumOptionInsert _
  1030.                     And strOption <> enumOptionParameter _
  1031.                     And strOption <> enumOptionRecordCount _
  1032.                     And strOption <> enumOptionSearch _
  1033.                     And strOption <> enumOptionTransaction _
  1034.                     And strOption <> enumOptionUpdate _
  1035.                     And strOption <> enumOptionUpdateInto _
  1036.                     And strOption <> enumOptionVB6 _
  1037.                     And strOption <> enumOptionVBA _
  1038.                     And strOption <> enumOptionVBNet Then
  1039.                     Call ProcessSchemaError("An invalid keyword was included in the Option statement - " & m_strArray(intX))
  1040.                 End If
  1041.                 If strOption = enumOptionVB6 Then
  1042.                     m_blnVBNet = False
  1043.                 ElseIf strOption = enumOptionVBNet Then
  1044.                     m_blnVBNet = True
  1045.                 Else
  1046.                     ReDim Preserve m_strOptionArray(UBound(m_strOptionArray) + 1)
  1047.                     m_strOptionArray(UBound(m_strOptionArray) - 1) = strOption
  1048.                 End If
  1049.             End If
  1050.         Next
  1051.     End If
  1052. End Sub
  1053.  
  1054. Private Sub ProcessSchemaOutput()
  1055. '
  1056. '   Scans and parses the Output line
  1057. '
  1058.     Dim intX As Integer
  1059.     Dim strLine As String
  1060.         
  1061.     intX = InStr(LCase$(m_strLine), enumSchemaOutput)
  1062.     If intX <> 0 Then
  1063.         strLine = Trim$(Mid$(m_strLine, intX + Len(enumSchemaOption)))
  1064.         If Right$(strLine, 1) = ">" Then
  1065.             strLine = Left$(strLine, Len(strLine) - 1)
  1066.         End If
  1067.         g_strModuleFile = strLine
  1068.     End If
  1069. End Sub
  1070.  
  1071. Private Sub ProcessSchemaQuery(intQueryType As Integer)
  1072. '
  1073. '   Scans and processes a query definition
  1074. '
  1075.     Dim blnOrderBy As Boolean
  1076.     Dim blnSet As Boolean
  1077.     Dim intFieldIndex As Integer
  1078.     Dim intTableIndex As Integer
  1079.     Dim intX As Integer
  1080.     Dim strLine As String
  1081.     Dim strQueryType As String
  1082.         
  1083.     Select Case intQueryType
  1084.         Case Is = enumQueryType.DeleteQuery
  1085.             strQueryType = enumSchemaQueryDelete
  1086.         Case Is = enumQueryType.SelectQuery
  1087.             strQueryType = enumSchemaQuerySelect
  1088.         Case Is = enumQueryType.SetQuery
  1089.             strQueryType = enumSchemaQuerySet
  1090.         Case Is = enumQueryType.UpdateQuery
  1091.             strQueryType = enumSchemaQueryUpdate
  1092.     End Select
  1093.     intX = InStr(LCase$(m_strLine), strQueryType)
  1094.     If intX <> 0 Then
  1095.         strLine = Trim$(Mid$(m_strLine, intX + Len(strQueryType)))
  1096.         If Right$(strLine, 1) = ">" Then
  1097.             strLine = Left$(strLine, Len(strLine) - 1)
  1098.         End If
  1099.         If strLine = "" Then
  1100.             Call ProcessSchemaError("A query line was read from the XML schema file with no following table name")
  1101.         End If
  1102.         ReDim Preserve g_recQuery(m_intQueryCount + 1)
  1103.         m_strArray = Split(strLine, " ")
  1104.         With g_recQuery(m_intQueryCount)
  1105.             If UBound(m_strArray) <= 0 Then
  1106.                 Call ProcessSchemaError("A query line was read with no following query name")
  1107.             End If
  1108.             .intQueryType = intQueryType
  1109.             .strQueryConnection = m_strCurrentQueryConnection
  1110.             .strQueryTableExternal = m_strArray(0)
  1111.             intX = 0
  1112.             Do While intX < UBound(m_strArray)
  1113.                 intX = intX + 1
  1114.                 If m_strArray(intX) <> "" Then
  1115.                     .strQueryName = m_strArray(intX)
  1116.                     Exit Do
  1117.                 End If
  1118.             Loop
  1119.             Do While intX < UBound(m_strArray)
  1120.                 intX = intX + 1
  1121.                 If m_strArray(intX) <> "" Then
  1122.                     If IsNumeric(m_strArray(intX)) Then
  1123.                         .intQueryTableBuffer = CInt(m_strArray(intX))
  1124.                         Exit Do
  1125.                     End If
  1126.                 End If
  1127.             Loop
  1128.             For intTableIndex = 0 To m_intTableCount - 1
  1129.                 If LCase$(.strQueryTableExternal) = LCase$(g_recTable(intTableIndex).strNameExternal) _
  1130.                     And LCase$(.strQueryConnection) = LCase$(g_recTable(intTableIndex).strConnection) Then
  1131.                     Exit For
  1132.                 End If
  1133.             Next
  1134.             If intTableIndex >= m_intTableCount Then
  1135.                 Call ProcessSchemaError("A query line specified a non-existant table - " & .strQueryName & "/" & .strQueryTableExternal)
  1136.             End If
  1137.             If .intQueryTableBuffer < 2 Then
  1138.                 .intQueryTableBuffer = 1
  1139.             End If
  1140.             If .intQueryTableBuffer > g_recTable(intTableIndex).intBuffers Then
  1141.                 Call ProcessSchemaError("A query line specified an invalid table buffer - " & .strQueryName & "/" & .strQueryTableExternal)
  1142.             End If
  1143.             .strQueryTableInternal = g_recTable(intTableIndex).strNameInternal
  1144.             .intQueryLineCount = 0
  1145.             .intQueryLinePtr = m_intQueryLineCount
  1146.             Do Until EOF(m_intFileNoXML)
  1147.                 If ProcessSchemaLine Then
  1148.                     If InStr(LCase$(m_strLine), enumSchemaQueryEnd) Then
  1149.                         Exit Do
  1150.                     End If
  1151.                     strLine = Trim$(m_strLine)
  1152.                     Call ParseStringToArray(strLine, m_strArray, " ")
  1153.                     ReDim Preserve g_recQueryLine(m_intQueryLineCount + 1)
  1154.                     With g_recQueryLine(m_intQueryLineCount)
  1155.                         If m_strArray(0) = "(" Or m_strArray(0) = ")" Then
  1156.                             .intQueryLineType = enumQueryLine.Parenthesis
  1157.                             .strFieldName = m_strArray(0)
  1158.                         ElseIf LCase$(m_strArray(0)) = "and" Or LCase$(m_strArray(0)) = "or" Then
  1159.                             .intQueryLineType = enumQueryLine.Conjunction
  1160.                             .strFieldName = UCase$(m_strArray(0))
  1161.                         ElseIf LCase$(m_strArray(0)) = "orderby" Or LCase$(m_strArray(0)) = "order" Then
  1162.                             If g_recQuery(m_intQueryCount).intQueryType <> enumQueryType.SelectQuery Then
  1163.                                 Call ProcessSchemaError("ORDER BY clause was specified on a non-select query - " & g_recQuery(m_intQueryCount).strQueryName & "/" & g_recQuery(m_intQueryCount).strQueryTableExternal)
  1164.                             Else
  1165.                                 .strFieldName = ""
  1166.                                 blnOrderBy = True
  1167.                             End If
  1168.                         ElseIf LCase$(m_strArray(0)) = "set" Then
  1169.                             If g_recQuery(m_intQueryCount).intQueryType <> enumQueryType.SetQuery Then
  1170.                                 Call ProcessSchemaError("SET clause was specified on a non-set query - " & g_recQuery(m_intQueryCount).strQueryName & "/" & g_recQuery(m_intQueryCount).strQueryTableExternal)
  1171.                             Else
  1172.                                 .strFieldName = ""
  1173.                                 blnSet = True
  1174.                             End If
  1175.                         Else
  1176.                             .strFieldName = m_strArray(0)
  1177.                             If blnOrderBy Then
  1178.                                 .intQueryLineType = enumQueryLine.OrderByField
  1179.                                 If UBound(m_strArray) >= 1 Then
  1180.                                     .strFieldValue = UCase$(m_strArray(1))
  1181.                                 End If
  1182.                             Else
  1183.                                 If UBound(m_strArray) < 2 Then
  1184.                                     Call ProcessSchemaError("Invalid query line configuration in query - " & g_recQuery(m_intQueryCount).strQueryName & "/" & g_recQuery(m_intQueryCount).strQueryTableExternal)
  1185.                                 End If
  1186.                                 .strOperator = m_strArray(1)
  1187.                                 If .strOperator <> "=" _
  1188.                                     And .strOperator <> "<>" _
  1189.                                     And .strOperator <> "!=" _
  1190.                                     And .strOperator <> ">" _
  1191.                                     And .strOperator <> "<" _
  1192.                                     And .strOperator <> ">=" _
  1193.                                     And .strOperator <> "<=" _
  1194.                                     And LCase$(.strOperator) <> "like" Then
  1195.                                     Call ProcessSchemaError("An invalid query line operator was specified on - " & g_recQuery(m_intQueryCount).strQueryName & "/" & g_recQuery(m_intQueryCount).strQueryTableExternal)
  1196.                                 End If
  1197.                                 If m_strArray(2) = "%" Then
  1198.                                     .intQueryLineType = IIf(blnSet, enumQueryLine.SetField, enumQueryLine.QueryField)
  1199.                                     If UBound(m_strArray) >= 3 Then
  1200.                                         For intX = 3 To UBound(m_strArray)
  1201.                                             .strFormat = .strFormat & m_strArray(intX)
  1202.                                         Next
  1203.                                     End If
  1204.                                 ElseIf m_strArray(2) = "" Then
  1205.                                     Call ProcessSchemaError("An invalid query line operand was specified on - " & g_recQuery(m_intQueryCount).strQueryName & "/" & g_recQuery(m_intQueryCount).strQueryTableExternal)
  1206.                                 Else
  1207.                                     .intQueryLineType = IIf(blnSet, enumQueryLine.SetFieldFixed, enumQueryLine.QueryFieldFixed)
  1208.                                     .strFieldValue = m_strArray(2)
  1209.                                 End If
  1210.                             End If
  1211.                             For intFieldIndex = g_recTable(intTableIndex).intFieldPtr To g_recTable(intTableIndex).intFieldPtr + g_recTable(intTableIndex).intFieldCount - 1
  1212.                                 If LCase$(.strFieldName) = LCase$(g_recField(intFieldIndex).strNameExternal) Then
  1213.                                     .lngFieldLength = g_recField(intFieldIndex).lngLength
  1214.                                     .strFieldType = g_recField(intFieldIndex).strType
  1215.                                     Exit For
  1216.                                 End If
  1217.                             Next
  1218.                             If .strFieldType = "" Then
  1219.                                 Call ProcessSchemaError("An invalid query field for a table was specified - " & g_recQuery(m_intQueryCount).strQueryName & "/" & g_recQuery(m_intQueryCount).strQueryTableExternal)
  1220.                             End If
  1221.                         End If
  1222.                     End With
  1223.                     If .intQueryLineCount = 0 Then
  1224.                         .intQueryLinePtr = m_intQueryLineCount
  1225.                     End If
  1226.                     If g_recQueryLine(m_intQueryLineCount).strFieldName <> "" Then
  1227.                         .intQueryLineCount = .intQueryLineCount + 1
  1228.                         m_intQueryLineCount = m_intQueryLineCount + 1
  1229.                     End If
  1230.                 End If
  1231.             Loop
  1232.         End With
  1233.         m_intQueryCount = m_intQueryCount + 1
  1234.     End If
  1235. End Sub
  1236.  
  1237. Private Sub ProcessSchemaQueryConnection()
  1238.     '
  1239.     '   Assigns a series of queries to a connection
  1240.     '
  1241.     Dim intX As Integer
  1242.     Dim strLine As String
  1243.         
  1244.     intX = InStr(LCase$(m_strLine), enumSchemaQueryConnection)
  1245.     If intX > 0 Then
  1246.         strLine = Trim$(Mid$(m_strLine, intX + Len(enumSchemaQueryConnection)))
  1247.         If Right$(strLine, 1) = ">" Then
  1248.             strLine = Left$(strLine, Len(strLine) - 1)
  1249.         End If
  1250.         If strLine = "" Then
  1251.             Call ProcessSchemaError("Query connection line contains no connection name value")
  1252.         End If
  1253.         Call ParseStringToArray(strLine, m_strArray, " ")
  1254.         m_strCurrentQueryConnection = m_strArray(0)
  1255.     Else
  1256.         Exit Sub
  1257.     End If
  1258.     For intX = 1 To Len(m_strCurrentQueryConnection)
  1259.         If InStr("abcdefghijklmnopqrstuvwxyz0123456789_", LCase$(Mid$(m_strCurrentConnection, intX, 1))) = 0 Then
  1260.             Mid$(m_strCurrentQueryConnection, intX, 1) = "_"
  1261.         End If
  1262.     Next
  1263.     For intX = 0 To m_intConnectionCount - 1
  1264.         If LCase$(m_strCurrentQueryConnection) = LCase$(g_recConnection(intX).strName) Then
  1265.             Exit For
  1266.         End If
  1267.     Next
  1268.     If intX >= m_intConnectionCount Then
  1269.         Call ProcessSchemaError("Query connection name was not previously defined - " & m_strCurrentQueryConnection)
  1270.     End If
  1271. End Sub
  1272.  
  1273. Private Sub ProcessSchemaTable()
  1274.     '
  1275.     '   Scans and parses a table definition
  1276.     '
  1277.     Dim blnFound As Boolean
  1278.     Dim intX As Integer
  1279.     Dim strValue As String
  1280.     Dim strLength As String
  1281.     Dim strLine As String
  1282.     
  1283.     intX = InStr(LCase$(m_strLine), enumSchemaTable)
  1284.     ReDim Preserve g_recTable(m_intTableCount + 1)
  1285.     strLine = Trim$(Mid$(m_strLine, intX + Len(enumSchemaTable)))
  1286.     If Right$(strLine, 1) = ">" Then
  1287.         strLine = Left$(strLine, Len(strLine) - 1)
  1288.     End If
  1289.     m_strArray = Split(strLine, " ")
  1290.     If UBound(m_strArray) < 0 Then
  1291.         Call ProcessSchemaError("A '" & enumSchemaTable & "' line was read with no following table name")
  1292.     End If
  1293.     With g_recTable(m_intTableCount)
  1294.         .strConnection = m_strCurrentConnection
  1295.         .strNameExternal = m_strArray(0)
  1296.         .strNameInternal = IIf(m_strCurrentConnection = "", "", m_strCurrentConnection & "_") & m_strArray(0)
  1297.         For intX = 1 To Len(.strNameInternal)
  1298.             If InStr("abcdefghijklmnopqrstuvwxyz0123456789_", LCase$(Mid$(.strNameInternal, intX, 1))) = 0 Then
  1299.                 Mid$(.strNameInternal, intX, 1) = "_"
  1300.             End If
  1301.         Next
  1302.         .intBuffers = 0
  1303.         .blnCreateTable = False
  1304.         .blnNoAdd = False
  1305.         .blnNoModify = False
  1306.         .blnNoDelete = False
  1307.         
  1308.         If UBound(m_strArray) > 0 Then
  1309.             For intX = 1 To UBound(m_strArray)
  1310.                 strValue = LCase$(m_strArray(intX))
  1311.                 Select Case strValuentQueryCount + 1
  1312.     End If
  1313. End Sub
  1314. SchemaError("A '"         And LCase$(.strOperator)Currse$(chemaEr
  1315. End Sub
  1316. SchemaError("A                                  End If   EminnrArro= Left$(slause
  1317.   id$(ub
  1318. Schm_intQuerpppppppppppppppIid$(.stt .blnNoDelete       End If
  1319.         Nextmi+tt .blnNoDelete       End If
  1320.         Nextmi+tt .blnNoDel
  1321.   ir)Currse$(chemaErF        Nextmi!ooix >= UBs(ay = Split(strLine, " ")
  1322.     innpppIid$(.stt .blnNtt .blC= UBs(ay =.blnNoDeletec                          For intFieldIndex = g_recTablg_recConnecti         Select Case strValuenldIndex = g_recTablg_recConoDetldIn     .s
  1323.   Select CfchemaErFFFFFFFFFFFFFine, " ")
  1324.     Iect Case str  Select C intFieldu   m_strAo & m_sTemplat.blnNtt .blC= UBsmi+tt .b And LCaect C intFieo + 1)
  1325.     s+ 1)
  1326.     strLifection()
  1327.     '
  1328.   ty(m_intd     gx+ 1)
  1329.     s+ 1)
  1330.      Iect Case str  Selecm Nextmi!ooix >= UBs(ay = Spsm Nextmi!ooix >=y = Spsm Neid$(.strNamentX + Len(enumSchemaOption)))
  1331.   UoField(d$(.sttrValuenldIndex = gFDeletec          d with n)))
  1332.   UoField("br m_strLiFDaPs Boolean
  1333.   cti   sTemplat.blnNtt .blC= UBsmternal)
  1334.             End If
  1335.   ied an Ntt .bln Ntt .bln Ntt .bln Ntt .bln Ntt .bln Ntt .bln Nbln Ntt .bln Ntt .bline, k   ied an Ntt .bln NttstrFiem id$(eVtion) = LCase$(g_recTable(intTableIndex).
  1336.   ty(m_intd  $(ub
  1337. Schm_intQuerppppppppX, 1) =ke" ThencLCase$(g_relx >= UBs(ay = Spsm   strValue = LCase$(m_strArray(intectQuery Then
  1338.           S ThencLCase$(g_relx >= UBs(ay = Spsm tectQuery Then
  1339.           S ThencLCase$(g_relx >= UBs(ay = Spsm tectQueryase$(g_relx >= UBs(ay = Spsm tectQuer& en= UBs(aaaaaaaaaaaaaaaaaaaoFFFFF To g_recTable(m_intTableIndex      S ThenppX, 1) =al)  1) strValue As String
  1340.     Dim strLength As String
  1341.     Dim strLine As String
  1342.     Then
  1343. cb
  1344. Schm_intQuerppppppppX, 1 g_recTablg_recConoDetldIn  a =al)  1) strValue As String
  1345.     Dim strLength As String
  1346.     Dim strLine As String
  1347.     Then
  1348. cb
  1349. Schm_intQuerppppppppX, 1 g_recTablg_re                   ReDim Preserl
  1350.     Dim strLCIFieldCount).strT           d$(m_strCurrentQueryConnection, seStringToArray(strLine, m_strArray, " ")
  1351.         m_strntQue         End If
  1352.                         g_recFieldf   Next
  1353.     If intX          
  1354.         m_strntQue         En        .intQueryLinePtr = m_intQueryLineCoulllll     AdTheX          
  1355.     
  1356. SchemaErro   Next          oo
  1357.     R          
  1358.         m_strntQue         En        .intQueryL     
  1359.       rt"
  1360.       nyL     
  1361.       rt"
  1362.       ElseIf LCase$intTablC            ection()
  1363.     '
  1364.   ty(m_intd     gx+ 1)
  1365.     s+ 1)
  1366.  seI  Dim" ")
  1367.    trFooArray(trLengtntd     gx+ 1)
  1368.     s+ 1)
  1369.  seI  Dim" ")
  1370.    trFooArray(trLengtn    End If
  1371. End Sub
  1372.  
  1373. Private Sub ProcessSchemaOutput()
  1374. '
  1375. '     m_str rrrrrrrrrrrrrrrrrrrrrd If
  1376. End Sub
  1377.  
  1378. PrivTableIndex).
  1379.   ty(m_intd  $(ub
  1380. SchmDim ).
  1381.   ty(m_inQueryConnectionf pStionf pStionf pStionf pStion       Nextectionf pStionf i,UBound(m_strLines) "
  1382.  
  1383.  
  1384. Private ststrCurrentConnection
  1385.        f intX  
  1386. Pri                            .strFi          f )  f ion           NextsnumQueryLine f )  f ion vstrFieldType = g_recField(inurrentConsinurrentCoonCount + 1
  1387. End Sub
  1388.  
  1389. Private Sub ProcessSchemaError(strError As String)
  1390. '
  1391. '   DisplayeE    Else
  1392.                       rrentQueryC[ g_recFi ")
  1393.    trFooA _
  1394. yurrentCoonCount + 1
  1395. End             Fm ).
  1396.   tL g_reernalLA _
  1397. yurrenta   Fm ).
  1398.   tL g_reernalLA _
  1399. yurrenta   Fm ).
  1400.   tL g_reernalLA tt .blnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnn   nnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnn1) strValue     Fm ).
  1401. 1nnnnnnnnnnnrArray)
  1402.             nBnnnnnnnnnnnnn1) sssssss"
  1403.  
  1404. uble"
  1405.             DisplayeE    Else
  1406.                       rrentQueryC[ g_recFi ")
  1407.    trFooA _
  1408. yurrentCoomInse   f )  f       Arrao     ngtntd     gx+ 1) ngtntd     g .intueryCount).strQueryTableExternal)
  1409.      ight$(strLine, 1) = ">" The_strLine), enumTemplateField) <IError("Querigh).strTypDahaac
  1410.   tx).
  1411.   ty(t).strTErr strTypDahaac
  1412.   tx).
  1413.   ty(t).strTErr strTypy(t).strTErr stU>" The_strLine), enumTemplateField) <IError("Querigh).strTypDahaac
  1414.   tx).
  1415.   ty(t).strTErr strTypDahaac
  1416.   tx).
  1417.   ty(tocessSchemaError(strError As String)
  1418.   tx).ine), enumTemplateField) <IError("Querield) <IError("Q    LindinQueryCfd) <IE <IE <IE <IE