clsvcconnectioncpp.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 = "clsVCConnectionCPP"
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

Public Function GetConnectionCPP(ByVal vstrProjectName As String) As String
   Dim strTemp As String

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

   strTemp = strTemp & "#include ""stdafx.h""" & vbCrLf
'   strTemp = strTemp & "#include """ & vstrProjectName & ".h""" & vbCrLf
   strTemp = strTemp & "#include ""DataConnection.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 & "CDataConnection::CDataConnection()" & vbCrLf
   strTemp = strTemp & "{" & vbCrLf
   strTemp = strTemp & "   m_lpszDatabaseName = """ & vstrProjectName & """;" & vbCrLf
   strTemp = strTemp & "   if (GetConnectionState() != adStateOpen)" & vbCrLf
   strTemp = strTemp & "   {" & vbCrLf
   strTemp = strTemp & "      OpenConnection(FALSE);" & vbCrLf
   strTemp = strTemp & "   }" & vbCrLf
   strTemp = strTemp & "}" & vbCrLf & vbCrLf
   
   strTemp = strTemp & "CDataConnection::~CDataConnection()" & vbCrLf
   strTemp = strTemp & "{" & vbCrLf
   strTemp = strTemp & "}" & vbCrLf & vbCrLf
   
   strTemp = strTemp & "void CDataConnection::SetDatabaseName(const char *lpszDatabaseName)" & vbCrLf
   strTemp = strTemp & "{" & vbCrLf
   strTemp = strTemp & "   CString strTemp;" & vbCrLf
   strTemp = strTemp & "   strTemp = lpszDatabaseName;" & vbCrLf
   strTemp = strTemp & "   if (strTemp.GetLength() > 0)" & vbCrLf
   strTemp = strTemp & "   {" & vbCrLf
   strTemp = strTemp & "      m_lpszDatabaseName = lpszDatabaseName;" & vbCrLf
   strTemp = strTemp & "   }" & vbCrLf
'   strTemp = strTemp & "   m_lpszDatabaseName = lpszDatabaseName;" & vbCrLf
   strTemp = strTemp & "   return;" & vbCrLf
   strTemp = strTemp & "}" & vbCrLf & vbCrLf
   
   GetConnectionCPP = 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, strVarType As String
   Dim strAddParams As String, strReturnParams As String
   
   strAddParams = ""
   strReturnParams = ""
   strTemp = "BOOL CDataConnection::Exe_" & vstrProcedureName & "("
   
   lngCount = GetArrElementNb(arrstrParamName)
   For I = 0 To lngCount - 1
      strParamName = GetParamName(arrstrParamName(I))
      Call GetParamType(arrlngParamType(I), arrlngParamDirection(I), strParamType, strTypeHead, strVarType)
      
      strTemp = strTemp & strParamType & strTypeHead & strParamName & ", "
      If I Mod 10 = 0 Or I = lngCount - 1 Then
         strTemp = strTemp & vbCrLf & Space(38)
      End If
'      If strVarType = "dtm" Then
'         strAddParams = strAddParams & "   pParams[" & I & "] = " & strTypeHead & strParamName & ".m_dt;" & vbCrLf
'      Else
         strAddParams = strAddParams & "   pParams[" & I & "] = " & strTypeHead & strParamName & ";" & vbCrLf
'      End If
      
      If Left(strTypeHead, 1) = "*" Then
         Select Case strVarType
            Case "var"
               strReturnParams = strReturnParams & "   " & strTypeHead & strParamName & " = pParams[" & I & "];" & vbCrLf
            Case "bstrVal"
               strReturnParams = strReturnParams & "   " & strTypeHead & strParamName & " = _com_util::ConvertBSTRToString(pParams[" & I & "]." & strVarType & ");" & vbCrLf
            Case "dtm"
               strReturnParams = strReturnParams & "   " & strTypeHead & strParamName & " = COleDateTime(pParams[" & I & "].date);" & vbCrLf
            Case Else
               strReturnParams = strReturnParams & "   " & strTypeHead & strParamName & " = pParams[" & I & "]." & strVarType & ";" & vbCrLf
         End Select
      End If
   Next I
   
   If Right(strTemp, 38) <> Space(38) Then
      strTemp = strTemp & Space(38)
   End If
   
   strTemp = strTemp & "_RecordsetPtr *robjRst)" & vbCrLf
   strTemp = strTemp & "{" & vbCrLf
   strTemp = strTemp & "   _variant_t *pParams = new _variant_t[" & lngCount & "];" & vbCrLf & vbCrLf
   
   strTemp = strTemp & strAddParams & vbCrLf
   
   strTemp = strTemp & "   BOOL ret = QExecuteProcedure(m_lpszDatabaseName, """ & vstrProcedureName & """, pParams, robjRst);" & vbCrLf & vbCrLf
   
   strTemp = strTemp & strReturnParams & vbCrLf
   
   strTemp = strTemp & "   delete [] pParams;" & vbCrLf
   strTemp = strTemp & "   return ret;" & vbCrLf
   strTemp = strTemp & "}" & vbCrLf & vbCrLf
   
   GetStoreProcedure = 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, _
'                        Optional ByRef rstrVarType As String)
'   Select Case vlngParamType
'      Case adDate, adDBDate, adDBTime, adDBTimeStamp
'         rstrTypeHead = "dtm"
'         rstrParamType = "COleDateTime"
'         rstrVarType = "dtm"
''      Case adCurrency
''         rstrTypeHead = "cur"
''         rstrParamType = "VARIANT"
''         rstrVarType = ""
'      Case adDouble
'         rstrTypeHead = "d"
'         rstrParamType = "double"
'         rstrVarType = "dblVal"
'      Case adSingle
'         rstrTypeHead = "f"
'         rstrParamType = "float"
'         rstrVarType = "fltVal"
'      Case adBigInt, adInteger
'         rstrTypeHead = "l"
'         rstrParamType = "long"
'         rstrVarType = "lVal"
''      Case adInteger
''         rstrTypeHead = "n"
''         rstrParamType = "int"
''         rstrVarType = "intVal"
'      Case adSmallInt
'         rstrTypeHead = "i"
'         rstrParamType = "short"
'         rstrVarType = "iVal"
'      Case adChar, adVarChar, adLongVarChar, adWChar, adVarWChar, adLongVarWChar
'         rstrTypeHead = "lpsz"
'         rstrParamType = "char *"
'         rstrVarType = "bstrVal"
'      Case adBoolean
'         rstrTypeHead = "b"
'         rstrParamType = "bool"
'         rstrVarType = "boolVal"
'      Case adUnsignedTinyInt
'         rstrTypeHead = "byt"
'         rstrParamType = "byt"
'         rstrVarType = "bVal"
''      Case adNumeric
''         rstrTypeHead = "var"
''         rstrParamType = "Variant"
'      Case Else
'         rstrTypeHead = "var"
'         rstrParamType = "VARIANT"
'         rstrVarType = "var"
'   End Select
'
'   If vlngParamDirection <> adParamInput Then
'      rstrTypeHead = "*" & rstrTypeHead & "p"
'   End If
'
'End Sub