clsvcheadfile.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 = "clsVCHeadFile"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'**********************************************************************
'**  功能描述: 代码生成器VC表操作部份头文件H
'**
'**  作    者: 陈顺球(LionCSQ)
'**  创建时间: 2005 年 09 月 08 日
'**-------------------------------------------------------------------
'**
'**  改进人员: 寻百安(XunBaian)
'**  改进日期: 2005 年 09 月 15 日

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

Option Explicit

Public Function GetHeadFileString(ByVal vstrProjectName As String, _
                                 ByRef objTable As Table, _
                                 ByRef rstrHeadFile As String, _
                                 Optional ByRef rlngErrNum As Long = 0, _
                                 Optional ByRef rstrErrDescr As String = "") As Boolean
   Dim strTemp As String
   
   On Error GoTo GetHeadFileStringErr
   GetHeadFileString = False
   
   strTemp = CreateIncludeString(vstrProjectName, objTable)
   strTemp = strTemp & CreateStruct(objTable)
   strTemp = strTemp & CreateClassDeclare(objTable)
   
   rstrHeadFile = strTemp
   GetHeadFileString = True
   Err.Clear
GetHeadFileStringErr:
   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 & ".h: interface for the C" & strTableName & " class." & vbCrLf
   strTemp = strTemp & "//" & vbCrLf
   strTemp = strTemp & String(70, "/") & vbCrLf & vbCrLf
   
   strTemp = strTemp & "#if !defined(AFX_" & UCase(strTableName) & "_H__9A9B8BA1_1F87_43EF_ABD3_0093C70448FD__INCLUDED_)" & vbCrLf
   strTemp = strTemp & "#define AFX_" & UCase(strTableName) & "_H__9A9B8BA1_1F87_43EF_ABD3_0093C70448FD__INCLUDED_" & vbCrLf & vbCrLf
   
   strTemp = strTemp & "#if _MSC_VER > 1000" & vbCrLf
   strTemp = strTemp & "#pragma once" & vbCrLf
   strTemp = strTemp & "#endif // _MSC_VER > 1000" & vbCrLf & vbCrLf
   
   strTemp = strTemp & "#ifndef QCREATECODE_CONST" & vbCrLf
   strTemp = strTemp & "#define QCREATECODE_CONST" & vbCrLf
   strTemp = strTemp & "const int NULL_INT = 0xfffffff;" & vbCrLf
   strTemp = strTemp & "const float NULL_FLOAT_EPSINON = 0.00001f;" & vbCrLf
   strTemp = strTemp & "#endif // QCREATECODE_CONST" & vbCrLf & vbCrLf
   
   strTemp = strTemp & "#include ""QDatabase.h""" & vbCrLf & vbCrLf
   
   CreateIncludeString = strTemp
End Function

'结构体
Private Function CreateStruct(ByRef objTable As Table) As String
   Dim strTemp As String
   Dim strTableName As String
   Dim I As Long, lngCount As Long
   Dim strHeadInfo As String, strTypeName As String
   
   strTableName = objTable.Name

   strTemp = "typedef struct tag" & strTableName & vbCrLf
   strTemp = strTemp & "{" & vbCrLf
      lngCount = objTable.Columns.Count
      For I = 0 To lngCount - 1
         strTypeName = GetColumnTypeInfo(objTable.Columns.Item(I), strHeadInfo, True)
         strTemp = strTemp & Space(4) & strTypeName & strHeadInfo & objTable.Columns.Item(I).Name & ";" & vbCrLf
      Next I
   strTemp = strTemp & "} TYP" & UCase(strTableName) & ";" & vbCrLf & vbCrLf
   
   CreateStruct = strTemp
End Function

'类声明部分
Private Function CreateClassDeclare(ByRef objTable As Table) As String
   Dim strTemp As String
   Dim strTableName As String, strTableType As String
   Dim arrstrAllTypeName() As String
   Dim arrstrHeadInfo() As String
   Dim strHeadInfo As String, strTypeName As String
   Dim I As Long, lngCount As Long
   
   strTableName = objTable.Name
   strTableType = UCase(objTable.Type)
   
   arrstrAllTypeName = GetAllTypeName(objTable, arrstrHeadInfo)
   lngCount = GetArrElementNb(arrstrAllTypeName)
   
   strTemp = "class C" & strTableName & vbCrLf
   strTemp = strTemp & "{" & vbCrLf
   strTemp = strTemp & "public:" & vbCrLf
      strTemp = strTemp & Space(4) & "C" & strTableName & "();" & vbCrLf
      strTemp = strTemp & Space(4) & "virtual ~C" & strTableName & "();" & vbCrLf & vbCrLf
   
      strTemp = strTemp & Space(4) & "char *GetConnectString() { return m_lpszConnectionString; }" & vbCrLf
      strTemp = strTemp & Space(4) & "long GetConnectState() { return mlngConnectState; }" & vbCrLf
      strTemp = strTemp & Space(4) & "const char *GetTableName() { return m_lpszTableName; }" & vbCrLf
      strTemp = strTemp & Space(4) & "EnuDatabaseType GetDatabaseType() { return mintDatabaseType; }" & vbCrLf
      strTemp = strTemp & Space(4) & "long QGetRecordCount() { return mlngRecordCount ; }" & vbCrLf & vbCrLf
      
