Database - Crea Database Tabelle Campi Indic iRelazioni!!

Visual # '********************************************************************************************
' Name.........:CreateDB
' Parameters...:Nessuno
' Return Value.:Boolean; se tutte le operazioni sono ok allora True else False
' Purpose......:Questa funzione viene chiamata da bottone nel tab degli Strumenti
'               Essa crea un database nuovo con lo schema necessario
' Note.........:Nessuna
'********************************************************************************************
Public Function CreateDB() As Boolean
    
    Dim intNumDocsType As Integer
    Dim strTempDbs As String
    Dim wspNewSearchDB As Workspace
    Dim dbsNewSearchDB As Database
    Dim TabellaDatabase, _
        TabellaTabelle, _
        TabellaCampi As TableDef
    Dim FldDatabase(2), _
        FldTabelle(6), _
        FldCampi(5), _
        fldParola(2), _
        fldParolaNonValida(2) As Field
    Dim idxTipoDocumento(2), _
        idxTabella(4), _
        idxCampi(2), _
        idxParola(2), _
        idxParolaNonValida(2), idxTipotabella(2) As Index
    Dim relParolaOccorrenza, _
        relTipoDocumentoDocumento, _
        relDocumentoOccorrenza  As Relation
    Dim fldParolaOccorrenzaRel, _
        FldDatabaseDocumentoRel, _
        FldTabelleOccorrenzaRel As Field
    Dim Relnuovo
    Dim UDTFiles As String
    
    ' On Error GoTo ERROR_HANDLER
    ChDir App.Path
    'UDTFiles = App.Path & "\Nuovo.Mdb"
    UDTFiles = "NuovoDB.Mdb"
    
    ' veriica dell'esistenza di un file con il nome del nuovo database.
    If Dir(UDTFiles) <> "" Then
        MsgBox "esiste un file con questo nome:per ora lo elimino e creo il nuovo, poi dar� la possilit� di mantenerlo!"
        Kill UDTFiles
    End If
    
    ' creazione del workspace
    Set wspNewSearchDB = DBEngine.Workspaces(0)
    ' creazione del database
    
    Set dbsNewSearchDB = wspNewSearchDB.CreateDatabase(UDTFiles, _
        dbLangGeneral)
    
    ' creazione delle tabelle
    Set TabellaDatabase = dbsNewSearchDB.CreateTableDef("Database_MDB")
    Set TabellaTabelle = dbsNewSearchDB.CreateTableDef("Tabelle")
    Set TabellaCampi = dbsNewSearchDB.CreateTableDef("Campi")
    
    ' creazione dei campi relativi alla tabella <Database_MDB>
    Set FldDatabase(0) = TabellaDatabase.CreateField("ID", dbLong)
    Set FldDatabase(1) = TabellaDatabase.CreateField("Database", dbText, 50)
    Set FldDatabase(2) = TabellaDatabase.CreateField("Path", dbText, 50)
    
    ' creazione dei campi relativi alla tabella <Tabelle>
    Set FldTabelle(0) = TabellaTabelle.CreateField("Tabella", dbText, 50)
    Set FldTabelle(1) = TabellaTabelle.CreateField("IDDatabase", dbLong)
    Set FldTabelle(2) = TabellaTabelle.CreateField("IDFields", dbLong)
    Set FldTabelle(3) = TabellaTabelle.CreateField("N_Record", dbLong)
    Set FldTabelle(4) = TabellaTabelle.CreateField("N_Campi", dbLong)
    Set FldTabelle(5) = TabellaTabelle.CreateField("Caratteristiche", dbMemo)
    
    ' creazione dei campi relativi alla tabella <Campi>
    Set FldCampi(0) = TabellaCampi.CreateField("IDFields", dbLong)
    Set FldCampi(1) = TabellaCampi.CreateField("Campo", dbText, 50)
    Set FldCampi(2) = TabellaCampi.CreateField("Tipo", dbText, 19)
    Set FldCampi(3) = TabellaCampi.CreateField("Lungo", dbInteger)
    Set FldCampi(4) = TabellaCampi.CreateField("Caratteristiche", dbMemo)
    Set FldCampi(5) = TabellaCampi.CreateField("NumeroCampi", dbLong)
    ' append dei field alla tabella <Database>
    TabellaDatabase.Fields.Append FldDatabase(0)
    TabellaDatabase.Fields.Append FldDatabase(1)
    TabellaDatabase.Fields.Append FldDatabase(2)
    
    ' append dei field alla tabella <Tabella>
    TabellaTabelle.Fields.Append FldTabelle(0)
    TabellaTabelle.Fields.Append FldTabelle(1)
    TabellaTabelle.Fields.Append FldTabelle(2)
    TabellaTabelle.Fields.Append FldTabelle(3)
    TabellaTabelle.Fields.Append FldTabelle(4)
    TabellaTabelle.Fields.Append FldTabelle(5)
    
    ' append dei field alla tabella <campi>
    TabellaCampi.Fields.Append FldCampi(0)
    TabellaCampi.Fields.Append FldCampi(1)
    TabellaCampi.Fields.Append FldCampi(2)
    TabellaCampi.Fields.Append FldCampi(3)
    TabellaCampi.Fields.Append FldCampi(4)
    TabellaCampi.Fields.Append FldCampi(5)
    
    'append delle tabelle al database
    dbsNewSearchDB.TableDefs.Append TabellaDatabase
    dbsNewSearchDB.TableDefs.Append TabellaTabelle
    dbsNewSearchDB.TableDefs.Append TabellaCampi
    
    ' creazione chiavi e indici per tabella <Database>
    Set idxTipoDocumento(0) = TabellaDatabase.CreateIndex("ID")
    
    ' definizione Primary Key ed indici / default Primary = Unique = false
    idxTipoDocumento(0).Unique = True
    idxTipoDocumento(0).Primary = True
    
    ' creazione fields per gli indici
    Set FldDatabase(0) = idxTipoDocumento(0).CreateField("ID")
    
    ' append dei fields agli indici
    idxTipoDocumento(0).Fields.Append FldDatabase(0)
    
    ' append degli indici alla tabella
    TabellaDatabase.Indexes.Append idxTipoDocumento(0)
    '*************************************************************************************
    ' creazione chiavi e indici per tabella <Tabella>
    Set idxTabella(0) = TabellaTabelle.CreateIndex("IDFields")
    
    ' definizione Primary Key ed indici / default Primary = Unique = false
    idxTabella(0).Unique = True
    idxTabella(0).Primary = True
    ' creazione fields per gli indici
    Set FldTabelle(0) = idxTabella(0).CreateField("IDFields")
    
    ' append dei fields agli indici
    idxTabella(0).Fields.Append FldTabelle(0)
    
    ' append degli indici alla tabella
    TabellaTabelle.Indexes.Append idxTabella(0)
    
    ' creazione chiavi e indici per tabella <Tabella> n. 2
    Set idxTabella(0) = TabellaTabelle.CreateIndex("IDDatabase")
    
    ' definizione Primary Key ed indici / default Primary = Unique = false
    idxTabella(0).Unique = False
    
    ' creazione fields per gli indici
    Set FldTabelle(0) = idxTabella(0).CreateField("IDdatabase")
    
    ' append dei fields agli indici
    idxTabella(0).Fields.Append FldTabelle(0)
    
    ' append degli indici alla tabella
    TabellaTabelle.Indexes.Append idxTabella(0)
    
    '*************************************************************************************
    
    ' creazione chiavi e indici per tabella <Campi>
    ' per essa viene creato un indice composto su FKDocumento e FKParola
    Set idxCampi(0) = TabellaCampi.CreateIndex("IDFields")
    ' definizione Primary Key ed indici / default Primary = Unique = true
    idxCampi(0).Primary = False
    idxCampi(0).Unique = False
    
    ' append dei fields all'indice idxCampi(0)
    With idxCampi(0)
        .Fields.Append .CreateField("IDFields")
    End With
    
    ' append degli indici alla tabella
    TabellaCampi.Indexes.Append idxCampi(0)
    
    Dim Apridata As Database
    Set Apridata = wspNewSearchDB.OpenDatabase(UDTFiles)
    
    ' crea un oggetto repartiimpiegati relation,
    ' con i nomi delle due tabelle nella relazione.
    Set Relnuovo = Apridata.CreateRelation("RelDataTab", _
        "Database_MDB", "Tabelle", _
        dbRelationUpdateCascade)
    '
    '        ' crea un oggetto field per l'insieme fields
    '        ' del nuovo oggetto relation. imposta le
    '        ' propriet� name e foreignname in base ai
    '        ' campi da utilizzare per la relazione.
    Relnuovo.Fields.Append Relnuovo.CreateField("ID")
    Relnuovo.Fields!ID.ForeignName = "idDatabase"
    Apridata.Relations.Append Relnuovo
    '
    '        ' crea un oggetto repartiimpiegati relation,
    '        ' con i nomi delle due tabelle nella relazione.
    Set Relnuovo = Apridata.CreateRelation("RelTabFields", _
        "Tabelle", "Campi", _
        dbRelationUpdateCascade)
    '
    '        ' crea un oggetto field per l'insieme fields
    '        ' del nuovo oggetto relation. imposta le
    '        ' propriet� name e foreignname in base ai
    '        ' campi da utilizzare per la relazione.
    Relnuovo.Fields.Append Relnuovo.CreateField("IdFields")
    Relnuovo.Fields!IdFields.ForeignName = "IdFields"
    Apridata.Relations.Append Relnuovo
    '
    
    ' chiusura del db - temporanea
    dbsNewSearchDB.Close
    
    ' nome del db temporaneo per effettuare il compact
    '   strTempDbs = App.Path + "\Temp.mdb"
    strTempDbs = "Temp.mdb"
    ' rinomino il db originale con il nome del temporaneo
    '  Name (UDTFiles) As strTempDbs
    ' compact del database appena creato
    '  DBEngine.CompactDatabase strTempDbs, UDTFiles
    
    ' elimino il file temporaneo
    '  Kill strTempDbs
    
    CreateDB = True
    Exit Function
    ERROR_HANDLER:
    
    CreateDB = False
