clsbuildstruct.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 = "clsBuildStruct"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'**********************************************************************
'**  功能描述: 代码生成器创建自定义类型
'**
'**  作    者: 陈顺球(LionCSQ)
'**  创建时间: 2005 年 09 月 08 日
'**-------------------------------------------------------------------
'**
'**  改进人员: 寻百安(XunBaian)
'**  改进日期: 2005 年 09 月 15 日

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

Option Explicit

Public Function FileHeadInfo(ByVal vstrFileName As String) As String
   Dim strTemp As String
   
   strTemp = "VERSION 1.0 CLASS" & vbCrLf
   strTemp = strTemp & "BEGIN" & vbCrLf
   strTemp = strTemp & "   MultiUse = -1  'True" & vbCrLf
   strTemp = strTemp & "   Persistable = 0  'NotPersistable" & vbCrLf
   strTemp = strTemp & "   DataBindingBehavior = 0  'vbNone" & vbCrLf
   strTemp = strTemp & "   DataSourceBehavior = 0   'vbNone" & vbCrLf
   strTemp = strTemp & "   MTSTransactionMode = 0   'NotAnMTSObject" & vbCrLf
   strTemp = strTemp & "End" & vbCrLf
   strTemp = strTemp & "Attribute VB_Name = " & Chr(34) & vstrFileName & Chr(34) & vbCrLf
   strTemp = strTemp & "Attribute VB_GlobalNameSpace = False" & vbCrLf
   strTemp = strTemp & "Attribute VB_Creatable = True" & vbCrLf
   strTemp = strTemp & "Attribute VB_PredeclaredId = False" & vbCrLf
   strTemp = strTemp & "Attribute VB_Exposed = True" & vbCrLf
   strTemp = strTemp & "Option Explicit" & vbCrLf & vbCrLf
   
   strTemp = strTemp & "Public Enum EnmNULL_INTEGER" & vbCrLf
   strTemp = strTemp & "   NULL_INTEGER = &HFFFFFFF '整数字段没有分配的值（以区别默认的0值）" & vbCrLf
   strTemp = strTemp & "   NULL_FLOAT_EPSINON = 5 '保留小数点位数" & vbCrLf
   strTemp = strTemp & "End Enum" & vbCrLf
   
   FileHeadInfo = strTemp & vbCrLf
End Function

Public Function BuildStruct(ByRef robjTable As Table) As String
   
   Dim ii As Long
   Dim ColumnTemp As Column
   
   Dim strStruInfo As String
   Dim strColumnTemp As String
   On Error GoTo ErrHandle
   
   strStruInfo = "Public Type typ" & robjTable.Name & vbCrLf
   
   For Each ColumnTemp In robjTable.Columns
      strStruInfo = strStruInfo & BuildColumnInfo(ColumnTemp) & vbCrLf
   Next ColumnTemp
   
   strStruInfo = strStruInfo & "End Type" & vbCrLf & vbCrLf
   
   BuildStruct = strStruInfo
   
ErrHandle:
End Function

Private Function BuildColumnInfo(ColumnTemp As Column) As String

   BuildColumnInfo = Space(3) & GetColumnTypeInfoHead(ColumnTemp) & ColumnTemp.Name & Space(Max((20 - Len(ColumnTemp.Name)), 0)) & " As " & GetColumnTypeInfo(ColumnTemp)

End Function

Private Function Max(a As Variant, b As Variant) As Variant

   Max = b
   If a > b Then
      Max = a
   End If
   
End Function

Private Function GetColumnTypeInfo(ColumnTemp As Column) As String

   Dim strColumnTypeInfo As String
   
   Select Case ColumnTemp.Type
   
      Case adDate, adDBDate, adDBTime, adDBTimeStamp
         strColumnTypeInfo = "Date"
         
      Case adCurrency
         strColumnTypeInfo = "Currency"
         
      Case adDouble
         strColumnTypeInfo = "Double"
         
      Case adInteger
         strColumnTypeInfo = "Long"
         
      Case adSingle
         strColumnTypeInfo = "Single"
         
      Case adSmallInt
         strColumnTypeInfo = "Integer"
         
      Case adChar, adVarChar, adLongVarChar, adWChar, adVarWChar, adLongVarWChar
         strColumnTypeInfo = "String"
         
      Case adBoolean
         strColumnTypeInfo = "Boolean"
      
      Case adUnsignedTinyInt
         
         strColumnTypeInfo = "Byte"
      
      Case Else
         strColumnTypeInfo = "Variant"
      
   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 adCurrency
         strColumnTypeInfo = "cur"

      Case adDouble
         strColumnTypeInfo = "dbl"

      Case adInteger
         strColumnTypeInfo = "lng"

      Case adSingle
         strColumnTypeInfo = "sng"

      Case adSmallInt
         strColumnTypeInfo = "int"

      Case adChar, adVarChar, adLongVarChar, adWChar, adVarWChar, adLongVarWChar
         strColumnTypeInfo = "str"

      Case adBoolean
         strColumnTypeInfo = "bln"

      Case adUnsignedTinyInt
         strColumnTypeInfo = "byt"

      Case Else
         strColumnTypeInfo = "var"

   End Select

   If ColumnTemp.Name = "ZS" Then
      Debug.Print
   End If

   GetColumnTypeInfoHead = strColumnTypeInfo
 
End Function