clsvbtableclass.cls

VB代码生成器

            If I <> 0 Then
               If Right(strTemp, 1) <> "(" Then
                  strTemp = strTemp & ","
               End If
            End If
            
            Select Case strHeadInfo
               Case "dtm"
                  strTemp = strTemp & """ & strSymbol " & vbCrLf & Space(9) & "mstrSQL = mstrSQL & Format(." & strHeadInfo & strColummName & ", ""yyyy-mm-dd hh:nn:ss"") & strSymbol & """
               Case "str"
                  strTemp = strTemp & "'"" " & vbCrLf & Space(9) & "mstrSQL = mstrSQL & ." & strHeadInfo & strColummName & " & ""'"
               Case "lng", "int", "byt", "bln", "dbl", "sng"
                  strTemp = strTemp & """ " & vbCrLf & Space(9) & "mstrSQL = mstrSQL & CStr(." & strHeadInfo & strColummName & ") & """
               Case Else '"var"
                  strTemp = strTemp & "'"" " & vbCrLf & Space(9) & "mstrSQL = mstrSQL & ." & strHeadInfo & strColummName & " & ""'"
            End Select
'            If I = lngCount - 1 Then
'               strTemp = strTemp & ")""" & vbCrLf
'            Else
'               strTemp = strTemp & ","
'            End If
         End If
      Next I
      strTemp = strTemp & ")""" & vbCrLf
      strTemp = strTemp & Space(6) & "End With" & vbCrLf
      
         strTemp = strTemp & Space(6) & "If Not mobjQDatabase.QExecuteQuery(MSTR_DATABASENAME, mstrSQL, rlngErrNum, rstrErrDescr) Then" & vbCrLf
            strTemp = strTemp & Space(9) & "Err.Raise rlngErrNum, , rstrErrDescr" & vbCrLf
         strTemp = strTemp & Space(6) & "End If" & vbCrLf
      strTemp = strTemp & Space(3) & "End If" & vbCrLf & vbCrLf
   
      strTemp = strTemp & Space(3) & "QAddNew = True" & vbCrLf & vbCrLf
   
      strTemp = strTemp & Space(3) & "Err.Clear" & vbCrLf
   strTemp = strTemp & "QAddNewErr:" & vbCrLf
      strTemp = strTemp & Space(3) & "rlngErrNum = Err.Number" & vbCrLf
      strTemp = strTemp & Space(3) & "rstrErrDescr = Err.Description" & vbCrLf
   strTemp = strTemp & "End Function" & vbCrLf & vbCrLf

   CreateQAddNew = strTemp
End Function

Private Function CreateGetResults(ByVal vstrProjectName As String, _
                                 ByRef objTable As Table) As String
   Dim strTemp As String
   Dim strTableName As String
   strTableName = objTable.Name
   
   strTemp = ""
   strTemp = strTemp & "Private Function GetResults() As typ" & strTableName & "()" & vbCrLf
   strTemp = strTemp & Space(3) & "Dim arrudt" & strTableName & "() As typ" & strTableName & vbCrLf
   strTemp = strTemp & Space(3) & "Dim I As Long" & vbCrLf
   strTemp = strTemp & Space(3) & "Dim lngErrNum As Long, strErrDescr As String" & vbCrLf & vbCrLf
   
   strTemp = strTemp & Space(3) & "If mlngRecordCount > 0 Then" & vbCrLf
      strTemp = strTemp & Space(6) & "ReDim arrudt" & strTableName & "(mlngRecordCount - 1)" & vbCrLf
      strTemp = strTemp & Space(6) & "If Not QMoveFirst(arrudt" & strTableName & "(0), lngErrNum, strErrDescr) Then" & vbCrLf
         strTemp = strTemp & Space(9) & "Err.Raise lngErrNum, , strErrDescr" & vbCrLf
      strTemp = strTemp & Space(6) & "End If" & vbCrLf
      strTemp = strTemp & Space(6) & "For I = 1 To mlngRecordCount - 1" & vbCrLf
         strTemp = strTemp & Space(9) & "If Not QMoveNext(arrudt" & strTableName & "(I), lngErrNum, strErrDescr) Then" & vbCrLf
            strTemp = strTemp & Space(12) & "Err.Raise lngErrNum, , strErrDescr" & vbCrLf
         strTemp = strTemp & Space(9) & "End If" & vbCrLf
      strTemp = strTemp & Space(6) & "Next I" & vbCrLf
   strTemp = strTemp & Space(3) & "End If" & vbCrLf & vbCrLf
   
   strTemp = strTemp & Space(3) & "GetResults = arrudt" & strTableName & vbCrLf
   strTemp = strTemp & "End Function" & vbCrLf & vbCrLf
   
   CreateGetResults = strTemp
End Function

