clsvccppfile.cls

VB代码生成器

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsVCCppFile"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'**********************************************************************
'**  功能描述: 代码生成器VC源码表操作部份CPP
'**
'**  作    者: 陈顺球(LionCSQ)
'**  创建时间: 2005 年 09 月 08 日
'**-------------------------------------------------------------------
'**
'**  改进人员: 寻百安(XunBaian)
'**  改进日期: 2005 年 09 月 15 日

'**  改进描述:
'**********************************************************************

Option Explicit

Private mstrAutoIncrement As String

Public Function GetCppFileString(ByVal vstrProjectName As String, _
                                 ByRef objTable As Table, _
                                 ByVal vstrAutoIncrement As String, _
                                 ByRef rstrCppFile As String, _
                                 Optional ByRef rlngErrNum As Long = 0, _
                                 Optional ByRef rstrErrDescr As String = "") As Boolean
   Dim strTemp As String
   Dim strTableType As String
   
   On Error GoTo GetCppFileStringErr
   GetCppFileString = False

   strTableType = UCase(objTable.Type)
   mstrAutoIncrement = vstrAutoIncrement
   
   strTemp = CreateIncludeString(vstrProjectName, objTable)
'   strTemp = strTemp & CreateSetConnect(vstrProjectName, objTable)
   strTemp = strTemp & CreateFtoaDtoa(objTable)
   If strTableType <> "VIEW" Then
      strTemp = strTemp & CreateQAddNew(vstrProjectName, objTable)
      strTemp = strTemp & CreateGetUpdateString(vstrProjectName, objTable)
'      strTemp = strTemp & CreateQUpdateBySN(vstrProjectName, objTable)
      strTemp = strTemp & CreateQUpdateByField(vstrProjectName, objTable)
      strTemp = strTemp & CreateQUpdateByWhere(vstrProjectName, objTable)
      strTemp = strTemp & CreateQDelAll(vstrProjectName, objTable)
'      strTemp = strTemp & CreateQDelBySN(vstrProjectName, objTable)
      strTemp = strTemp & CreateQDelByField(vstrProjectName, objTable)
      strTemp = strTemp & CreateQDelByWhere(vstrProjectName, objTable)
   End If
   strTemp = strTemp & CreateQGetAll(vstrProjectName, objTable)
'   strTemp = strTemp & CreateQGetBySN(vstrProjectName, objTable)
   strTemp = strTemp & CreateQGetByField(vstrProjectName, objTable)
   strTemp = strTemp & CreateQGetBySQL(vstrProjectName, objTable)
   strTemp = strTemp & CreateQGetByWhere(vstrProjectName, objTable)
   strTemp = strTemp & CreateGetResult(vstrProjectName, objTable)
   strTemp = strTemp & CreateQMove(objTable)
   strTemp = strTemp & CreateGetFindSQL(objTable)

   rstrCppFile = strTemp
   GetCppFileString = True
   Err.Clear
GetCppFileStringErr:
   rlngErrNum = Err.Number
   rstrErrDescr = Err.Description
End Function

Private Function CreateIncludeString(ByVal vstrProjectName As String, _
                                 ByRef objTable As Table) As String
   Dim strTemp As String
   Dim strTableName As String
   strTableName = objTable.Name

   '声明部分
   strTemp = "// " & strTableName & ".cpp: implementation of the C" & strTableName & " class." & vbCrLf
   strTemp = strTemp & "//" & vbCrLf & String(70, "/") & vbCrLf & vbCrLf

   strTemp = strTemp & "#include ""stdafx.h""" & vbCrLf
