<Serializable()>
Public Class cDatabase
Private _Nome As String = ""
Public Property Nome As String
Get
Return _Nome
End Get
Set(ByVal value As String)
_Nome = value
End Set
End Property
Private _TipoOrigine As String
Public Property TipoOrigine() As String
Get
Return _TipoOrigine
End Get
Set(ByVal value As String)
_TipoOrigine = value
End Set
End Property
Private _TipoSorgente As enTipoSorgente
Friend Property TipoSorgente() As enTipoSorgente
Get
Return _TipoSorgente
End Get
Set(ByVal value As enTipoSorgente)
_TipoSorgente = value
End Set
End Property
Private _BufferClassiBase As String
Public ReadOnly Property BufferClassiBase() As String
Get
Return _BufferClassiBase
End Get
End Property
Private _BufferSQL As String = ""
Public ReadOnly Property BufferSQL() As String
Get
Return _BufferSQL
End Get
End Property
Public Relazioni As New List(Of cRelazioneTabella)
Public Tabelle As New List(Of cTabella)
Public Sub ElaboraStruttura()
_BufferSQL = ""
ElaboraClassi()
ElaboraSQL()
End Sub
Private Function CreaTabellaSql(ByVal NomeTab As String) As String
Dim buffer As String
buffer = "DROP TABLE " & NomeTab & ";" & vbNewLine
buffer &= "CREATE TABLE " & NomeTab & ";" & vbNewLine
Return buffer
End Function
Private Function CreaChiaveSql(ByVal NomeTab As String, ByVal NomeCampoChiave As String) As String
Dim buffer As String
buffer = "CREATE INDEX idx" & NomeCampoChiave & " ON " & NomeTab & "(" & NomeCampoChiave & ") WITH PRIMARY;" & vbNewLine
Return buffer
End Function
Private Function CreaCampoSql(ByVal NomeTab As String, ByRef Campo As cCampoDb) As String
'"campo: " & col.Caption & " - allownull: " & col.AllowDBNull & " - autoincrement: " & col.AutoIncrement & " - tipo: " & col.DataType.ToString & " - size: " & col.MaxLength & " - defaultvalue: " & col.DefaultValue & " - readonly:" & col.ReadOnly
Dim buffer As String
buffer = Campo.Nome
Select Case Campo.TipoStringa
Case Is = "int32"
If Campo.Contatore Then
buffer &= " COUNTER "
Else
buffer &= " INT"
End If
Case Is = "int16"
If Campo.Contatore Then
buffer &= " COUNTER "
Else
buffer &= " INT"
End If
Case Is = "String"
If Campo.MaxLength < 256 Then
buffer &= " TEXT"
Else
buffer &= " MEMO"
End If
Case Is = "Decimal"
buffer &= " SINGLE"
Case Is = "Boolean"
buffer &= " YESNO "
Case Else
buffer &= " " & Campo.TipoStringa.ToUpper
End Select
' buffer &= " " & Campo.DataType.Name
If Campo.TipoStringa = "String" And Campo.MaxLength < 256 Then buffer &= " (" & Campo.MaxLength & ")"
If Campo.DefaultValue.ToString.Length Then buffer &= " DEFAULT " & Campo.DefaultValue
buffer &= " " & IIf(Campo.AllowDBNull, "NULL", "NOT NULL")
buffer = "ALTER TABLE " & NomeTab & " ADD COLUMN " & buffer & ";" & vbNewLine
'buffer &= ";" & vbNewLine
Return buffer
End Function
Private Sub ElaboraSQL()
Dim Tb As cTabella
For Each Tb In Tabelle
Dim NomeTab As String = Tb.NomeTabella
If Tb.Selezionata Then
_BufferSQL &= CreaTabellaSql(NomeTab)
Dim Campo As cCampoDb, NomeCampoChiave As String = ""
For Each Campo In Tb.Campi
If Campo.Ordinal = 0 Then
NomeCampoChiave = Campo.Nome
End If
_BufferSQL &= CreaCampoSql(NomeTab, Campo)
Next
_BufferSQL &= CreaChiaveSql(NomeTab, NomeCampoChiave)
'_BufferSQL &= CreaInsertDati(NomeTab)
_BufferSQL &= vbNewLine
End If
Next
End Sub
Private Function AggiungiIntestazione(Optional ByVal AggiungiImports As Boolean = True) As String
Dim Buffer As String = ""
Buffer = "#Region ""Author""" & vbNewLine
Buffer &= "'Class created with Luna " & My.Application.Info.Version.Major & "." & My.Application.Info.Version.Minor & "." & My.Application.Info.Version.Build & "." & My.Application.Info.Version.Revision & vbNewLine
Buffer &= "'Author: Diego Lunadei" & vbNewLine
Buffer &= "'Date: " & Now.ToShortDateString & vbNewLine
Buffer &= "#End Region" & vbNewLine & vbNewLine
If AggiungiImports Then
'imports System
Buffer &= "Imports System" & vbNewLine
'imports System.xml
Buffer &= "Imports System.Xml" & vbNewLine
Buffer &= "Imports System.Xml.Serialization" & vbNewLine
'imports System.Data
Buffer &= "Imports System.Data" & vbNewLine
'imports System.Data.OleDb
Buffer &= "Imports System.Data.OleDb" & vbNewLine & vbNewLine
End If
Return Buffer
End Function
Private Sub ElaboraClassi()
'Nuova implementazione creare un singolo file e una singola tab per ogni classe e per ogni classe DAL
'dare la possibilita di salvare in automatico i file in formato vb
_BufferClassiBase = AggiungiBaseClass()
Dim Tb As cTabella
Dim Indice As Integer = 0
For Each Tb In Tabelle
If Tb.Selezionata Then
Tb.CodiceClasseEntity = AggiungiIntestazione(True) '(False)
Tb.CodiceClasse = AggiungiIntestazione(False)
'non aggiungo piu l'intestazione perch� � contenuta nella classe Entity
'Tb.CodiceDAL = AggiungiIntestazione()
'NomeTab = NomeTab.Substring(0, 1).ToUpper & NomeTab.Substring(1).ToLower
Tb.CodiceClasse &= "Public Class " & Tb.NomeClasse & vbNewLine & vbNewLine
Tb.CodiceClasse &= "#Region ""Logic Field""" & vbNewLine & vbNewLine
Tb.CodiceClasse &= "#End Region" & vbNewLine & vbNewLine
Tb.CodiceClasse &= "#Region ""Method""" & vbNewLine & vbNewLine
Tb.CodiceClasse &= "#End Region" & vbNewLine & vbNewLine
Tb.CodiceClasse &= "End Class" & vbNewLine & vbNewLine
Tb.CodiceClasseEntity &= "Partial Public Class " & Tb.NomeClasse
Tb.CodiceClasseEntity &= vbNewLine & "Inherits LUNA.LunaBaseClass" & vbNewLine
Tb.CodiceClasseEntity &= "'******IMPORTANT: Write your code in the Class object that use this Partial Class." & vbNewLine
Tb.CodiceClasseEntity &= "'******So you can replace DAOClass and EntityClass without lost your code" & vbNewLine
Tb.CodiceClasseEntity &= vbNewLine
Tb.CodiceClasseEntity &= "Public Sub New()" & vbNewLine & vbNewLine
Tb.CodiceClasseEntity &= "End Sub" & vbNewLine & vbNewLine
Tb.CodiceClasseEntity &= "#Region ""Database Field Map""" & vbNewLine
Dim Campo As cCampoDb, NomeCampoChiave As String = ""
For Each Campo In Tb.Campi
If Campo.Ordinal = 0 Then
NomeCampoChiave = Campo.Nome
End If
Tb.CodiceClasseEntity &= CreaCampoClasse(Campo)
Next
Tb.CodiceClasseEntity &= "#End Region" & vbNewLine & vbNewLine
'Le classi sono volutamente lasciate aperte per poi chiuderle una volta inserite le relazioni
'Tb.CodiceClasse &= "End Class " & vbNewLine & vbNewLine
Dim Dal As String
Dal = AggiungiDAO(NomeCampoChiave, Tb)
Tb.CodiceDAL &= Dal & vbNewLine
'TODO: SISTEMARE l'accesso ai dati facendolo direttamente e non con le replace
Select Case _TipoSorgente
'Case enTipoSorgente.Access
Case enTipoSorgente.SQLServer
Tb.CodiceDAL = Tb.CodiceDAL.Replace("OleDb.OleDbConnection", "SqlClient.SqlConnection") 'DA SISTEMARE
Tb.CodiceDAL = Tb.CodiceDAL.Replace("System.Data.OleDb", "System.Data.SqlClient")
Tb.CodiceDAL = Tb.CodiceDAL.Replace("OleDbCommand", "SqlCommand")
Tb.CodiceDAL = Tb.CodiceDAL.Replace("OleDbDataReader", "SqlDataReader")
Tb.CodiceDAL = Tb.CodiceDAL.Replace("OleDbTransaction", "SqlTransaction")
Case enTipoSorgente.Oracle
Tb.CodiceDAL = Tb.CodiceDAL.Replace("OleDb.OleDbConnection", "OracleConnection") 'DA SISTEMARE
Tb.CodiceDAL = Tb.CodiceDAL.Replace("System.Data.OleDb", "System.Data.OracleClient")
Tb.CodiceDAL = Tb.CodiceDAL.Replace("OleDbCommand", "OracleCommand")
Tb.CodiceDAL = Tb.CodiceDAL.Replace("OleDbDataReader", "OracleDataReader")
Tb.CodiceDAL = Tb.CodiceDAL.Replace("OleDbTransaction", "OracleTransaction")
End Select
Indice += 1
'qui metto tutte le classi figlie che trovo
Dim Rel As cRelazioneTabella
Tb.CodiceClasseEntity &= "#Region ""Embedded Class""" & vbNewLine & vbNewLine
For Each Rel In Relazioni
Dim tbOrig As cTabella = Tabelle.Find(Function(item) item.NomeTabella = Rel.TabellaOrigine)
Dim tbDest As cTabella = Tabelle.Find(Function(item) item.NomeTabella = Rel.TabellaDestinazione)
If Rel.TabellaOrigine = Tb.NomeTabella Then
Tb.CodiceClasseEntity &= AggiungiRelazioneDiretta(Rel, tbOrig, tbDest)
ElseIf Rel.TabellaDestinazione = Tb.NomeTabella Then
Tb.CodiceClasseEntity &= AggiungiRelazioneInDiretta(Rel, tbOrig, tbDest)
End If
Next
Tb.CodiceClasseEntity &= "#End Region" & vbNewLine & vbNewLine
Tb.CodiceClasseEntity &= "End Class " & vbNewLine & vbNewLine
End If
Next
End Sub
Private Function AggiungiRelazioneDiretta(ByVal Rel As cRelazioneTabella, ByVal TbOrig As cTabella, ByVal TbDest As cTabella) As String
Dim buffer As String = ""
If Rel.CampoOrigine = TbOrig.CampoChiave.Nome Then
'se sto facendo una relazione dal mio campo chiave verso un altra tabella dove dentro c'e' il mio campo chiave e' una relazione uno a N quindi torno una List Of
buffer &= "Private _List" & TbDest.NomeClasse & " as List(Of " & TbDest.NomeClasse & ")" & vbNewLine
buffer &= vbNewLine
buffer &= "<XmlElementAttribute(""List" & TbDest.NomeClasse & """)> _" & vbNewLine
buffer &= "Public Property List" & TbDest.NomeClasse & "(Optional ByVal ForceLoad As Boolean = False) as List(Of " & TbDest.NomeClasse & ")" & vbNewLine
buffer &= "Get" & vbNewLine
buffer &= vbTab & "If _List" & TbDest.NomeClasse & " Is Nothing Or ForceLoad = True Then" & vbNewLine
buffer &= vbTab & vbTab & "Dim Mgr As New " & TbDest.NomeClasseDAO & vbNewLine
buffer &= vbTab & vbTab & "Dim Param1 As New LUNA.LunaSearchParameter(""" & Rel.CampoDestinazione & """, _" & Rel.CampoOrigine & ")" & vbNewLine
buffer &= vbTab & vbTab & "_List" & TbDest.NomeClasse & " = Mgr.Find(Param1)" & vbNewLine
buffer &= vbTab & "End If" & vbNewLine
buffer &= vbTab & "Return _List" & TbDest.NomeClasse & vbNewLine
buffer &= "End Get" & vbNewLine
buffer &= "Set (ByVal value As List(Of " & TbDest.NomeClasse & "))" & vbNewLine
buffer &= vbTab & "_List" & TbDest.NomeClasse & " = value" & vbNewLine
buffer &= "End Set" & vbNewLine
buffer &= "End Property" & vbNewLine & vbNewLine
Else
'se sto facendo una relazione non dal mio campo chiave verso un altra tabella al suo campo chiave e' una relazione 1 a 1
'qui anche devo caricare l'oggetto solo se non � gia caricato
'qui devo entrarci se esiste il campo _CampoOrigine dentro la tabella destinazione
If Not TbOrig.Campi.Find(Function(item) item.Nome = Rel.CampoOrigine) Is Nothing Then
buffer &= "Private _" & TbDest.NomeClasse & " As " & TbDest.NomeClasse & vbNewLine
buffer &= "Public property " & TbDest.NomeClasse & "(Optional ByVal ForceLoad As Boolean = False) As " & TbDest.NomeClasse & vbNewLine
buffer &= "Get" & vbNewLine
buffer &= vbTab & "If _" & TbDest.NomeClasse & " Is Nothing Or ForceLoad = True Then" & vbNewLine
buffer &= vbTab & vbTab & "Dim Mgr As New " & TbDest.NomeClasseDAO & vbNewLine
buffer &= vbTab & vbTab & "_" & TbDest.NomeClasse & " = Mgr.Read(_" & Rel.CampoOrigine & ")" & vbNewLine
buffer &= vbTab & "End If" & vbNewLine
buffer &= vbTab & "Return _" & TbDest.NomeClasse & vbNewLine
buffer &= "End Get" & vbNewLine
buffer &= "Set(ByVal value As " & TbDest.NomeClasse & ")" & vbNewLine
buffer &= vbTab & "_" & TbDest.NomeClasse & " = value" & vbNewLine
buffer &= "End Set" & vbNewLine
buffer &= "End Property" & vbNewLine & vbNewLine
End If
End If
Return buffer
End Function
Private Function AggiungiRelazioneInDiretta(ByVal Rel As cRelazioneTabella, ByVal TbOrig As cTabella, ByVal TbDest As cTabella) As String
Dim buffer As String = ""
If Rel.CampoOrigine <> TbOrig.CampoChiave.Nome Then
'se sto facendo una relazione dal mio campo chiave verso un altra tabella dove dentro c'e' il mio campo chiave e' una relazione uno a N quindi torno una List Of
buffer &= "Private _List" & TbOrig.NomeClasse & " as List(Of " & TbOrig.NomeClasse & ")" & vbNewLine
buffer &= vbNewLine
buffer &= "<XmlElementAttribute(""List" & TbOrig.NomeClasse & """)> _" & vbNewLine
buffer &= "Public Property List" & TbOrig.NomeClasse & "(Optional ByVal ForceLoad As Boolean = False) as List(Of " & TbOrig.NomeClasse & ")" & vbNewLine
buffer &= "Get" & vbNewLine
buffer &= vbTab & "If _List" & TbOrig.NomeClasse & " Is Nothing Or ForceLoad = True Then" & vbNewLine
buffer &= vbTab & vbTab & "Dim Mgr As New " & TbOrig.NomeClasseDAO & vbNewLine
buffer &= vbTab & vbTab & "Dim Param1 As New LUNA.LunaSearchParameter(""" & Rel.CampoOrigine & """, _" & Rel.CampoDestinazione & ")" & vbNewLine
buffer &= vbTab & vbTab & "_List" & TbOrig.NomeClasse & " = Mgr.Find(Param1)" & vbNewLine
buffer &= vbTab & "End If" & vbNewLine
buffer &= vbTab & "Return _List" & TbOrig.NomeClasse & vbNewLine
buffer &= "End Get" & vbNewLine
buffer &= "Set (ByVal value As List(Of " & TbOrig.NomeClasse & "))" & vbNewLine
buffer &= vbTab & "_List" & TbOrig.NomeClasse & " = value" & vbNewLine
buffer &= "End Set" & vbNewLine
buffer &= "End Property" & vbNewLine & vbNewLine
'Else
' 'se sto facendo una relazione non dal mio campo chiave verso un altra tabella al suo campo chiave e' una relazione 1 a 1
' 'qui anche devo caricare l'oggetto solo se non � gia caricato
' 'qui devo entrarci se esiste il campo _CampoOrigine dentro la tabella destinazione
' If Not TbOrig.Campi.Find(Function(item) item.Nome = Rel.CampoOrigine) Is Nothing Then
' buffer &= "Private _" & TbDest.NomeClasse & " As " & TbDest.NomeClasse & vbNewLine
' buffer &= "Public property " & TbDest.NomeClasse & "(Optional ByVal ForceLoad As Boolean = False) As " & TbDest.NomeClasse & vbNewLine
' buffer &= "Get" & vbNewLine
' buffer &= vbTab & "If _" & TbDest.NomeClasse & " Is Nothing Or ForceLoad = True Then" & vbNewLine
' buffer &= vbTab & vbTab & "Dim Mgr As New " & TbDest.NomeClasseDAO & vbNewLine
' buffer &= vbTab & vbTab & "_" & TbDest.NomeClasse & " = Mgr.Read(_" & Rel.CampoOrigine & ")" & vbNewLine
' buffer &= vbTab & "End If" & vbNewLine
' buffer &= vbTab & "Return _" & TbDest.NomeClasse & vbNewLine
' buffer &= "End Get" & vbNewLine
' buffer &= "Set(ByVal value As " & TbDest.NomeClasse & ")" & vbNewLine
' buffer &= vbTab & "_" & TbDest.NomeClasse & " = value" & vbNewLine
' buffer &= "End Set" & vbNewLine
' buffer &= "End Property" & vbNewLine & vbNewLine
' End If
End If
Return buffer
End Function
Private Function AggiungiBaseClass() As String
Dim Buffer As String
Buffer = AggiungiIntestazione()
Buffer &= "Namespace LUNA" & vbNewLine & vbNewLine
Buffer &= "Public Enum enLogicOperator" & vbNewLine
Buffer &= vbTab & "enAND = 0" & vbNewLine
Buffer &= vbTab & "enOR" & vbNewLine
Buffer &= "End Enum" & vbNewLine & vbNewLine
Buffer &= "Public MustInherit Class LunaBaseClass" & vbNewLine & vbNewLine
Select Case _TipoSorgente
Case enTipoSorgente.Access
Buffer &= "Protected Shared _cn As OleDb.OleDbConnection" & vbNewLine
Case enTipoSorgente.SQLServer
Buffer &= "Protected Shared _cn As SqlClient.SqlConnection" & vbNewLine
Case enTipoSorgente.Oracle
Buffer &= "Protected Shared _cn As OracleConnection" & vbNewLine
End Select
Buffer &= "Protected Shared _ConnectionString As String = String.Empty" & vbNewLine & vbNewLine
Buffer &= "Public Sub ManageError(ByVal ex As Exception)" & vbNewLine & vbNewLine
Buffer &= "End Sub" & vbNewLine & vbNewLine
Buffer &= "End Class" & vbNewLine & vbNewLine
Buffer &= "Public MustInherit Class LunaBaseClassDAO(Of T)" & vbNewLine
Buffer &= "Inherits LunaBaseClass" & vbNewLine & vbNewLine
Buffer &= "Public Sub New()" & vbNewLine & vbNewLine
Buffer &= vbTab & "'By default use ConnectionString in AppSettings" & vbNewLine
Buffer &= vbTab & "_ConnectionString = My.Settings(""ConnectionString"").ToString" & vbNewLine
Buffer &= vbTab & "OpenDBConnection()" & vbNewLine
Buffer &= "End Sub" & vbNewLine & vbNewLine
Select Case _TipoSorgente
Case enTipoSorgente.Access
Buffer &= "Public Sub New(ByVal Connection As Data.OleDb.OleDbConnection)" & vbNewLine
Case enTipoSorgente.SQLServer
Buffer &= "Public Sub New(ByVal Connection As SqlClient.SqlConnection)" & vbNewLine
Case enTipoSorgente.Oracle
Buffer &= "Public Sub New(ByVal Connection As OracleConnection)" & vbNewLine
End Select
Buffer &= vbTab & "_cn = Connection" & vbNewLine
Buffer &= vbTab & "OpenDBConnection()" & vbNewLine
Buffer &= "End Sub" & vbNewLine & vbNewLine
Buffer &= "Public Sub New(ByVal ConnectionString As string)" & vbNewLine
Buffer &= vbTab & "if ConnectionString.Length <>0 then " & vbNewLine
Buffer &= vbTab & vbTab & "_ConnectionString = ConnectionString" & vbNewLine
Buffer &= vbTab & vbTab & "OpenDBConnection()" & vbNewLine
Buffer &= vbTab & "End if" & vbNewLine
Buffer &= "End Sub" & vbNewLine & vbNewLine
Buffer &= "Public MustOverride Function Read(ByVal Id As Integer) As T" & vbNewLine
Buffer &= "Public MustOverride Function Save(ByRef obj As T) As Integer" & vbNewLine
Buffer &= "Public MustOverride Sub Delete(ByVal Id As Integer)" & vbNewLine
Buffer &= "Public MustOverride Sub Delete(ByRef obj As T, Optional ByRef ListaObj As List(Of T) = Nothing)" & vbNewLine
Buffer &= "Public MustOverride Function Find(ByVal ParamArray Parameter() As Luna.LunaSearchParameter) As IEnumerable(Of T)" & vbNewLine
Buffer &= "Public MustOverride Function GetAll(Optional ByVal OrderByField As String = """", Optional ByVal AddEmptyItem As Boolean = False) As IEnumerable(Of T)" & vbNewLine & vbNewLine
Buffer &= "Protected Function OpenDBConnection() As Integer" & vbNewLine
Buffer &= "Dim Ris As Integer = 0" & vbNewLine
Buffer &= "Try" & vbNewLine
Buffer &= vbTab & "If _cn Is Nothing Then _cn = New OleDb.OleDbConnection" & vbNewLine
Buffer &= vbTab & "if _cn.ConnectionString.Length =0 then _cn.ConnectionString = _ConnectionString" & vbNewLine
Buffer &= vbTab & "If _cn.State <> Data.ConnectionState.Open Then _cn.Open()" & vbNewLine
Buffer &= vbTab & "Catch ex As Exception" & vbNewLine
Buffer &= vbTab & vbTab & "Ris = 1" & vbNewLine
Buffer &= vbTab & "End Try" & vbNewLine
Buffer &= vbTab & "Return Ris" & vbNewLine
Buffer &= "End Function" & vbNewLine & vbNewLine
Buffer &= "Protected Function CloseDbConnection() As Integer" & vbNewLine
Buffer &= "Dim Ris As Integer = 0" & vbNewLine
Buffer &= "Try" & vbNewLine
Buffer &= vbTab & "If Not _cn Is Nothing Then" & vbNewLine
Buffer &= vbTab & vbTab & "If _cn.State = ConnectionState.Open Then" & vbNewLine
Buffer &= vbTab & vbTab & vbTab & "_cn.Close()" & vbNewLine
Buffer &= vbTab & vbTab & "End If" & vbNewLine
Buffer &= vbTab & "_cn = Nothing" & vbNewLine
Buffer &= vbTab & "End If" & vbNewLine
Buffer &= "Catch ex As Exception" & vbNewLine
Buffer &= vbTab & "Ris = 1" & vbNewLine
Buffer &= "End Try" & vbNewLine
Buffer &= "Return Ris" & vbNewLine
Buffer &= "End Function" & vbNewLine & vbNewLine
Buffer &= "Public Function Ap(ByVal Testo) As String" & vbNewLine
Buffer &= "Dim str As String = String.Empty" & vbNewLine
Buffer &= "If Not TypeOf Testo Is String Then" & vbNewLine
Buffer &= vbTab & "Str = "" "" & Testo.ToString" & vbNewLine
Buffer &= "Else" & vbNewLine
Buffer &= vbTab & "Str = Testo.ToString" & vbNewLine
Buffer &= vbTab & "Str = Str.Replace(""'"", ""''"")" & vbNewLine
Buffer &= vbTab & "Str = "" '"" & Str & ""'""" & vbNewLine
Buffer &= "End If" & vbNewLine
Buffer &= "Return Str" & vbNewLine
Buffer &= "End Function" & vbNewLine & vbNewLine
'METODI DI SERIALIZZAZIONE
Buffer &= "#Region ""Serialization Method""" & vbNewLine
Buffer &= AggiungiLeggiSerialize()
Buffer &= AggiungiSalvaSerialize()
Buffer &= "#End Region" & vbNewLine & vbNewLine
Buffer &= "End Class" & vbNewLine & vbNewLine
Buffer &= "Public Class LunaSearchParameter" & vbNewLine & vbNewLine
Buffer &= "Public Sub New()" & vbNewLine & vbNewLine
Buffer &= "End Sub" & vbNewLine & vbNewLine
Buffer &= "Public Sub New(ByVal FieldName As String, ByVal Value As Object, Optional ByVal SqlOperator As String = """",Optional ByVal LogicOperator As enLogicOperator = enLogicOperator.enAND)" & vbNewLine
Buffer &= vbTab & "_FieldName = FieldName" & vbNewLine
Buffer &= vbTab & "_Value = Value" & vbNewLine
Buffer &= vbTab & "If SqlOperator.Length Then _SqlOperator = SqlOperator" & vbNewLine
Buffer &= vbTab & "_LogicOperator = LogicOperator" & vbNewLine
Buffer &= "End Sub" & vbNewLine & vbNewLine
Buffer &= "Private _SqlOperator As String = "" = """ & vbNewLine
Buffer &= "Public Property SqlOperator As String" & vbNewLine
Buffer &= vbTab & "Get" & vbNewLine
Buffer &= vbTab & vbTab & "Return _SqlOperator" & vbNewLine
Buffer &= vbTab & "End Get" & vbNewLine
Buffer &= vbTab & "Set(ByVal value As String)" & vbNewLine
Buffer &= vbTab & vbTab & "_SqlOperator = value" & vbNewLine
Buffer &= vbTab & "End Set" & vbNewLine
Buffer &= "End Property" & vbNewLine & vbNewLine
Buffer &= "Private _LogicOperator As enLogicOperator = enLogicOperator.enAND" & vbNewLine
Buffer &= "Public Property LogicOperator As enLogicOperator" & vbNewLine
Buffer &= vbTab & "Get" & vbNewLine
Buffer &= vbTab & vbTab & "Return _LogicOperator" & vbNewLine
Buffer &= vbTab & "End Get" & vbNewLine
Buffer &= vbTab & "Set(ByVal value As enLogicOperator)" & vbNewLine
Buffer &= vbTab & vbTab & "_LogicOperator = value" & vbNewLine
Buffer &= vbTab & "End Set" & vbNewLine
Buffer &= "End Property" & vbNewLine & vbNewLine
Buffer &= "Public ReadOnly Property LogicOperatorStr As String" & vbNewLine
Buffer &= vbTab & "Get" & vbNewLine
Buffer &= vbTab & vbTab & "If _LogicOperator = enLogicOperator.enAND Then" & vbNewLine
Buffer &= vbTab & vbTab & vbTab & "Return "" And """ & vbNewLine
Buffer &= vbTab & vbTab & " Else" & vbNewLine
Buffer &= vbTab & vbTab & vbTab & "Return "" Or """ & vbNewLine
Buffer &= vbTab & vbTab & "End If" & vbNewLine
Buffer &= vbTab & "End Get" & vbNewLine
Buffer &= "End Property" & vbNewLine & vbNewLine
Buffer &= "Private _FieldName As String" & vbNewLine
Buffer &= "Public Property FieldName As String" & vbNewLine
Buffer &= vbTab & "Get" & vbNewLine
Buffer &= vbTab & vbTab & "Return _FieldName" & vbNewLine
Buffer &= vbTab & "End Get" & vbNewLine
Buffer &= vbTab & "Set(ByVal value As String)" & vbNewLine
Buffer &= vbTab & vbTab & "_FieldName = value" & vbNewLine
Buffer &= vbTab & "End Set" & vbNewLine
Buffer &= "End Property" & vbNewLine & vbNewLine
Buffer &= "Private _Value" & vbNewLine
Buffer &= "Public Property Value" & vbNewLine
Buffer &= vbTab & "Get" & vbNewLine
Buffer &= vbTab & vbTab & "Return _Value" & vbNewLine
Buffer &= vbTab & "End Get" & vbNewLine
Buffer &= vbTab & "Set(ByVal value)" & vbNewLine
Buffer &= vbTab & vbTab & "_Value = value" & vbNewLine
Buffer &= vbTab & "End Set" & vbNewLine
Buffer &= "End Property" & vbNewLine & vbNewLine
Buffer &= "End Class" & vbNewLine & vbNewLine
Buffer &= "End Namespace" & vbNewLine & vbNewLine
Return Buffer
End Function
Private Function AggiungiDAO(ByVal NomeCampoChiave As String, ByRef TB As cTabella) As String
Dim ListaCampi As String = ""
For Each cam As cCampoDb In TB.Campi
ListaCampi &= cam.Nome & ","
Next
ListaCampi = ListaCampi.TrimEnd(",")
Dim c As cCampoDb
Dim Buffer As String
Buffer = "Public Class " & TB.NomeClasseDAO & vbNewLine
Buffer &= "Inherits LUNA.LunaBaseClassDAO(Of " & TB.NomeClasse & ")" & vbNewLine & vbNewLine
Buffer &= "Public Sub New()" & vbNewLine
Buffer &= vbTab & "MyBase.New()" & vbNewLine
Buffer &= "End Sub" & vbNewLine & vbNewLine
Buffer &= "Public Sub New(ByVal Connection As Data.OleDb.OleDbConnection)" & vbNewLine
Buffer &= vbTab & "MyBase.New(Connection)" & vbNewLine
Buffer &= "End Sub" & vbNewLine & vbNewLine
Buffer &= "Public Sub New(ByVal ConnectionString As string)" & vbNewLine
Buffer &= vbTab & "MyBase.New(ConnectionString)" & vbNewLine
Buffer &= "End Sub" & vbNewLine & vbNewLine
Buffer &= AggiungiLeggi(NomeCampoChiave, TB)
Buffer &= AggiungiSalva(NomeCampoChiave, TB)
Buffer &= AggiungiSalvaCascade(NomeCampoChiave, TB)
'TODO:WriteCascade
Buffer &= AggiungiElimina(NomeCampoChiave, TB)
Buffer &= "Public Overloads Function Find(ByVal OrderBy As String, ByVal ParamArray Parameter() As LUNA.LunaSearchParameter) as iEnumerable(Of " & TB.NomeClasse & ")" & vbNewLine
Buffer &= "Return FindReal(OrderBy, Parameter)" & vbNewLine
Buffer &= "End Function" & vbNewLine & vbNewLine
Buffer &= "Public Overrides Function Find(ByVal ParamArray Parameter() As LUNA.LunaSearchParameter) as iEnumerable(Of " & TB.NomeClasse & ")" & vbNewLine
Buffer &= "Return FindReal("""", Parameter)" & vbNewLine
Buffer &= "End Function" & vbNewLine & vbNewLine
Buffer &= "Private Function FindReal(ByVal OrderBy As String, ByVal ParamArray Parameter() As LUNA.LunaSearchParameter) as iEnumerable(Of " & TB.NomeClasse & ")" & vbNewLine
Buffer &= "Dim Ls As New List(Of " & TB.NomeClasse & ")" & vbNewLine
Buffer &= "Try" & vbNewLine & vbNewLine
Buffer &= "Dim myCommand As OleDbCommand = _cn.CreateCommand()" & vbNewLine
Buffer &= "Dim sql As String = """ & vbNewLine
Buffer &= "sql =""SELECT " & ListaCampi & " from " & TB.NomeTabella & """" & vbNewLine
Buffer &= "For Each Par As LUNA.LunaSearchParameter In Parameter" & vbNewLine
Buffer &= vbTab & "If Not Par Is Nothing Then" & vbNewLine
Buffer &= vbTab & vbTab & "If Sql.IndexOf(""WHERE"") = -1 Then Sql &= "" WHERE "" Else Sql &= "" "" & Par.LogicOperatorStr & "" """ & vbNewLine
Buffer &= vbTab & vbTab & "Sql &= Par.FieldName & "" "" & Par.SqlOperator & "" "" & Ap(Par.Value)" & vbNewLine
Buffer &= vbTab & "End if" & vbNewLine
Buffer &= "Next" & vbNewLine & vbNewLine
Buffer &= "If OrderBy.Length Then Sql &= "" ORDER BY "" & OrderBy" & vbNewLine & vbNewLine
Buffer &= "myCommand.CommandText = sql" & vbNewLine
Buffer &= "Dim myReader As OleDbDataReader = myCommand.ExecuteReader()" & vbNewLine
Buffer &= "while myReader.Read" & vbNewLine
Buffer &= vbTab & "Dim classe as new " & TB.NomeClasse & vbNewLine
For Each c In TB.Campi
Buffer &= vbTab & "if not myReader(""" & c.Nome & """) is DBNull.Value then classe." & c.Nome & " = myReader(""" & c.Nome & """)" & vbNewLine
Next
Buffer &= vbTab & "Ls.Add(classe)" & vbNewLine
Buffer &= "end while" & vbNewLine
Buffer &= "myReader.Close()" & vbNewLine
Buffer &= "myCommand.Dispose()" & vbNewLine & vbNewLine
Buffer &= "Catch ex As Exception" & vbNewLine
Buffer &= vbTab & "ManageError(ex)" & vbNewLine
Buffer &= "End Try" & vbNewLine
Buffer &= "Return Ls" & vbNewLine
Buffer &= "End Function" & vbNewLine & vbNewLine
Buffer &= "Public Overrides Function GetAll(Optional OrderByField as string = """", Optional ByVal AddEmptyItem As Boolean = False) as iEnumerable(Of " & TB.NomeClasse & ")" & vbNewLine
Buffer &= "Dim Ls As New List(Of " & TB.NomeClasse & ")" & vbNewLine
Buffer &= "Try" & vbNewLine & vbNewLine
Buffer &= "Dim myCommand As OleDbCommand = _cn.CreateCommand()" & vbNewLine
Buffer &= "Dim sql As String = """ & vbNewLine
Buffer &= "sql =""SELECT " & ListaCampi & " from " & TB.NomeTabella & """" & vbNewLine
Buffer &= "If OrderByField.Length Then" & vbNewLine
Buffer &= vbTab & "Sql &= "" ORDER BY "" & OrderByField" & vbNewLine
Buffer &= "End If" & vbNewLine & vbNewLine
Buffer &= "myCommand.CommandText = sql" & vbNewLine
Buffer &= "Dim myReader As OleDbDataReader = myCommand.ExecuteReader()" & vbNewLine
Buffer &= "If AddEmptyItem Then Ls.Add(New " & TB.NomeClasse & "() With {"
For Each c In TB.Campi
Buffer &= "." & c.Nome & c.ValoreDefault & ","
Next
Buffer = Buffer.TrimEnd(",")
'.IdGruppo = 0, .Nome = "" - All""
Buffer &= "})" & vbNewLine
Buffer &= "while myReader.Read" & vbNewLine
Buffer &= vbTab & "Dim classe as new " & TB.NomeClasse & vbNewLine
For Each c In TB.Campi
Buffer &= vbTab & "if not myReader(""" & c.Nome & """) is DBNull.Value then classe." & c.Nome & " = myReader(""" & c.Nome & """)" & vbNewLine
Next
Buffer &= vbTab & "Ls.Add(classe)" & vbNewLine
Buffer &= "end while" & vbNewLine
Buffer &= "myReader.Close()" & vbNewLine
Buffer &= "myCommand.Dispose()" & vbNewLine & vbNewLine
Buffer &= "Catch ex As Exception" & vbNewLine
Buffer &= vbTab & "ManageError(ex)" & vbNewLine
Buffer &= "End Try" & vbNewLine
Buffer &= "Return Ls" & vbNewLine
Buffer &= "End Function" & vbNewLine
Buffer &= "End Class" & vbNewLine & vbNewLine
Return Buffer
End Function
Private Function AggiungiLeggiSerialize() As String
Dim buffer As String = ""
buffer &= "Public Function ReadSerialize(ByVal PathXMLSerial As String) as T" & vbNewLine & vbNewLine
buffer &= "Dim cls As T" & vbNewLine
buffer &= vbTab & "Try" & vbNewLine
buffer &= vbTab & vbTab & "Dim serialize As XmlSerializer = New XmlSerializer(GetType(T))" & vbNewLine
buffer &= vbTab & vbTab & "Dim deSerialize As IO.FileStream = New IO.FileStream(PathXMLSerial, IO.FileMode.Open)" & vbNewLine
buffer &= vbTab & vbTab & "cls = serialize.Deserialize(deSerialize)" & vbNewLine
buffer &= vbTab & "Catch ex As Exception" & vbNewLine
buffer &= vbTab & vbTab & "ManageError(ex)" & vbNewLine
buffer &= vbTab & "End Try" & vbNewLine & vbNewLine
buffer &= "Return cls" & vbNewLine
buffer &= "End function" & vbNewLine
Return buffer
End Function
Private Function AggiungiLeggi(ByVal NomeCampoChiave As String, ByVal x As cTabella) As String
'TODO: Da rivedere meglio e ottimizzare
Dim Buffer As String
Buffer = "Public Overrides Function Read(Id as integer) as " & x.NomeClasse & vbNewLine
Buffer &= "Dim cls as new " & x.NomeClasse & vbNewLine & vbNewLine
Buffer &= "Try" & vbNewLine
Buffer &= "Dim myCommand As OleDbCommand = _cn.CreateCommand()" & vbNewLine
Buffer &= "myCommand.CommandText = ""SELECT * FROM " & x.NomeTabella & " where " & NomeCampoChiave & " = "" & Id" & vbNewLine
'Buffer &= Istruzione("select1", NomeTab, NomeCampoChiave) & vbNewLine
Buffer &= "Dim myReader As OleDbDataReader = myCommand.ExecuteReader()" & vbNewLine
Buffer &= "myReader.Read()" & vbNewLine
Buffer &= "if myReader.HasRows then" & vbNewLine
Dim col As cCampoDb
For Each col In x.Campi
If col.AllowDBNull Then Buffer &= vbTab & "if not myReader(""" & col.Nome & """) is DBNull.Value then" & vbNewLine & vbTab
Buffer &= vbTab & "cls." & col.Nome & "= myReader(""" & col.Nome & """)"
'If col.AllowDBNull Then Buffer &= ".toString"
If col.AllowDBNull Then Buffer &= vbNewLine & vbTab & "end if"
Buffer &= vbNewLine
Next
Buffer &= "End If" & vbNewLine
Buffer &= "myReader.Close()" & vbNewLine
Buffer &= "myCommand.Dispose()" & vbNewLine & vbNewLine
Buffer &= "Catch ex As Exception" & vbNewLine
Buffer &= vbTab & "ManageError(ex)" & vbNewLine
Buffer &= "End Try" & vbNewLine
Buffer &= "Return cls" & vbNewLine
Buffer &= "End Function" & vbNewLine & vbNewLine
Return Buffer
End Function
Private Function AggiungiElimina(ByVal NomeCampoChiave As String, ByVal TB As cTabella)
Dim Buffer As String = ""
Buffer &= "Private Sub DestroyPermanently(Id as integer) " & vbNewLine
Buffer &= "Try" & vbNewLine & vbNewLine
Buffer &= "Dim UpdateCommand As OleDbCommand = New OleDbCommand()" & vbNewLine
Buffer &= "UpdateCommand.Connection = _cn" & vbNewLine & vbNewLine
Buffer &= "'******IMPORTANT: You can use this commented instruction to make a logical delete ." & vbNewLine
Buffer &= "'******Replace DELETED Field with your logic deleted field name." & vbNewLine
Buffer &= "'Dim Sql As String = ""UPDATE " & TB.NomeTabella & " SET DELETED=True """ & vbNewLine
Buffer &= "Dim Sql As String = ""DELETE FROM " & TB.NomeTabella & """" & vbNewLine
Buffer &= "Sql &= "" Where " & NomeCampoChiave & " = "" & Id " & vbNewLine & vbNewLine
Buffer &= "UpdateCommand.CommandText = Sql" & vbNewLine
Buffer &= "UpdateCommand.ExecuteNonQuery()" & vbNewLine
Buffer &= "UpdateCommand.Dispose()" & vbNewLine
Buffer &= "Catch ex As Exception" & vbNewLine
Buffer &= vbTab & "ManageError(ex)" & vbNewLine
Buffer &= "End Try" & vbNewLine
Buffer &= "End Sub" & vbNewLine & vbNewLine
Buffer &= "Public Overrides Sub Delete(Id as integer) " & vbNewLine & vbNewLine
Buffer &= "DestroyPermanently (Id)" & vbNewLine & vbNewLine
Buffer &= "End Sub" & vbNewLine & vbNewLine
Buffer &= "Public Overrides Sub Delete(byref obj as " & TB.NomeClasse & ", Optional ByRef ListaObj as List (of " & TB.NomeClasse & ") = Nothing)" & vbNewLine & vbNewLine
Buffer &= "DestroyPermanently (obj." & NomeCampoChiave & ")" & vbNewLine
Buffer &= "If Not ListaObj Is Nothing Then ListaObj.Remove(obj)" & vbNewLine & vbNewLine
Buffer &= "End Sub" & vbNewLine & vbNewLine
Return Buffer
End Function
Private Function AggiungiSalvaCascade(ByVal NomeCampoChiave As String, ByVal x As cTabella) As String
'''Aggiunge il salvataggio a cascata
Dim Buffer As String = ""
Return Buffer
End Function
Private Function AggiungiSalva(ByVal NomeCampoChiave As String, ByVal x As cTabella) As String
'TODO: Da rivedere meglio e ottimizzare
Dim Buffer As String
Buffer = "Public Overrides Function Save(byRef cls as " & x.NomeClasse & ") as Integer" & vbNewLine & vbNewLine
Buffer &= "Dim Ris as integer=0 'in Ris torno l'id inserito" & vbNewLine & vbNewLine
Buffer &= "Dim DbCommand As OleDbCommand = New OleDbCommand()" & vbNewLine
Buffer &= "Dim myTransaction As OleDbTransaction" & vbNewLine
Buffer &= vbTab & "Try" & vbNewLine
Buffer &= vbTab & vbTab & "Dim sql As String" & vbNewLine
Buffer &= vbTab & vbTab & "DbCommand.Connection = _cn" & vbNewLine
Buffer &= vbTab & vbTab & "myTransaction = _cn.BeginTransaction" & vbNewLine
Buffer &= vbTab & vbTab & "DbCommand.Transaction = myTransaction" & vbNewLine
Buffer &= vbTab & vbTab & "If cls." & NomeCampoChiave & " = 0 Then" & vbNewLine
Buffer &= vbTab & vbTab & vbTab & "sql = ""INSERT INTO " & x.NomeTabella & "(" & """" & vbNewLine
Dim col As cCampoDb
For Each col In x.Campi
If col.Nome <> NomeCampoChiave Then
Buffer &= vbTab & vbTab & vbTab & "sql &= """ & col.Nome
If col.Ordinal + 1 <> x.Campi.Count Then
Buffer &= ","
End If
Buffer &= """" & vbNewLine
End If
Next
Buffer &= vbTab & vbTab & vbTab & vbTab & "sql &= "") VALUES (""" & vbNewLine
For Each col In x.Campi
If col.Nome <> NomeCampoChiave Then
Select Case col.TipoStringa
Case "int16", "int32", "single", "double"
Buffer &= vbTab & "sql &= cls." & col.Nome
Case "Boolean"
Buffer &= vbTab & "sql &= iif(cls." & col.Nome & ",-1,0)"
Case Else
Buffer &= vbTab & "sql &= ap(cls." & col.Nome & ")"
End Select
If col.Ordinal + 1 <> x.Campi.Count Then
Buffer &= " & "","""
End If
Buffer &= vbNewLine
End If
Next
Buffer &= vbTab & vbTab & vbTab & vbTab & "sql &= "")""" & vbNewLine
Buffer &= vbTab & vbTab & "Else" & vbNewLine
Buffer &= vbTab & vbTab & vbTab & "sql = ""UPDATE " & x.NomeTabella & " SET """ & vbNewLine
For Each col In x.Campi
If col.Nome <> NomeCampoChiave Then
Buffer &= vbTab & vbTab & vbTab & "sql &= """ & col.Nome & " = """
Select Case col.TipoStringa
Case "int16", "int32", "single", "double"
Buffer &= " & cls." & col.Nome
Case "Boolean"
Buffer &= " & iif(cls." & col.Nome & ",true,False)"
Case Else
Buffer &= " & ap(cls." & col.Nome & ")"
End Select
If col.Ordinal + 1 <> x.Campi.Count Then
Buffer &= " & "","""
End If
Buffer &= vbNewLine
End If
Next
Buffer &= vbTab & vbTab & vbTab & vbTab & "sql &= "" WHERE " & NomeCampoChiave & "= "" & cls." & NomeCampoChiave & vbNewLine
Buffer &= vbTab & vbTab & "End if" & vbNewLine
Buffer &= vbTab & vbTab & "DbCommand.CommandText = sql" & vbNewLine
Buffer &= vbTab & vbTab & "DbCommand.ExecuteNonQuery()" & vbNewLine & vbNewLine
Buffer &= vbTab & vbTab & " If cls." & NomeCampoChiave & "=0 Then" & vbNewLine
Buffer &= vbTab & vbTab & vbTab & "Dim IdInserito as integer = 0" & vbNewLine
Buffer &= vbTab & vbTab & vbTab & "Sql = ""select @@identity""" & vbNewLine
Buffer &= vbTab & vbTab & vbTab & "DbCommand.CommandText = Sql" & vbNewLine
Buffer &= vbTab & vbTab & vbTab & "Idinserito = DbCommand.ExecuteScalar()" & vbNewLine
Buffer &= vbTab & vbTab & vbTab & "cls." & NomeCampoChiave & " = Idinserito" & vbNewLine
Buffer &= vbTab & vbTab & vbTab & "Ris = Idinserito" & vbNewLine
Buffer &= vbTab & vbTab & "else" & vbNewLine
Buffer &= vbTab & vbTab & vbTab & "Ris = cls." & NomeCampoChiave & vbNewLine
Buffer &= vbTab & vbTab & "End If" & vbNewLine & vbNewLine
Buffer &= vbTab & vbTab & "myTransaction.Commit()" & vbNewLine
Buffer &= vbTab & vbTab & "DbCommand.Dispose()" & vbNewLine & vbNewLine
Buffer &= vbTab & "Catch ex As Exception" & vbNewLine
Buffer &= vbTab & vbTab & "myTransaction.RollBack()" & vbNewLine
Buffer &= vbTab & vbTab & "ManageError(ex)" & vbNewLine
Buffer &= vbTab & "End Try" & vbNewLine
Buffer &= "Return Ris" & vbNewLine
Buffer &= "End Function" & vbNewLine & vbNewLine
Return Buffer
End Function
Private Function AggiungiSalvaSerialize() As String
Dim buffer As String = ""
buffer &= "Public Sub SaveSerialize(Obj as T, ByVal PathXML As String)" & vbNewLine & vbNewLine
buffer &= "Try" & vbNewLine
buffer &= vbTab & "Dim serialize As XmlSerializer = New XmlSerializer(GetType(T))" & vbNewLine
buffer &= vbTab & "Dim Writer As New System.IO.StreamWriter(PathXML)" & vbNewLine
buffer &= vbTab & "serialize.Serialize(Writer, Obj)" & vbNewLine
buffer &= vbTab & "Writer.Close()" & vbNewLine
buffer &= vbTab & "Catch ex As Exception" & vbNewLine
buffer &= vbTab & vbTab & "ManageError(ex)" & vbNewLine
buffer &= vbTab & "End Try" & vbNewLine & vbNewLine
buffer &= "End Sub" & vbNewLine
Return buffer
End Function
Private Function CreaCampoClasse(ByRef Campo As cCampoDb) As String
'"campo: " & col.Caption & " - allownull: " & col.AllowDBNull & " - autoincrement: " & col.AutoIncrement & " - tipo: " & col.DataType.ToString & " - size: " & col.MaxLength & " - defaultvalue: " & col.DefaultValue & " - readonly:" & col.ReadOnly
Dim buffer As String
buffer = vbNewLine & "Private _" & Campo.Nome & " as " & Campo.TipoStringa & Campo.ValoreDefault
buffer &= vbNewLine & vbNewLine
buffer &= "<XmlElementAttribute(""" & Campo.Nome & """)> _" & vbNewLine
buffer &= "Public property " & Campo.Nome & "() as " & Campo.TipoStringa & vbNewLine
buffer &= "Get" & vbNewLine
buffer &= vbTab & "Return _" & Campo.Nome & vbNewLine
buffer &= "End Get" & vbNewLine
buffer &= "Set (byval value as " & Campo.TipoStringa & ")" & vbNewLine
buffer &= vbTab & "_" & Campo.Nome & "= value" & vbNewLine
buffer &= "End Set" & vbNewLine
buffer &= "End property " & vbNewLine
Return buffer
End Function
End Class
Submit an article or tip