'      strTemp = strTemp & Space(4) & "BOOL SetConnect(BOOL bIsReset = TRUE);" & vbCrLf & vbCrLf

   If strTableType <> "VIEW" Then
      strTemp = strTemp & Space(4) & "BOOL QAddNew(const TYP" & UCase(strTableName) & " &udt" & strTableName & ");" & vbCrLf
      For I = 0 To lngCount - 1
'         strTypeName = GetColumnTypeInfo(objTable.Columns.Item(I), strHeadInfo)
         strTemp = strTemp & Space(4) & "BOOL QUpdateByField(const char *lpszFieldName, " & arrstrAllTypeName(I) & arrstrHeadInfo(I) & "FieldValue, const TYP" & UCase(strTableName) & " &udt" & strTableName & ");" & vbCrLf
      Next I
      strTemp = strTemp & vbCrLf
      strTemp = strTemp & Space(4) & "// BOOL QUpdateBySQL(const char *lpszSQL);" & vbCrLf
      strTemp = strTemp & Space(4) & "BOOL QUpdateByWhere(const char *lpszWhere, const TYP" & UCase(strTableName) & " &udt" & strTableName & ");" & vbCrLf & vbCrLf
      
      strTemp = strTemp & Space(4) & "BOOL QDelAll();" & vbCrLf
      For I = 0 To lngCount - 1
'         strTypeName = GetColumnTypeInfo(objTable.Columns.Item(I), strHeadInfo)
         strTemp = strTemp & Space(4) & "BOOL QDelByField(const char *lpszFieldName, " & arrstrAllTypeName(I) & arrstrHeadInfo(I) & "FieldValue);" & vbCrLf
      Next I
      strTemp = strTemp & vbCrLf
      strTemp = strTemp & Space(4) & "// BOOL QDelBySQL(const char *lpszSQL);" & vbCrLf
      strTemp = strTemp & Space(4) & "BOOL QDelByWhere(const char *lpszWhere);" & vbCrLf & vbCrLf
   End If
   
      strTemp = strTemp & Space(4) & "long QGetAll();" & vbCrLf
      strTemp = strTemp & Space(4) & "long QGetAll(TYP" & UCase(strTableName) & " *parrudt" & strTableName & ");" & vbCrLf
      