'   strTemp = strTemp & "#include """ & vstrProjectName & ".h""" & vbCrLf
   strTemp = strTemp & "#include """ & strTableName & ".h""" & vbCrLf & vbCrLf

   strTemp = strTemp & "#ifdef _DEBUG" & vbCrLf
   strTemp = strTemp & "#undef THIS_FILE" & vbCrLf
   strTemp = strTemp & "static char THIS_FILE[]=__FILE__;" & vbCrLf
   strTemp = strTemp & "#define new DEBUG_NEW" & vbCrLf
   strTemp = strTemp & "#endif" & vbCrLf & vbCrLf

   strTemp = strTemp & String(70, "/") & vbCrLf
   strTemp = strTemp & "// Construction/Destruction" & vbCrLf
   strTemp = strTemp & String(70, "/") & vbCrLf & vbCrLf

   '构造函数
   strTemp = strTemp & "C" & strTableName & "::C" & strTableName & "()" & vbCrLf
   strTemp = strTemp & "{" & vbCrLf
      strTemp = strTemp & Space(4) & "m_lpszDatabaseName = """ & vstrProjectName & """;" & vbCrLf
      strTemp = strTemp & Space(4) & "m_lpszTableName = """ & strTableName & """;" & vbCrLf
      strTemp = strTemp & Space(4) & "mlngRecordCount = -1;" & vbCrLf
      strTemp = strTemp & Space(4) & "mrst.CreateInstance((__uuidof(Recordset)));" & vbCrLf & vbCrLf
      
      strTemp = strTemp & Space(4) & "if (GetConnectState()!=adStateOpen)" & vbCrLf
      strTemp = strTemp & Space(4) & "{" & vbCrLf
         strTemp = strTemp & Space(8) & "QOpenConnect(m_lpszDatabaseName, FALSE);" & vbCrLf
      strTemp = strTemp & Space(4) & "}" & vbCrLf
      strTemp = strTemp & Space(4) & "mintDatabaseType = QGetDatabaseType(m_lpszDatabaseName);" & vbCrLf
   strTemp = strTemp & "}" & vbCrLf & vbCrLf

   '析构函数
   strTemp = strTemp & "C" & strTableName & "::~C" & strTableName & "()" & vbCrLf
   strTemp = strTemp & "{" & vbCrLf
      strTemp = strTemp & Space(4) & "QCloseRecordSet(m_lpszDatabaseName, mrst);" & vbCrLf
   strTemp = strTemp & "}" & vbCrLf & vbCrLf

   CreateIncludeString = strTemp
End Function

'SetConnect函数
Private Function CreateSetConnect(ByVal vstrProjectName As String, _
                                 ByRef objTable As Table) As String
   Dim strTemp As String
   Dim strTableName As String
   strTableName = objTable.Name

   strTemp = "BOOL C" & strTableName & "::SetConnect(BOOL bIsReset)" & vbCrLf
   strTemp = strTemp & "{" & vbCrLf
      strTemp = strTemp & Space(4) & "return QOpenConnect(m_lpszDatabaseName, bIsReset);" & vbCrLf
   strTemp = strTemp & "}" & vbCrLf & vbCrLf

   CreateSetConnect = strTemp
End Function

'ftoa,dtoa函数
Private Function CreateFtoaDtoa(ByRef objTable As Table) As String
   Dim strTemp As String
   Dim strTableName As String
   Dim arrstrFieldTypeName() As String
   Dim arrstrHeadInfo() As String
   strTableName = objTable.Name

   arrstrFieldTypeName = GetAllTypeName(objTable, arrstrHeadInfo)

   'ftoa
   If StringInArr("float ", arrstrFieldTypeName) Then
      strTemp = "CString C" & strTableName & "::ftoa(float fData)" & vbCrLf
      strTemp = strTemp & "{" & vbCrLf
         strTemp = strTemp & Space(4) & "CString str;" & vbCrLf
         strTemp = strTemp & Space(4) & "str.Format(""%f"", fData);" & vbCrLf
         strTemp = strTemp & Space(4) & "return str;" & vbCrLf
      strTemp = strTemp & "}" & vbCrLf & vbCrLf
   End If

   'dtoa
   If StringInArr("double ", arrstrFieldTypeName) Then
      strTemp = strTemp & "CString C" & strTableName & "::dtoa(double dblData)" & vbCrLf
      strTemp = strTemp & "{" & vbCrLf
         strTemp = strTemp & Space(4) & "CString str;" & vbCrLf
         strTemp = strTemp & Space(4) & "str.Format(""%f"", dblData);" & vbCrLf
         strTemp = strTemp & Space(4) & "return str;" & vbCrLf
      strTemp = strTemp & "}" & vbCrLf & vbCrLf
   End If

   CreateFtoaDtoa = strTemp
End Function

'QAddNew函数
Private Function CreateQAddNew(ByVal vstrProjectName As String, _
                              ByRef objTable As Table) As String
   Dim strTemp As String
   Dim strTableName As String
   Dim strHeadInfo As String
   Dim strSymbol As String
   Dim arrstrFieldTypeName() As String, arrstrHeadInfo() As String
   Dim I As Long, lngCount As Long
   Dim strColummName As String

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

   strTemp = strTemp & "BOOL C" & strTableName & "::QAddNew(const TYP" & UCase(strTableName) & " &udt" & strTableName & ")"
   strTemp = strTemp & "{" & vbCrLf
   If StringInArr("int ", arrstrFieldTypeName) Or _
      StringInArr("long ", arrstrFieldTypeName) Or _
      StringInArr("BOOL ", arrstrFieldTypeName) Then
         strTemp = strTemp & Space(4) & "char szBuffer[256];" & vbCrLf
   End If
   If StringInArr("COleDateTime ", arrstrFieldTypeName) Then
      strTemp = strTemp & Space(4) & "CString strSymbol;" & vbCrLf
      strTemp = strTemp & Space(4) & "strSymbol = (mintDatabaseType == enuDatabaseType_Access) ? ""#"" : ""'"";" & vbCrLf
   End If
   
   strTemp = strTemp & Space(4) & "mstrSQL = ""Insert Into "" + CString(m_lpszTableName) +" & vbCrLf
      strTemp = strTemp & Space(8) & """ ("
      lngCount = objTable.Columns.Count
      For I = 0 To lngCount - 1
         strColummName = objTable.Columns.Item(I).Name
         If strColummName <> mstrAutoIncrement Then
            If I = lngCount - 1 Then
               strTemp = strTemp & strColummName & ") "" +" & vbCrLf
            Else
               strTemp = strTemp & strColummName & ", "
               If I Mod 10 = 0 And I <> 0 Then
                  strTemp = strTemp & """ +" & vbCrLf & Space(8) & """"
               End If
            End If
         End If
      Next I
      strTemp = strTemp & Space(8) & """Values("
      For I = 0 To lngCount - 1
         strColummName = objTable.Columns.Item(I).Name
         If strColummName <> mstrAutoIncrement Then
            strHeadInfo = GetColumnTypeInfoHead(objTable.Columns.Item(I))
            Select Case strHeadInfo
               Case "dtm"
                  strTemp = strTemp & """ + strSymbol +" & vbCrLf & Space(12) & "udt" & strTableName & "." & strHeadInfo & strColummName & ".Format(""%Y-%m-%d %H:%M:%S"") + strSymbol + """
               Case "lpsz"
                  strTemp = strTemp & "'"" +" & vbCrLf & Space(12) & "CString(udt" & strTableName & "." & strHeadInfo & strColummName & ") + ""'"
               Case "str"
                  strTemp = strTemp & "'"" +" & vbCrLf & Space(12) & "udt" & strTableName & "." & strHeadInfo & strColummName & " + ""'"
               Case "lng"
                  strTemp = strTemp & """ +" & vbCrLf & Space(12) & "CString(ltoa(udt" & strTableName & "." & strHeadInfo & strColummName & ", szBuffer, 10)) + """
               Case "int", "byt", "bln"
                  strTemp = strTemp & """ +" & vbCrLf & Space(12) & "CString(itoa(udt" & strTableName & "." & strHeadInfo & strColummName & ", szBuffer, 10)) + """
               Case "flt"
                  strTemp = strTemp & """ +" & vbCrLf & Space(12) & "ftoa(udt" & strTableName & "." & strHeadInfo & strColummName & ") + """
               Case "dbl"
                  strTemp = strTemp & """ +" & vbCrLf & Space(12) & "dtoa(udt" & strTableName & "." & strHeadInfo & strColummName & ") + """
               Case Else '"var"
                  strTemp = strTemp & "'"" +" & vbCrLf & Space(12) & "CString(udt" & strTableName & "." & strHeadInfo & strColummName & ") + ""'"
            End Select
            If I = lngCount - 1 Then
               strTemp = strTemp & ")"";" & vbCrLf
            Else
               strTemp = strTemp & ","
            End If
         End If
      Next I
      strTemp = strTemp & Space(4) & "return QExecuteQuery(m_lpszDatabaseName, mstrSQL);" & vbCrLf
   strTemp = strTemp & "}" & vbCrLf & vbCrLf

   CreateQAddNew = strTemp
End Function

'QGetAll函数
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 = "long C" & strTableName & "::QGetAll()" & vbCrLf
   strTemp = strTemp & "{" & vbCrLf
      strTemp = strTemp & Space(4) & "mlngRecordCount = -1;" & vbCrLf
      strTemp = strTemp & Space(4) & "mstrSQL = ""Select * From "" + CString(m_lpszTableName) + "" Order By " & strTableName & "ID ASC"";" & vbCrLf
      strTemp = strTemp & Space(4) & "if (QOpenRecordSet(m_lpszDatabaseName, mstrSQL, mrst))" & vbCrLf
      strTemp = strTemp & Space(4) & "{" & vbCrLf
         strTemp = strTemp & Space(8) & "mstrSQL = ""QGetAll"";" & vbCrLf
         strTemp = strTemp & Space(8) & "mlngRecordCount = mrst->RecordCount;" & vbCrLf
      strTemp = strTemp & Space(4) & "}" & vbCrLf
      strTemp = strTemp & Space(4) & "return mlngRecordCount;" & vbCrLf
   strTemp = strTemp & "}" & vbCrLf & vbCrLf

   strTemp = strTemp & "long C" & strTableName & "::QGetAll(TYP" & UCase(strTableName) & " *parrudt" & strTableName & ")" & vbCrLf
   strTemp = strTemp & "{" & vbCrLf
      strTemp = strTemp & Space(4) & "if (mstrSQL != ""QGetAll"")" & vbCrLf
      strTemp = strTemp & Space(4) & "{" & vbCrLf