clsvbtableclass.cls

VB代码生成器

   strTemp = strTemp & "                           Optional ByRef rstrErrDescr As String = """") As Boolean" & vbCrLf
   strTemp = strTemp & "   On Error GoTo QGetBySQLsErr" & vbCrLf
   strTemp = strTemp & "   QGetBySQLs = False" & vbCrLf & vbCrLf

   strTemp = strTemp & "   If mstrSQL <> vstrSQL Then" & vbCrLf
   strTemp = strTemp & "      If Not QGetBySQL(vstrSQL, rlngErrNum, rstrErrDescr) Then" & vbCrLf
   strTemp = strTemp & "         Err.Raise rlngErrNum, , rstrErrDescr" & vbCrLf
   strTemp = strTemp & "      End If" & vbCrLf
   strTemp = strTemp & "   End If" & vbCrLf & vbCrLf

   strTemp = strTemp & "   rarrudt" & strTableName & " = GetResults" & vbCrLf & vbCrLf

   strTemp = strTemp & "   QGetBySQLs = True" & vbCrLf
   strTemp = strTemp & "   Err.Clear" & vbCrLf
   strTemp = strTemp & "QGetBySQLsErr:" & vbCrLf
   strTemp = strTemp & "   rlngErrNum = Err.Number" & vbCrLf
   strTemp = strTemp & "   rstrErrDescr = Err.Description" & vbCrLf
   strTemp = strTemp & "End Function" & vbCrLf & vbCrLf
   
   CreateQGetBySQL = strTemp
End Function

Private Function CreateQGetByWhere(ByVal vstrProjectName As String, _
                                 ByRef objTable As Table) As String

   Dim strTemp As String
   Dim strTableName As String
   strTableName = objTable.Name
   
   strTemp = ""
   strTemp = strTemp & "Public Function QGetByWhere(ByVal vstrWhere As String, _" & vbCrLf
   strTemp = strTemp & "                           Optional ByRef rlngErrNum As Long = 0, _" & vbCrLf
   strTemp = strTemp & "                           Optional ByRef rstrErrDescr As String = """") As Boolean" & vbCrLf
   strTemp = strTemp & "   Dim blnRet As Boolean" & vbCrLf
   strTemp = strTemp & "   mlngRecordCount = -1" & vbCrLf & vbCrLf

   strTemp = strTemp & "   mstrSQL = ""Select * From "" & MSTR_TABLENAME & "" "" & vstrWhere" & vbCrLf
   strTemp = strTemp & "   blnRet = mobjQDatabase.QOpenRecordSet(MSTR_DATABASENAME, mstrSQL, mrst, rlngErrNum, rstrErrDescr)" & vbCrLf
   strTemp = strTemp & "   If blnRet Then" & vbCrLf
   strTemp = strTemp & "      mlngRecordCount = mrst.RecordCount" & vbCrLf
   strTemp = strTemp & "   End If" & vbCrLf & vbCrLf

   strTemp = strTemp & "   QGetByWhere = blnRet" & vbCrLf
   strTemp = strTemp & "End Function" & vbCrLf & vbCrLf

   strTemp = strTemp & "Public Function QGetByWheres(ByVal vstrWhere As String, _" & vbCrLf
   strTemp = strTemp & "                           ByRef rarrudt" & strTableName & "() As typ" & strTableName & ", _" & vbCrLf
   strTemp = strTemp & "                           Optional ByRef rlngErrNum As Long = 0, _" & vbCrLf
   strTemp = strTemp & "                           Optional ByRef rstrErrDescr As String = """") As Boolean" & vbCrLf
   strTemp = strTemp & "   Dim strSQL As String" & vbCrLf
   strTemp = strTemp & "   On Error GoTo QGetByWheresErr" & vbCrLf
   strTemp = strTemp & "   QGetByWheres = False" & vbCrLf & vbCrLf

   strTemp = strTemp & "   strSQL = ""Select * From "" & MSTR_TABLENAME & "" "" & vstrWhere" & vbCrLf
   strTemp = strTemp & "   If mstrSQL <> strSQL Then" & vbCrLf
   strTemp = strTemp & "      If Not QGetByWhere(vstrWhere, rlngErrNum, rstrErrDescr) Then" & vbCrLf
   strTemp = strTemp & "         Err.Raise rlngErrNum, , rstrErrDescr" & vbCrLf
   strTemp = strTemp & "      End If" & vbCrLf
   strTemp = strTemp & "   End If" & vbCrLf & vbCrLf

   strTemp = strTemp & "   rarrudt" & strTableName & " = GetResults" & vbCrLf & vbCrLf

   strTemp = strTemp & "   QGetByWheres = True" & vbCrLf
   strTemp = strTemp & "   Err.Clear" & vbCrLf
   strTemp = strTemp & "QGetByWheresErr:" & vbCrLf
   strTemp = strTemp & "   rlngErrNum = Err.Number" & vbCrLf
   strTemp = strTemp & "   rstrErrDescr = Err.Description" & vbCrLf
   strTemp = strTemp & "End Function" & vbCrLf & vbCrLf
   
   CreateQGetByWhere = strTemp
   
End Function

Private Function CreateGetUpdateString(ByVal vstrProjectName As String, _
                                       ByRef objTable As Table) As String

   Dim strTemp As String
   Dim strTableName As String, strHeadInfo As String, strColumnName As String
   Dim strTempSQL As String
   Dim I As Long, lngCount As Long
   strTableName = objTable.Name
   
   strTemp = ""
   strTemp = strTemp & "Private Function GetUpdateString(ByRef udt" & strTableName & " As typ" & strTableName & ")" & vbCrLf
   strTemp = strTemp & "   Dim strSQL As String" & vbCrLf
   strTemp = strTemp & "   Dim strSymbol As String" & vbCrLf
   strTemp = strTemp & "   strSymbol = GetDateSymbo(DatabaseType)" & vbCrLf
   strTemp = strTemp & "   strSQL = ""Update "" & MSTR_TABLENAME & "" Set "" " & vbCrLf

   lngCount = objTable.Columns.Count
   For I = 0 To lngCount - 1
      strColumnName = objTable.Columns.Item(I).Name
      If strColumnName <> mstrAutoIncrement Then
         strHeadInfo = GetColumnTypeInfoHead(objTable.Columns.Item(I))
         Select Case strHeadInfo
            Case "dtm"
               strTempSQL = strTempSQL & Space(3) & "strSQL = strSQL & """ & strColumnName & "="" & strSymbol & Format(udt" & strTableName & "." & strHeadInfo & strColumnName & ", ""yyyy-mm-dd hh:nn:ss"") & strSymbol & """
            Case "str"
               strTempSQL = strTempSQL & Space(3) & "strSQL = strSQL & """ & strColumnName & "='"" & udt" & strTableName & "." & strHeadInfo & strColumnName & " & ""'"
            Case "int", "byt", "bln", "lng", "sng", "dbl"
               strTempSQL = strTempSQL & Space(3) & "strSQL = strSQL & """ & strColumnName & "="" & udt" & strTableName & "." & strHeadInfo & strColumnName & " & """
            Case Else '"var"
               strTempSQL = strTempSQL & Space(3) & "strSQL = strSQL & """ & strColumnName & "='"" & udt" & strTableName & "." & strHeadInfo & strColumnName & " & ""'"
         End Select
         If I = lngCount - 1 Then
            strTempSQL = strTempSQL & """"
         Else
            strTempSQL = strTempSQL & ","""
         End If
         strTempSQL = strTempSQL & vbCrLf
      End If
   Next I
   
   strTemp = strTemp & strTempSQL
   strTemp = strTemp & "   GetUpdateString = strSQL" & vbCrLf
   strTemp = strTemp & "End Function" & vbCrLf & vbCrLf
   
   CreateGetUpdateString = strTemp