End Function

Visual # '********************************************************************************************
' Name.........:CreateDB

' Parameters...:Nessuno

' Return Value.:Boolean; se tutte le operazioni sono ok allora True else False

' Purpose......:Questa funzione viene chiamata da bottone nel tab degli Strumenti

' Essa crea un database nuovo con lo schema necessario

' Note.........:Nessuna

'********************************************************************************************

Public Function CreateDB() As Boolean

Dim intNumDocsType As Integer
Dim strTempDbs As String
Dim wspNewSearchDB As Workspace
Dim dbsNewSearchDB As Database
Dim TabellaDatabase, _
TabellaTabelle, _
TabellaCampi As TableDef
Dim FldDatabase(2), _
FldTabelle(6), _
FldCampi(5), _
fldParola(2), _
fldParolaNonValida(2) As Field
Dim idxTipoDocumento(2), _
idxTabella(4), _
idxCampi(2), _
idxParola(2), _
idxParolaNonValida(2), idxTipotabella(2) As Index
Dim relParolaOccorrenza, _
relTipoDocumentoDocumento, _
relDocumentoOccorrenza As Relation
Dim fldParolaOccorrenzaRel, _
FldDatabaseDocumentoRel, _
FldTabelleOccorrenzaRel As Field
Dim Relnuovo
Dim UDTFiles As String