'      lngCount = GetArrElementNb(arrstrAllTypeName)
      For I = 0 To lngCount - 1
         strTemp = strTemp & Space(4) & "long QGetByField(const char *lpszFieldName, " & arrstrAllTypeName(I) & arrstrHeadInfo(I) & "FieldValue);" & vbCrLf
         strTemp = strTemp & Space(4) & "long QGetByField(const char *lpszFieldName, " & arrstrAllTypeName(I) & arrstrHeadInfo(I) & "FieldValue, TYP" & UCase(strTableName) & " *parrudt" & strTableName & ");" & vbCrLf
      Next I
      strTemp = strTemp & vbCrLf
      strTemp = strTemp & Space(4) & "long QGetBySQL(const char *lpszSQL);" & vbCrLf
      strTemp = strTemp & Space(4) & "long QGetBySQL(const char *lpszSQL, TYP" & UCase(strTableName) & " *parrudt" & strTableName & ");" & vbCrLf
      strTemp = strTemp & Space(4) & "long QGetByWhere(const char *lpszWhere);" & vbCrLf
      strTemp = strTemp & Space(4) & "long QGetByWhere(const char *lpszWhere, TYP" & UCase(strTableName) & " *parrudt" & strTableName & ");" & vbCrLf & vbCrLf
   
   
      strTemp = strTemp & Space(4) & "BOOL QMoveFirst(TYP" & UCase(strTableName) & " &rudt" & strTableName & ");" & vbCrLf
      strTemp = strTemp & Space(4) & "BOOL QMoveLast(TYP" & UCase(strTableName) & " &rudt" & strTableName & ");" & vbCrLf
      strTemp = strTemp & Space(4) & "BOOL QMoveNext(TYP" & UCase(strTableName) & " &rudt" & strTableName & ");" & vbCrLf
      strTemp = strTemp & Space(4) & "BOOL QMovePrevious(TYP" & UCase(strTableName) & " &rudt" & strTableName & ");" & vbCrLf
      strTemp = strTemp & Space(4) & "BOOL QMoveTo(long vlngNumRecords, long vlngStart, TYP" & UCase(strTableName) & " &rudt" & strTableName & " );" & vbCrLf & vbCrLf
      
      strTemp = strTemp & Space(4) & "char *GetFindSQL(const TYP" & UCase(strTableName) & " &udt" & strTableName & ");" & vbCrLf & vbCrLf
      
   strTemp = strTemp & "private:" & vbCrLf
      strTemp = strTemp & Space(4) & "_RecordsetPtr mrst;" & vbCrLf & vbCrLf
      
      strTemp = strTemp & Space(4) & "const char *m_lpszDatabaseName;" & vbCrLf
      strTemp = strTemp & Space(4) & "const char *m_lpszTableName ;" & vbCrLf & vbCrLf
      
      strTemp = strTemp & Space(4) & "char *m_lpszConnectionString;" & vbCrLf
      strTemp = strTemp & Space(4) & "EnuDatabaseType mintDatabaseType;" & vbCrLf
      strTemp = strTemp & Space(4) & "long mlngConnectState;" & vbCrLf
      strTemp = strTemp & Space(4) & "long mlngRecordCount;" & vbCrLf & vbCrLf
      
      strTemp = strTemp & Space(4) & "CString mstrSQL;" & vbCrLf & vbCrLf
      
      strTemp = strTemp & Space(4) & "CString GetUpdateString(const TYP" & UCase(strTableName) & " &udt" & strTableName & ");" & vbCrLf
      strTemp = strTemp & Space(4) & "TYP" & UCase(strTableName) & " GetResult();" & vbCrLf
      strTemp = strTemp & Space(4) & "void GetResult(TYP" & UCase(strTableName) & " *parrudt" & strTableName & ");" & vbCrLf
      If StringInArr("float ", arrstrAllTypeName) Then
         strTemp = strTemp & Space(4) & "CString ftoa(float fData);" & vbCrLf
      End If
      If StringInArr("double ", arrstrAllTypeName) Then
         strTemp = strTemp & Space(4) & "CString dtoa(double dblData);" & vbCrLf
      End If
'      strTemp = strTemp & vbCrLf
   strTemp = strTemp & "};" & vbCrLf & vbCrLf
   
   strTemp = strTemp & "#endif // !defined(AFX_" & UCase(strTableName) & "_H__9A9B8BA1_1F87_43EF_ABD3_0093C70448FD__INCLUDED_)"

   CreateClassDeclare = strTemp
End Function

Private Function GetAllTypeName(objTable As Table, ByRef rarrstrHeadInfo() As String) 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
      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 "CString"
               rarrstrHeadInfo(K) = "str"
            Case "float"
               rarrstrHeadInfo(K) = "flt"
            Case Else
               rarrstrHeadInfo(K) = "lpsz"
         End Select
         
         K = K + 1
      End If
   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 lpsz = arrstr(I) Then
         blnInArr = True
         Exit For
      End If
   Next I
   StringInArr = blnInArr
End Function

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

   Dim strColumnTypeInfo As String
   
   Select Case ColumnTemp.Type
      Case adDate, adDBDate, adDBTime, adDBTimeStamp
         strColumnTypeInfo = "COleDateTime "
         rstrHeadInfo = "dtm"
      Case adDouble
         strColumnTypeInfo = "double "
         rstrHeadInfo = "dbl"
      Case adBigInt, adUnsignedBigInt
         strColumnTypeInfo = "long "
         rstrHeadInfo = "lng"
      Case adInteger, adSmallInt, adUnsignedTinyInt, adTinyInt
         strColumnTypeInfo = "int "
         rstrHeadInfo = "int"
      Case adSingle
         strColumnTypeInfo = "float "
         rstrHeadInfo = "flt"
      Case adBoolean
         strColumnTypeInfo = "BOOL "
         rstrHeadInfo = "bln"
      Case Else 'adChar, adVarChar, adLongVarChar, adWChar, adVarWChar, adLongVarWChar, adCurrency
         If vblnIsType Then
            strColumnTypeInfo = "CString "
            rstrHeadInfo = "str"
         Else
            strColumnTypeInfo = "const char *"
            rstrHeadInfo = "lpsz"
         End If
   End Select
   
   GetColumnTypeInfo = strColumnTypeInfo
End Function