End Function

Private Function CreateQUpdateFunction(ByVal vstrProjectName As String, _
                                       ByRef objTable As Table) As String

   Dim strTemp As String
   Dim strTableName As String
   strTableName = objTable.Name
   
   strTemp = ""
'   strTemp = strTemp & "Public Function QUpdateBySN(ByVal vstrSN As String, _" & vbCrLf
'   strTemp = strTemp & "                           ByRef udt" & strTableName & " As typ" & strTableName & ", _" & vbCrLf
'   strTemp = strTemp & "                           Optional ByRef rlngErrNum As Long = 0, _" & vbCrLf
'   strTemp = strTemp & "                           Optional ByRef rstrErrDescr As String = """") As Boolean" & vbCrLf
'   strTemp = strTemp & "   mstrSQL = GetUpdateString(udt" & strTableName & ") & _" & vbCrLf
'   strTemp = strTemp & "       "" Where " & strTableName & "SN='"" & udt" & strTableName & ".str" & strTableName & "SN & ""'""" & vbCrLf
'   strTemp = strTemp & "   QUpdateBySN = mobjQDatabase.QExecuteQuery(MSTR_DATABASENAME, mstrSQL, rlngErrNum, rstrErrDescr)" & vbCrLf
'   strTemp = strTemp & "End Function" & vbCrLf & vbCrLf

   strTemp = strTemp & "Public Function QUpdateByField(ByVal vstrFieldName As String, _" & vbCrLf
   strTemp = strTemp & "                              ByVal vvarFieldValue As Variant, _" & vbCrLf
   strTemp = strTemp & "                              ByRef udt" & strTableName & " As typ" & strTableName & ", _" & vbCrLf
   strTemp = strTemp & "                              Optional ByVal vblnAddNew As Boolean = True, _" & vbCrLf
   strTemp = strTemp & "                              Optional ByRef rlngErrNum As Long = 0, _" & vbCrLf
   strTemp = strTemp & "                              Optional ByRef rstrErrDescr As String = """") As Boolean" & vbCrLf
   strTemp = strTemp & "   Dim strSymbol As String, strFieldValue As String" & vbCrLf & vbCrLf

   strTemp = strTemp & "   If vblnAddNew Then" & vbCrLf
   strTemp = strTemp & "      QUpdateByField = QAddNew(udt" & strTableName & ", vstrFieldName, vvarFieldValue, rlngErrNum, rstrErrDescr)" & vbCrLf
   strTemp = strTemp & "   Else" & vbCrLf
   
   strTemp = strTemp & "      TranceferSymbo vvarFieldValue, strSymbol, strFieldValue" & vbCrLf & vbCrLf

   strTemp = strTemp & "      mstrSQL = GetUpdateString(udt" & strTableName & ") & _" & vbCrLf
   strTemp = strTemp & "               "" Where "" & vstrFieldName & ""="" & strSymbol & strFieldValue & strSymbol" & vbCrLf
   strTemp = strTemp & "      QUpdateByField = mobjQDatabase.QExecuteQuery(MSTR_DATABASENAME, mstrSQL, rlngErrNum, rstrErrDescr)" & vbCrLf
   strTemp = strTemp & "   End If" & vbCrLf
   strTemp = strTemp & "End Function" & vbCrLf & vbCrLf

   strTemp = strTemp & "Public Function QUpdateByWhere(ByVal vstrWhere As String, _" & vbCrLf
   strTemp = strTemp & "                              ByRef udt" & strTableName & " As typ" & strTableName & ", _" & vbCrLf
   strTemp = strTemp & "                              Optional ByRef rlngErrNum As Long = 0, _" & vbCrLf
   strTemp = strTemp & "                              Optional ByRef rstrErrDescr As String = """") As Boolean" & vbCrLf
   strTemp = strTemp & "   mstrSQL = GetUpdateString(udt" & strTableName & ") & vstrWhere" & vbCrLf
   strTemp = strTemp & "   QUpdateByWhere = mobjQDatabase.QExecuteQuery(MSTR_DATABASENAME, mstrSQL, rlngErrNum, rstrErrDescr)" & vbCrLf
   strTemp = strTemp & "End Function" & vbCrLf & vbCrLf

   CreateQUpdateFunction = strTemp