' On Error GoTo ERROR_HANDLER

ChDir App.Path
'UDTFiles = App.Path & "\Nuovo.Mdb"

UDTFiles = "NuovoDB.Mdb"

' veriica dell'esistenza di un file con il nome del nuovo database.

If Dir(UDTFiles) <> "" Then
MsgBox "esiste un file con questo nome:per ora lo elimino e creo il nuovo, poi daro' la possilita' di mantenerlo!"
Kill UDTFiles
End If

' creazione del workspace

Set wspNewSearchDB = DBEngine.Workspaces(0)
' creazione del database

Set dbsNewSearchDB = wspNewSearchDB.CreateDatabase(UDTFiles, _
dbLangGeneral)

' creazione delle tabelle

Set TabellaDatabase = dbsNewSearchDB.CreateTableDef("Database_MDB")
Set TabellaTabelle = dbsNewSearchDB.CreateTableDef("Tabelle")
Set TabellaCampi = dbsNewSearchDB.CreateTableDef("Campi")

' creazione dei campi relativi alla tabella <Database_MDB>

Set FldDatabase(0) = TabellaDatabase.CreateField("ID", dbLong)
Set FldDatabase(1) = TabellaDatabase.CreateField("Database", dbText, 50)
Set FldDatabase(2) = TabellaDatabase.CreateField("Path", dbText, 50)

