clsvccppfile.cls

VB代码生成器

   Dim strTemp As String
   Dim strTableName As String
   Dim strFuncName As String
   Dim I As Long
   strTableName = objTable.Name

   strTemp = ""
   For I = 0 To 4
      Select Case I
         Case 0
            strFuncName = "First"
         Case 1
            strFuncName = "Last"
         Case 2
            strFuncName = "Next"
         Case 3
            strFuncName = "Previous"
         Case 4
            strFuncName = "To"
      End Select
      If I = 4 Then
         strTemp = strTemp & "BOOL C" & strTableName & "::QMove" & strFuncName & "(long vlngNumRecords, long vlngStart, TYP" & UCase(strTableName) & " &rudt" & strTableName & ")" & vbCrLf
      Else
         strTemp = strTemp & "BOOL C" & strTableName & "::QMove" & strFuncName & "(TYP" & UCase(strTableName) & " &rudt" & strTableName & ")" & vbCrLf
      End If
      strTemp = strTemp & "{" & vbCrLf
         strTemp = strTemp & Space(4) & "try" & vbCrLf
         strTemp = strTemp & Space(4) & "{" & vbCrLf
         If I = 4 Then
            strTemp = strTemp & Space(8) & "mrst->Move(vlngNumRecords, vlngStart);" & vbCrLf
         Else
            strTemp = strTemp & Space(8) & "mrst->Move" & strFuncName & "();" & vbCrLf
         End If
            strTemp = strTemp & Space(8) & "rudt" & strTableName & " = GetResult();" & vbCrLf
            strTemp = strTemp & Space(8) & "return TRUE;" & vbCrLf
         strTemp = strTemp & Space(4) & "}" & vbCrLf
         strTemp = strTemp & Space(4) & "catch (...)" & vbCrLf
         strTemp = strTemp & Space(4) & "{" & vbCrLf
            strTemp = strTemp & Space(8) & "return FALSE;" & vbCrLf
         strTemp = strTemp & Space(4) & "}" & vbCrLf
      strTemp = strTemp & "}" & vbCrLf & vbCrLf
   Next I

   CreateQMove = strTemp