Private Function CreateQGetAll(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 QGetAll(Optional ByRef rlngErrNum As Long = 0, _" & vbCrLf
   strTemp = strTemp & "                        Optional ByRef rstrErrDescr As String = """") As Boolean" & vbCrLf
   strTemp = strTemp & "   Dim blnRet As Boolean" & vbCrLf & vbCrLf
   
   strTemp = strTemp & "   mlngRecordCount = -1" & vbCrLf
   strTemp = strTemp & "   mstrSQL = ""Select * From "" & MSTR_TABLENAME" & vbCrLf
   strTemp = strTemp & "   blnRet = mobjQDatabase.QOpenRecordSet(MSTR_DATABASENAME, mstrSQL, mrst, rlngErrNum, rstrErrDescr)" & vbCrLf
   strTemp = strTemp & "   If blnRet Then" & vbCrLf
   strTemp = strTemp & "      mstrSQL = ""GetAll""" & vbCrLf
   strTemp = strTemp & "      mlngRecordCount = mrst.RecordCount" & vbCrLf
   strTemp = strTemp & "   End If" & vbCrLf
   strTemp = strTemp & "   QGetAll = blnRet" & vbCrLf
   strTemp = strTemp & "End Function" & vbCrLf & vbCrLf
   
   strTemp = strTemp & "Public Function QGetAlls(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 & "   On Error GoTo QGetAllsErr" & vbCrLf
   strTemp = strTemp & "   QGetAlls = False" & vbCrLf & vbCrLf
   
   strTemp = strTemp & "   If mstrSQL <> ""GetAll"" Then" & vbCrLf
   strTemp = strTemp & "      If Not QGetAll(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 & "   QGetAlls = True" & vbCrLf & vbCrLf
   
   strTemp = strTemp & "   Err.Clear" & vbCrLf
   strTemp = strTemp & "QGetAllsErr:" & vbCrLf
   strTemp = strTemp & "   rlngErrNum = Err.Number" & vbCrLf
   strTemp = strTemp & "   rstrErrDescr = Err.Description" & vbCrLf
   strTemp = strTemp & "End Function" & vbCrLf & vbCrLf
   
   CreateQGetAll = strTemp
End Function

'Private Function CreateQGetBySN(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 QGetBySN(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 & "   Dim blnRet As Boolean" & vbCrLf & vbCrLf
'
'   strTemp = strTemp & "   mlngRecordCount = -1" & vbCrLf
'   strTemp = strTemp & "   mstrSQL = ""Select * From "" & MSTR_TABLENAME & _" & vbCrLf
'   strTemp = strTemp & "            "" Where " & strTableName & "SN='"" & vstrSN & ""' Order By " & strTableName & "ID ASC" & 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
'   strTemp = strTemp & "   QGetBySN = blnRet" & vbCrLf
'   strTemp = strTemp & "End Function" & vbCrLf & vbCrLf
'
'   CreateQGetBySN = strTemp
'End Function

Private Function CreateQGetByField(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 QGetByField(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
   strTemp = strTemp & "   Dim blnRet As Boolean" & vbCrLf & vbCrLf

   strTemp = strTemp & "   mlngRecordCount = -1" & vbCrLf & vbCrLf

   strTemp = strTemp & "   TranceferSymbo vvarFieldValue, strSymbol, strFieldValue" & vbCrLf
   strTemp = strTemp & "   mstrSQL = ""Select * From "" & MSTR_TABLENAME & _" & vbCrLf
   strTemp = strTemp & "            "" Where "" & vstrFieldName & ""="" & strSymbol & strFieldValue & strSymbol" & 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 & "   QGetByField = blnRet" & vbCrLf
   strTemp = strTemp & "End Function" & vbCrLf & vbCrLf
   
   strTemp = strTemp & "Public Function QGetByFields(ByVal vstrFieldName As String, _" & vbCrLf
   strTemp = strTemp & "                           ByVal vvarFieldValue As Variant, _" & 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 & "   Dim strSymbol As String, strFieldValue As String" & vbCrLf
   strTemp = strTemp & "   On Error GoTo QGetByFieldsErr" & vbCrLf
   strTemp = strTemp & "   QGetByFields = False" & vbCrLf & vbCrLf
   
   strTemp = strTemp & "   TranceferSymbo vvarFieldValue, strSymbol, strFieldValue" & vbCrLf
   strTemp = strTemp & "   strSQL = ""Select * From "" & MSTR_TABLENAME & _" & vbCrLf
   strTemp = strTemp & "            "" Where "" & vstrFieldName & ""="" & strSymbol & strFieldValue & strSymbol" & vbCrLf & vbCrLf
   
   strTemp = strTemp & "   If mstrSQL <> strSQL Then" & vbCrLf
   strTemp = strTemp & "      If Not QGetByField(vstrFieldName, vvarFieldValue, 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 & "   QGetByFields = True" & vbCrLf
   strTemp = strTemp & "   Err.Clear" & vbCrLf
   strTemp = strTemp & "QGetByFieldsErr:" & vbCrLf
   strTemp = strTemp & "   rlngErrNum = Err.Number" & vbCrLf
   strTemp = strTemp & "   rstrErrDescr = Err.Description" & vbCrLf
   strTemp = strTemp & "End Function" & vbCrLf & vbCrLf
   
   CreateQGetByField = strTemp
End Function

Private Function CreateQGetBySQL(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 QGetBySQL(ByVal vstrSQL 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 & "   blnRet = mobjQDatabase.QOpenRecordSet(MSTR_DATABASENAME, vstrSQL, mrst, rlngErrNum, rstrErrDescr)" & vbCrLf
   strTemp = strTemp & "   If blnRet Then" & vbCrLf
   strTemp = strTemp & "      mstrSQL = vstrSQL" & vbCrLf
   strTemp = strTemp & "      mlngRecordCount = mrst.RecordCount" & vbCrLf
   strTemp = strTemp & "   End If" & vbCrLf & vbCrLf

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

   strTemp = strTemp & "Public Function QGetBySQLs(ByVal vstrSQL As String, _" & vbCrLf
   strTemp = strTemp & "                           ByRef rarrudt" & strTableName & "() As typ" & strTableName & ", _" & vbCrLf
   strTemp = strTemp & "                           Optional ByRef rlngErrNum As Long = 0, _" & vbCrLf