' creazione dei campi relativi alla tabella <Tabelle>

Set FldTabelle(0) = TabellaTabelle.CreateField("Tabella", dbText, 50)
Set FldTabelle(1) = TabellaTabelle.CreateField("IDDatabase", dbLong)
Set FldTabelle(2) = TabellaTabelle.CreateField("IDFields", dbLong)
Set FldTabelle(3) = TabellaTabelle.CreateField("N_Record", dbLong)
Set FldTabelle(4) = TabellaTabelle.CreateField("N_Campi", dbLong)
Set FldTabelle(5) = TabellaTabelle.CreateField("Caratteristiche", dbMemo)

' creazione dei campi relativi alla tabella <Campi>

Set FldCampi(0) = TabellaCampi.CreateField("IDFields", dbLong)
Set FldCampi(1) = TabellaCampi.CreateField("Campo", dbText, 50)
Set FldCampi(2) = TabellaCampi.CreateField("Tipo", dbText, 19)
Set FldCampi(3) = TabellaCampi.CreateField("Lungo", dbInteger)
Set FldCampi(4) = TabellaCampi.CreateField("Caratteristiche", dbMemo)
Set FldCampi(5) = TabellaCampi.CreateField("NumeroCampi", dbLong)
' append dei field alla tabella <Database>

TabellaDatabase.Fields.Append FldDatabase(0)
TabellaDatabase.Fields.Append FldDatabase(1)
TabellaDatabase.Fields.Append FldDatabase(2)

' append dei field alla tabella <Tabella>

TabellaTabelle.Fields.Append FldTabelle(0)
TabellaTabelle.Fields.Append FldTabelle(1)
TabellaTabelle.Fields.Append FldTabelle(2)
TabellaTabelle.Fields.Append FldTabelle(3)
TabellaTabelle.Fields.Append FldTabelle(4)
TabellaTabelle.Fields.Append FldTabelle(5)

' append dei field alla tabella <campi>

TabellaCampi.Fields.Append FldCampi(0)
TabellaCampi.Fields.Append FldCampi(1)
TabellaCampi.Fields.Append FldCampi(2)
TabellaCampi.Fields.Append FldCampi(3)
TabellaCampi.Fields.Append FldCampi(4)
TabellaCampi.Fields.Append FldCampi(5)

'append delle tabelle al database

dbsNewSearchDB.TableDefs.Append TabellaDatabase
dbsNewSearchDB.TableDefs.Append TabellaTabelle
dbsNewSearchDB.TableDefs.Append TabellaCampi

' creazione chiavi e indici per tabella <Database>

Set idxTipoDocumento(0) = TabellaDatabase.CreateIndex("ID")

' definizione Primary Key ed indici / default Primary = Unique = false

idxTipoDocumento(0).Unique = True
idxTipoDocumento(0).Primary = True

' creazione fields per gli indici