End Function
'
'GetFindSQL 函数
Private Function CreateGetFindSQL(ByRef objTable As Table) As String
   Dim strTemp As String
   Dim strTableName As String
   Dim arrstrFieldTypeName() As String, arrstrHeadInfo() As String
   Dim I As Long, lngCount As Long
   Dim blnBufferDefine As Boolean
   Dim strHeadInfo As String, strColumnName As String

   strTableName = objTable.Name
   arrstrFieldTypeName = GetAllTypeName(objTable, arrstrHeadInfo, False)

   strTemp = "char *C" & strTableName & "::GetFindSQL(const TYP" & UCase(strTableName) & " &udt" & strTableName & ")" & vbCrLf
   strTemp = strTemp & "{" & vbCrLf

      If StringInArr("COleDateTime ", arrstrFieldTypeName) Then
         strTemp = strTemp & Space(4) & "COleDateTime dtm(1900, 5, 8, 0, 0, 0);" & vbCrLf
         strTemp = strTemp & Space(4) & "CString strSymbol;" & vbCrLf
         strTemp = strTemp & Space(4) & "strSymbol = (mintDatabaseType == enuDatabaseType_Access) ? ""#"" : ""'"";" & vbCrLf
      End If

      If StringInArr("int ", arrstrFieldTypeName) Or _
         StringInArr("long ", arrstrFieldTypeName) Or _
         StringInArr("BOOL ", arrstrFieldTypeName) Then
            strTemp = strTemp & Space(4) & "char szBuffer[256];" & vbCrLf
      End If

      strTemp = strTemp & Space(4) & "mstrSQL = ""Select * From EvectionManager Where 1=1"";" & 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"
                  strTemp = strTemp & Space(4) & "if (udt" & strTableName & ".dtm" & strColumnName & " > dtm)" & vbCrLf
                  strTemp = strTemp & Space(4) & "{" & vbCrLf
                     strTemp = strTemp & Space(8) & "mstrSQL += "" And " & strColumnName & " >= "" + strSymbol + udt" & strTableName & ".dtm" & strColumnName & ".Format(""%Y-%m-%d 00:00:00"") + strSymbol;" & vbCrLf
                     strTemp = strTemp & Space(8) & "mstrSQL += "" And " & strColumnName & " <= "" + strSymbol + udt" & strTableName & ".dtm" & strColumnName & ".Format(""%Y-%m-%d 23:59:59"") + strSymbol;" & vbCrLf
                  strTemp = strTemp & Space(4) & "}" & vbCrLf

               Case "lpsz"
                  strTemp = strTemp & Space(4) & "if (strlen(udt" & strTableName & ".lpsz" & strColumnName & ") > 0)" & vbCrLf
                  strTemp = strTemp & Space(4) & "{" & vbCrLf
                     strTemp = strTemp & Space(8) & "mstrSQL += "" And " & strColumnName & " Like '%"" + CString(udt" & strTableName & ".lpsz" & strColumnName & ") + ""%'"";" & vbCrLf
                  strTemp = strTemp & Space(4) & "}" & vbCrLf

               Case "str"
                  strTemp = strTemp & Space(4) & "if (strlen(udt" & strTableName & ".str" & strColumnName & ") > 0)" & vbCrLf
                  strTemp = strTemp & Space(4) & "{" & vbCrLf
                     strTemp = strTemp & Space(8) & "mstrSQL += "" And " & strColumnName & " Like '%"" + udt" & strTableName & ".str" & strColumnName & " + ""%'"";" & vbCrLf
                  strTemp = strTemp & Space(4) & "}" & vbCrLf

               Case "lng"
                  strTemp = strTemp & Space(4) & "if (udt" & strTableName & ".lng" & strColumnName & " != NULL_INT)" & vbCrLf
                  strTemp = strTemp & Space(4) & "{" & vbCrLf
                     strTemp = strTemp & Space(8) & "mstrSQL += "" And " & strColumnName & " = "" + CString(ltoa(udt" & strTableName & ".lng" & strColumnName & ", szBuffer, 10));" & vbCrLf
                  strTemp = strTemp & Space(4) & "}" & vbCrLf
               Case "int", "byt", "bln"
                  strTemp = strTemp & Space(4) & "if (udt" & strTableName & "." & strHeadInfo & strColumnName & " != NULL_INT)" & vbCrLf
                  strTemp = strTemp & Space(4) & "{" & vbCrLf
                     strTemp = strTemp & Space(8) & "mstrSQL += "" And " & strColumnName & " = "" + CString(itoa(udt" & strTableName & "." & strHeadInfo & strColumnName & ", szBuffer, 10));" & vbCrLf
                  strTemp = strTemp & Space(4) & "}" & vbCrLf
               Case "flt"
                  strTemp = strTemp & Space(4) & "if ((udt" & strTableName & ".flt" & strColumnName & " > NULL_INT - NULL_FLOAT_EPSINON) && (udt" & strTableName & ".flt" & strColumnName & " < NULL_INT + NULL_FLOAT_EPSINON))" & vbCrLf
                  strTemp = strTemp & Space(4) & "{" & vbCrLf
                     strTemp = strTemp & Space(8) & "mstrSQL += "" And " & strColumnName & " = "" + ftoa(udt" & strTableName & ".flt" & strColumnName & ");" & vbCrLf
                  strTemp = strTemp & Space(4) & "}" & vbCrLf

               Case "dbl"
                  strTemp = strTemp & Space(4) & "if ((udt" & strTableName & ".dbl" & strColumnName & " > NULL_INT - NULL_FLOAT_EPSINON) && (udt" & strTableName & ".dbl" & strColumnName & " < NULL_INT + NULL_FLOAT_EPSINON))" & vbCrLf
                  strTemp = strTemp & Space(4) & "{" & vbCrLf
                     strTemp = strTemp & Space(8) & "mstrSQL += "" And " & strColumnName & " = "" + dtoa(udt" & strTableName & ".dbl" & strColumnName & ");" & vbCrLf
                  strTemp = strTemp & Space(4) & "}" & vbCrLf

'                     Case "cur"
               Case Else '"var"
                  strTemp = strTemp & Space(4) & "if (strlen(udt" & strTableName & ".lpsz" & strColumnName & ") > 0)" & vbCrLf
                  strTemp = strTemp & Space(4) & "{" & vbCrLf
                     strTemp = strTemp & Space(8) & "mstrSQL += "" And " & strColumnName & " Like '%"" + CString(udt" & strTableName & ".lpsz" & strColumnName & ") + ""%'"";" & vbCrLf
                  strTemp = strTemp & Space(4) & "}" & vbCrLf

            End Select
         End If
      Next

      strTemp = strTemp & Space(4) & "//mstrSQL += "" Order By " & strTableName & "ID ASC"";" & vbCrLf
      strTemp = strTemp & Space(4) & "return mstrSQL.GetBuffer(mstrSQL.GetLength());" & vbCrLf
   strTemp = strTemp & "}"

   CreateGetFindSQL = strTemp
