clsvcconnectionhead.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 = "clsVCConnectionHead"
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 GetConnectionHead(ByVal vstrProjectName As String) As String
   Dim strTemp As String
   
   '声明部分
   strTemp = "// DataConnection.h: interface for the CDataConnection class." & vbCrLf
   strTemp = strTemp & "//" & vbCrLf
   strTemp = strTemp & String(70, "/") & vbCrLf & vbCrLf
   
   strTemp = strTemp & "#if !defined(AFX_DATACONNECTION_H__9A9B8BA1_1F87_43EF_ABD3_0093C70448FD__INCLUDED_)" & vbCrLf
   strTemp = strTemp & "#define AFX_DATACONNECTION_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 & "#include """ & vstrProjectName & ".h""" & vbCrLf
   strTemp = strTemp & "#include ""QDatabase.h""" & vbCrLf & vbCrLf
   
   strTemp = strTemp & "class CDataConnection" & vbCrLf
   strTemp = strTemp & "{" & vbCrLf
   strTemp = strTemp & "public:" & vbCrLf
   strTemp = strTemp & "    CDataConnection();" & vbCrLf
   strTemp = strTemp & "    virtual ~CDataConnection();" & vbCrLf & vbCrLf
   
'   strTemp = strTemp & "public:" & vbCrLf
   strTemp = strTemp & "    void SetDatabaseName(const char *lpszDatabaseName = """ & vstrProjectName & """);" & vbCrLf & vbCrLf
   
   strTemp = strTemp & "    const char *GetCurrentDatabase() { return m_lpszDatabaseName; }" & vbCrLf
   strTemp = strTemp & "    char *GetConnectionString() { return QGetConnectionString(m_lpszDatabaseName); }" & vbCrLf
   strTemp = strTemp & "    long GetConnectionState() { return QGetConnectionState(m_lpszDatabaseName); }" & vbCrLf
   strTemp = strTemp & "    EnuDatabaseType GetDatabaseType() { QGetDatabaseType(m_lpszDatabaseName); }" & vbCrLf & vbCrLf
   
   strTemp = strTemp & "    BOOL OpenConnection(BOOL bIsReset, HWND hWnd = NULL) { return QOpenConnect(m_lpszDatabaseName, bIsReset, hWnd); }" & vbCrLf
   strTemp = strTemp & "    BOOL CloseConnection() { return QCloseConnect(m_lpszDatabaseName); }" & vbCrLf & vbCrLf
   
   strTemp = strTemp & "private:" & vbCrLf
   strTemp = strTemp & "    const char *m_lpszDatabaseName;" & vbCrLf
   
   GetConnectionHead = strTemp
End Function

Public Function GetConnectionHeadTail() As String
   Dim strTemp As String
   
   strTemp = "};" & vbCrLf & vbCrLf
   strTemp = strTemp & "#endif // !defined(AFX_DATACONNECTION_H__9A9B8BA1_1F87_43EF_ABD3_0093C70448FD__INCLUDED_)"
   
   GetConnectionHeadTail = strTemp
End Function

Public Function GetStoreProcedure(ByVal vstrProcedureName As String, _
                                    ByRef arrlngParamDirection() As Long, _
                                    ByRef arrstrParamName() As String, _
                                    ByRef arrlngParamType() As Long) As String
   Dim strTemp As String
   Dim I As Long, lngCount As Long
   Dim strParamDirection As String, strParamName As String, strParamType As String, strTypeHead As String
   Dim strAddParams As String, strReturnParams As String
   
   strAddParams = ""
   strTemp = "    BOOL Exe_" & vstrProcedureName & "("
   
   lngCount = GetArrElementNb(arrstrParamName)
   For I = 0 To lngCount - 1
      strParamName = GetParamName(arrstrParamName(I))
      Call GetParamType(arrlngParamType(I), arrlngParamDirection(I), strParamType, strTypeHead)
      
      strTemp = strTemp & strParamType & strTypeHead & strParamName & ", "
      If I Mod 10 = 0 Or I = lngCount - 1 Then
         strTemp = strTemp & vbCrLf & Space(27)
      End If
   Next I
   
   If Right(strTemp, 27) <> Space(27) Then
      strTemp = strTemp & Space(27)
   End If
   
   strTemp = strTemp & "_RecordsetPtr *robjRst = NULL);" & vbCrLf
   
   GetStoreProcedure = strTemp

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 & "#include """ & vstrProjectName & ".h""" & vbCrLf
   strTemp = strTemp & "#include ""QDatabase.h""" & vbCrLf & vbCrLf
   
   CreateIncludeString = strTemp
End Function

Private Function GetParamName(ByVal vstrParamName As String) As String
   Dim strParamName As String
   
   strParamName = Mid(vstrParamName, 2)
   
   GetParamName = strParamName
End Function
'
'Private Sub GetParamType(ByVal vlngParamType As Long, ByVal vlngParamDirection As Long, ByRef rstrParamType As String, ByRef rstrTypeHead As String)
'   Select Case vlngParamType
'      Case adDate, adDBDate, adDBTime, adDBTimeStamp
'         rstrTypeHead = "dtm"
'         rstrParamType = "COleDateTime"
'      Case adDouble
'         rstrTypeHead = "d"
'         rstrParamType = "double"
'      Case adSingle
'         rstrTypeHead = "f"
'         rstrParamType = "float"
'      Case adBigInt, adInteger
'         rstrTypeHead = "l"
'         rstrParamType = "long"
''      Case adInteger
''         rstrTypeHead = "n"
''         rstrParamType = "int"
'      Case adSmallInt
'         rstrTypeHead = "i"
'         rstrParamType = "short"
'      Case adChar, adVarChar, adLongVarChar, adWChar, adVarWChar, adLongVarWChar
'         rstrTypeHead = "lpsz"
'         rstrParamType = "char *"
'      Case adBoolean
'         rstrTypeHead = "b"
'         rstrParamType = "bool"
'      Case adUnsignedTinyInt
'         rstrTypeHead = "byt"
'         rstrParamType = "byte"
''      Case adNumeric
''         rstrTypeHead = "var"
''         rstrParamType = "Variant"
'      Case Else
'         rstrTypeHead = "var"
'         rstrParamType = "VARIANT"
'   End Select
'
'   If vlngParamDirection <> adParamInput Then
'      rstrTypeHead = "*" & rstrTypeHead & "p"
'   End If
'
'End Sub