End Function

Private Function CreateQDelFunction(ByVal vstrProjectName As String, _
                                    ByRef objTable As Table) As String

   Dim strTemp As String
   Dim strTableName As String
   strTableName = objTable.Name
   
   strTemp = ""
   strTemp = strTemp & "Public Function QDelAll(Optional ByRef rlngErrNum As Long = 0, _" & vbCrLf
   strTemp = strTemp & "                        Optional ByRef rstrErrDescr As String = """") As Boolean" & vbCrLf
   strTemp = strTemp & "   mstrSQL = ""Delete From "" & MSTR_TABLENAME" & vbCrLf
   strTemp = strTemp & "   QDelAll = mobjQDatabase.QExecuteQuery(MSTR_DATABASENAME, mstrSQL, rlngErrNum, rstrErrDescr)" & vbCrLf
   strTemp = strTemp & "End Function" & vbCrLf & vbCrLf

'   strTemp = strTemp & "Public Function QDelBySN(ByVal vstrSN As String, _" & vbCrLf
'   strTemp = strTemp & "                        Optional ByRef rlngErrNum As Long = 0, _" & vbCrLf
'   strTemp = strTemp & "                        Optional ByRef rstrErrDescr As String = """") As Boolean" & vbCrLf
'   strTemp = strTemp & "   mstrSQL = ""Delete From "" & MSTR_TABLENAME & _" & vbCrLf
'   strTemp = strTemp & "        "" Where " & strTableName & "SN='"" & vstrSN & ""'""" & vbCrLf
'   strTemp = strTemp & "   QDelBySN = mobjQDatabase.QExecuteQuery(MSTR_DATABASENAME, mstrSQL, rlngErrNum, rstrErrDescr)" & vbCrLf
'   strTemp = strTemp & "End Function" & vbCrLf & vbCrLf

   strTemp = strTemp & "Public Function QDelByField(ByVal vstrFieldName As String, _" & vbCrLf
   strTemp = strTemp & "                        ByVal vvarFieldValue As Variant, _" & vbCrLf
   strTemp = strTemp & "                        Optional ByRef rlngErrNum As Long = 0, _" & vbCrLf
   strTemp = strTemp & "                        Optional ByRef rstrErrDescr As String = """") As Boolean" & vbCrLf
   strTemp = strTemp & "   Dim strSymbol As String, strFieldValue As String" & vbCrLf & vbCrLf

   strTemp = strTemp & "   TranceferSymbo vvarFieldValue, strSymbol, strFieldValue" & vbCrLf
   strTemp = strTemp & "   mstrSQL = ""Delete From "" & MSTR_TABLENAME & _" & vbCrLf
   strTemp = strTemp & "        "" Where "" & vstrFieldName & ""="" & strSymbol & strFieldValue & strSymbol" & vbCrLf
   strTemp = strTemp & "   QDelByField = mobjQDatabase.QExecuteQuery(MSTR_DATABASENAME, mstrSQL, rlngErrNum, rstrErrDescr)" & vbCrLf
   strTemp = strTemp & "End Function" & vbCrLf & vbCrLf

   strTemp = strTemp & "Public Function QDelByWhere(ByVal vstrWhere As String, _" & vbCrLf
   strTemp = strTemp & "                        Optional ByRef rlngErrNum As Long = 0, _" & vbCrLf
   strTemp = strTemp & "                        Optional ByRef rstrErrDescr As String = """") As Boolean" & vbCrLf
   strTemp = strTemp & "   mstrSQL = ""Delete From "" & MSTR_TABLENAME & vstrWhere" & vbCrLf
   strTemp = strTemp & "   QDelByWhere = mobjQDatabase.QExecuteQuery(MSTR_DATABASENAME, mstrSQL, rlngErrNum, rstrErrDescr)" & vbCrLf
   strTemp = strTemp & "End Function" & vbCrLf & vbCrLf
   
   CreateQDelFunction = strTemp
End Function

Private Function CreateGetResult(ByVal vstrProjectName As String, _
                                    ByRef objTable As Table) As String

   Dim strTemp As String
   Dim strTableName As String, strColumnName As String, strHeadInfo As String
   Dim I As Long, lngCount As Long
   Dim strDefaultValue As String
   strTableName = objTable.Name
   
   strTemp = ""
   strTemp = strTemp & "Private Function GetResult() As typ" & strTableName & vbCrLf
   strTemp = strTemp & "   Dim udt" & strTableName & " As typ" & strTableName & vbCrLf
   strTemp = strTemp & "   With udt" & strTableName & vbCrLf

   lngCount = objTable.Columns.Count
   For I = 0 To lngCount - 1
      strColumnName = objTable.Columns.Item(I).Name
      strHeadInfo = GetColumnTypeInfoHead(objTable.Columns.Item(I))