End Function

Private Function GetAllTypeName(objTable As Table, _
   ByRef rarrstrHeadInfo() As String, _
   Optional ByVal vblnIncludeAutoIncrement As Boolean = True) As String()
   
   Dim arrstrTableTypeName() As String
   Dim I As Long, lngCount As Long, J As Long, K As Long
   Dim strType As String
   Dim blnIsExist As Boolean

   lngCount = objTable.Columns.Count
   ReDim arrstrTableTypeName(lngCount - 1)
   ReDim rarrstrHeadInfo(lngCount - 1)

   K = 0
   For I = 0 To lngCount - 1
      If Not vblnIncludeAutoIncrement And mstrAutoIncrement = objTable.Columns.Item(I).Name Then
         GoTo NextI
      End If
      
      strType = GetColumnTypeInfo(objTable.Columns.Item(I))
      If strType = "BOOL " Then
         strType = "int "
      End If

      blnIsExist = False
      For J = 0 To K
         If arrstrTableTypeName(J) = strType Then
            blnIsExist = True
            Exit For
         End If
      Next J

      If Not blnIsExist Then
         arrstrTableTypeName(K) = strType
         Select Case RTrim(strType)
            Case "char *", "const char *"
               rarrstrHeadInfo(K) = "lpsz"
            Case "BOOL", "bool"
               rarrstrHeadInfo(K) = "bln"
            Case "int"
               rarrstrHeadInfo(K) = "int"
            Case "long"
               rarrstrHeadInfo(K) = "lng"
            Case "COleDateTime"
               rarrstrHeadInfo(K) = "dtm"
            Case "double"
               rarrstrHeadInfo(K) = "dbl"
            Case "float"
               rarrstrHeadInfo(K) = "flt"
            Case "CString"
               rarrstrHeadInfo(K) = "str"
            Case Else
               rarrstrHeadInfo(K) = "str"
         End Select

         K = K + 1
      End If
NextI:
   Next I
   ReDim Preserve arrstrTableTypeName(K - 1)
   ReDim Preserve rarrstrHeadInfo(K - 1)

   GetAllTypeName = arrstrTableTypeName
End Function

Private Function StringInArr(ByVal lpsz As String, arrstr() As String) As Boolean
   Dim I As Long, lngCount As Long
   Dim blnInArr As Boolean

   blnInArr = False
   lngCount = GetArrElementNb(arrstr)
   For I = 0 To lngCount - 1
      If Trim(lpsz) = Trim(arrstr(I)) Then
         blnInArr = True
         Exit For
      End If
   Next I
   StringInArr = blnInArr
End Function

Private Function GetColumnTypeInfo(ColumnTemp As Column, Optional ByVal vblnIsType As Boolean = False) As String

   Dim strColumnTypeInfo As String

   Select Case ColumnTemp.Type
      Case adDate, adDBDate, adDBTime, adDBTimeStamp
         strColumnTypeInfo = "COleDateTime "
      Case adDouble
         strColumnTypeInfo = "double "
      Case adInteger, adUnsignedTinyInt, adSmallInt
         strColumnTypeInfo = "int "
      Case adSingle
         strColumnTypeInfo = "float "
      Case adBoolean
         strColumnTypeInfo = "BOOL "
      Case adUnsignedTinyInt
         strColumnTypeInfo = "int "
      Case Else 'adChar, adVarChar, adLongVarChar, adWChar, adVarWChar, adLongVarWChar, adCurrency
         If vblnIsType Then
            strColumnTypeInfo = "CString"
         Else
            strColumnTypeInfo = "const char *"
         End If
   End Select
   
   GetColumnTypeInfo = strColumnTypeInfo
End Function

Private Function GetColumnTypeInfoHead(ColumnTemp As Column) As String
   Dim strColumnTypeInfo As String

   Select Case ColumnTemp.Type
      Case adDate, adDBDate, adDBTime, adDBTimeStamp
         strColumnTypeInfo = "dtm"
      Case adDouble
         strColumnTypeInfo = "dbl"
      Case adInteger, adSmallInt, adUnsignedTinyInt
         strColumnTypeInfo = "int"
      Case adSingle
         strColumnTypeInfo = "flt"
      Case adBoolean
         strColumnTypeInfo = "bln"
      Case Else 'adChar, adVarChar, adLongVarChar, adWChar, adVarWChar, adLongVarWChar, adCurrency
         strColumnTypeInfo = "str"
   End Select

   GetColumnTypeInfoHead = strColumnTypeInfo
End Function