Set FldDatabase(0) = idxTipoDocumento(0).CreateField("ID")

' append dei fields agli indici

idxTipoDocumento(0).Fields.Append FldDatabase(0)

' append degli indici alla tabella

TabellaDatabase.Indexes.Append idxTipoDocumento(0)
'*************************************************************************************

' creazione chiavi e indici per tabella <Tabella>

Set idxTabella(0) = TabellaTabelle.CreateIndex("IDFields")

' definizione Primary Key ed indici / default Primary = Unique = false

idxTabella(0).Unique = True
idxTabella(0).Primary = True
' creazione fields per gli indici

Set FldTabelle(0) = idxTabella(0).CreateField("IDFields")

' append dei fields agli indici

idxTabella(0).Fields.Append FldTabelle(0)

' append degli indici alla tabella

TabellaTabelle.Indexes.Append idxTabella(0)

' creazione chiavi e indici per tabella <Tabella> n. 2

Set idxTabella(0) = TabellaTabelle.CreateIndex("IDDatabase")

' definizione Primary Key ed indici / default Primary = Unique = false

idxTabella(0).Unique = False

' creazione fields per gli indici

Set FldTabelle(0) = idxTabella(0).CreateField("IDdatabase")

' append dei fields agli indici

idxTabella(0).Fields.Append FldTabelle(0)

' append degli indici alla tabella

TabellaTabelle.Indexes.Append idxTabella(0)

'*************************************************************************************

' creazione chiavi e indici per tabella <Campi>

' per essa viene creato un indice composto su FKDocumento e FKParola

Set idxCampi(0) = TabellaCampi.CreateIndex("IDFields")
' definizione Primary Key ed indici / default Primary = Unique = true

idxCampi(0).Primary = False
idxCampi(0).Unique = False

' append dei fields all'indice idxCampi(0)

With idxCampi(0)
.Fields.Append .CreateField("IDFields")
End With

' append degli indici alla tabella

TabellaCampi.Indexes.Append idxCampi(0)

Dim Apridata As Database
Set Apridata = wspNewSearchDB.OpenDatabase(UDTFiles)

' crea un oggetto repartiimpiegati relation,

' con i nomi delle due tabelle nella relazione.

Set Relnuovo = Apridata.CreateRelation("RelDataTab", _
"Database_MDB", "Tabelle", _
dbRelationUpdateCascade)
'

' ' crea un oggetto field per l'insieme fields

' ' del nuovo oggetto relation. imposta le

' ' proprieta' name e foreignname in base ai

' ' campi da utilizzare per la relazione.

Relnuovo.Fields.Append Relnuovo.CreateField("ID")
Relnuovo.Fields!ID.ForeignName = "idDatabase"
Apridata.Relations.Append Relnuovo
'

' ' crea un oggetto repartiimpiegati relation,

' ' con i nomi delle due tabelle nella relazione.

Set Relnuovo = Apridata.CreateRelation("RelTabFields", _
"Tabelle", "Campi", _
dbRelationUpdateCascade)
'

' ' crea un oggetto field per l'insieme fields

' ' del nuovo oggetto relation. imposta le

' ' proprieta' name e foreignname in base ai

' ' campi da utilizzare per la relazione.

Relnuovo.Fields.Append Relnuovo.CreateField("IdFields")
Relnuovo.Fields!IdFields.ForeignName = "IdFields"
Apridata.Relations.Append Relnuovo
'

' chiusura del db - temporanea

dbsNewSearchDB.Close

' nome del db temporaneo per effettuare il compact

' strTempDbs = App.Path + "\Temp.mdb"

strTempDbs = "Temp.mdb"
' rinomino il db originale con il nome del temporaneo

' Name (UDTFiles) As strTempDbs

' compact del database appena creato

' DBEngine.CompactDatabase strTempDbs, UDTFiles

' elimino il file temporaneo

' Kill strTempDbs

CreateDB = True
Exit Function
ERROR_HANDLER:

CreateDB = False
End Function