REGISTRI - Modulo Completo RegistrySistema

Imports System
Imports Microsoft.Win32

Module RegistrySistema

'Chiave  AdmCond
    'Const NomeChiaveMadre As String = "AdmPolicy"
    Public NomeChiaveMadre As String

Public Sub SetRegKey(ByVal NomeChiaveFiglia As String, ByVal Valore As String, ByVal MyVal As RegistryValueKind)
        ' questa sub inserisce un valore dentro ad una chiave
        ' se non esiste la inserisce
        ' NomeChiaveMadre inserire il nome dell'applicazione
        ' NomeChiaveFiglia inserire l'etichetta della chiave da inserire
        ' Valore inserire il valore della chiave stessa

' 0 nessun valueKing
        ' 1 RegistryValueKind.Binary
        ' 2 DWord
        ' 3 ExpandString
        ' 4 MultiString
        ' 5 QWord
        ' 6 String
        ' 7 Unknown

On Error GoTo errore
        Const userRoot As String = "HKEY_CURRENT_USER\Software"
        Dim subkey As String = NomeChiaveMadre
        Dim keyName As String = userRoot & "\" & subkey

Registry.SetValue(keyName, NomeChiaveFiglia, Valore, MyVal)
        Exit Sub

Errore:
        MsgBox("SetRegKey : Errore :" & Err.Description, MsgBoxStyle.Information, "Errore")

End Sub

Public Function GetRegKey(ByVal NomeChiaveFiglia As String) As String
        ' legge e ritorna il valore di CHIAVE
        Dim Errore As Boolean
        ' The name of the key must include a valid root.
        Const userRoot As String = "HKEY_CURRENT_USER\Software"
        Dim subkey As String = NomeChiaveMadre
        Dim keyName As String = userRoot & "\" & subkey
        GetRegKey = ""
        Dim COnto As Long = 0
Rileggi:
        '********************************************************************************
        ' se esiste deve uscire via altrimenti metterebbe sempre i valori di default
        Dim Esiste As String

Esiste = Registry.GetValue(keyName, NomeChiaveFiglia, "Non Esiste")
         
        If Trim(Esiste) <> "Non Esiste" And Trim(Esiste) <> "False" Then
            GetRegKey = Esiste
            Exit Function
        Else
            Err.Number = 5
            SetRegKey(NomeChiaveFiglia, "False", RegistryValueKind.String)
            Errore = True
            COnto = COnto + 1
        End If

If Errore = True Then
            If COnto > 1 Then
                GetRegKey = Esiste
                Exit Function
            End If
            GoTo Rileggi

End If

'********************************************************************************
    End Function

Public Function EsisteKey(ByVal NomeChiave As String) As Boolean
        '**********************************************
        ' verifica se la chiave esiste nel registro
        '**********************************************
        EsisteKey = False
         Const userRoot As String = "HKEY_CURRENT_USER\Software"
        Dim subkey As String = NomeChiaveMadre
        Dim keyName As String = userRoot & "\" & subkey
        Dim Esiste As String = Registry.GetValue(keyName, NomeChiave, "")
        If Esiste <> "" Then
            'Beep()
            EsisteKey = True
        Else
            EsisteKey = False
        End If

End Function

Public Sub ScriviRegKeyGlobale()
        '*********************************************************
        ' Se la chiave madre non esiste la SUB crea la struttura
        ' delle chiavi di registro dell'applicazione
        '*********************************************************

Dim I As Long
        TypeConn.MyDirPath = My.Application.Info.DirectoryPath
        I = InStr(TypeConn.MyDirPath, "\bin\Debug")
        If I > 0 Then
            TypeConn.MyDirPath = Mid(TypeConn.MyDirPath, 1, I - 1)
        End If

If Dir(TypeConn.MyDirPath & "\INI\GestioneRete.ini") <> "" Then
            I = FreeFile()
            FileOpen(I, TypeConn.MyDirPath & "\INI\GestioneRete.ini", OpenMode.Input)
            TypeConn.TipoConnessione = LineInput(I)
            TypeConn.PathDataBase = LineInput(I)
            TypeConn.NomeDatabase = LineInput(I)
            FileClose(I)
        End If

SetRegKey("NomeDatabase", TypeConn.NomeDatabase, RegistryValueKind.String)
        SetRegKey("PathDataBase", TypeConn.PathDataBase, RegistryValueKind.String)
        SetRegKey("MyDirPath", TypeConn.MyDirPath, RegistryValueKind.String)
        SetRegKey("Autenticazione", "1", RegistryValueKind.String)
        SetRegKey("PathDataBase", TypeConn.PathDataBase, RegistryValueKind.String)
        SetRegKey("NomeServer", "1", RegistryValueKind.String)
        SetRegKey("User", "1", RegistryValueKind.String)   ' login
        SetRegKey("PassWord", "2", RegistryValueKind.String)
        SetRegKey("DNS", "1", RegistryValueKind.String)
        SetRegKey("TipoConnessione", "[Gestione database Aziendale]", RegistryValueKind.String)
        SetRegKey("Trasparenze", "True", RegistryValueKind.String)
        SetRegKey("DimensionaForm", "True", RegistryValueKind.String)
        SetRegKey("Rete", "True", RegistryValueKind.String)
        SetRegKey("Schermo", "True", RegistryValueKind.String)
        SetRegKey("Backup", "False", RegistryValueKind.String)
        SetRegKey("BackupArch", "True", RegistryValueKind.String)
        SetRegKey("ConnectionString", "", RegistryValueKind.String)
        SetRegKey("DelPdf", "True", RegistryValueKind.String)
        SetRegKey("NCry", 1, RegistryValueKind.String)
        SetRegKey("FatturaCartaIntestata", "False", RegistryValueKind.String)
        SetRegKey("MForzaPDFPrinter", "True", RegistryValueKind.String)

End Sub

Public Sub ScriviRegINIGlobale()
        Dim I As Long
        TypeConn.MyDirPath = My.Application.Info.DirectoryPath
        I = InStr(TypeConn.MyDirPath, "\bin\Debug")
        If I > 0 Then
            TypeConn.MyDirPath = Mid(TypeConn.MyDirPath, 1, I - 1)
        End If

FileOpen(1, TypeConn.MyDirPath & "\INI\Registry.ini", OpenMode.Output)

If Len(GestioneRete.TextBox2.Text) <> 0 And Len(TypeConn.NomeDatabase) = 0 Then
            TypeConn.NomeDatabase = GestioneRete.TextBox2.Text
        End If

PrintLine(1, "NomeDatabase=" & TypeConn.NomeDatabase)
        PrintLine(1, "PathDataBase=" & TypeConn.PathDataBase)
        PrintLine(1, "MyDirPath=" & TypeConn.MyDirPath)
        PrintLine(1, "Autenticazione=1")
        PrintLine(1, "PathDataBase=" & TypeConn.PathDataBase)
        PrintLine(1, "NomeServer=1")
        PrintLine(1, "User=1")   ' login
        PrintLine(1, "PassWord=2")
        PrintLine(1, "DNS=1")
        PrintLine(1, "TipoConnessione=[Gestione database Aziendale]")
        PrintLine(1, "Trasparenze=True")
        PrintLine(1, "DimensionaForm=True")
        PrintLine(1, "Rete=True")
        PrintLine(1, "Schermo=True")
        PrintLine(1, "Backup=False")
        PrintLine(1, "BackupArch=True")
        PrintLine(1, "ConnectionString=")
        PrintLine(1, "DelPdf=True")
        PrintLine(1, "NCry=1")
        PrintLine(1, "FatturaCartaIntestata=False")
        PrintLine(1, "MForzaPDFPrinter=True")

FileClose(1)

End Sub

Function TogliReg(ByVal NomeRegistro As String) As String
        Dim M As Long
        M = InStr(NomeRegistro, "=")
        If M <> 0 Then
            TogliReg = Mid(NomeRegistro, M + 1, Len(NomeRegistro))
        Else
            TogliReg = NomeRegistro
        End If

End Function
    Public Sub LeggiRegINIGlobale()
        On Error GoTo Errore
        Dim I As Long
        TypeConn.MyDirPath = My.Application.Info.DirectoryPath
        I = InStr(TypeConn.MyDirPath, "\bin\Debug")
        If I > 0 Then
            TypeConn.MyDirPath = Mid(TypeConn.MyDirPath, 1, I - 1)
        End If

If Dir(TypeConn.MyDirPath & "\INI\Registry.ini") = "" Then
            Exit Sub
        End If
        Dim X As Long = FreeFile()

FileOpen(X, TypeConn.MyDirPath & "\INI\Registry.ini", OpenMode.Input)
        'PrintLine(1, "NomeDatabase=Archivio.mdb")
        TypeConn.NomeDatabase = TogliReg(LineInput(X))
        'PrintLine(1, "PathDataBase=" & TypeConn.MyDirPath & "\Database\Archivio.mdb")
        TypeConn.PathDataBase = TogliReg(LineInput(X))
        'PrintLine(1, "MyDirPath=" & TypeConn.MyDirPath)
        TypeConn.MyDirPath = TogliReg(LineInput(X))
        'PrintLine(1, "Autenticazione=1")
        TypeConn.Autenticazione = TogliReg(LineInput(X))
        'PrintLine(1, "PathDataBase=" & TypeConn.MyDirPath & "\Database\Archivio.mdb")
        TypeConn.PathDataBase = TogliReg(LineInput(X))
        'PrintLine(1, "NomeServer=1")
        TypeConn.NomeServer = TogliReg(LineInput(X))
        'PrintLine(1, "User=1")   ' login
        TypeConn.User = TogliReg(LineInput(X))
        'PrintLine(1, "PassWord=2")
        TypeConn.PassWord = TogliReg(LineInput(X))
        'PrintLine(1, "DNS=1")
        TypeConn.DNS = TogliReg(LineInput(X))
        'PrintLine(1, "TipoConnessione=[Gestione database Aziendale]")
        TypeConn.TipoConnessione = TogliReg(LineInput(X))
        'PrintLine(1, "Trasparenze=True")
        TypeConn.Trasparenze = TogliReg(LineInput(X))
        'PrintLine(1, "DimensionaForm=True")
        TypeConn.DimensionaForm = TogliReg(LineInput(X))
        'PrintLine(1, "Rete=True")
        TypeConn.Rete = TogliReg(LineInput(X))
        'PrintLine(1, "Schermo=True")
        TypeConn.Schermo = TogliReg(LineInput(X))
        If TypeConn.Schermo = "False" Then
            Sfondo.Visible = False
        Else
            Sfondo.Visible = True
        End If

'PrintLine(1, "Backup=False")
        TypeConn.Backup = TogliReg(LineInput(X))
        'PrintLine(1, "BackupArch=True")
        TypeConn.BackupArch = TogliReg(LineInput(X))
        'PrintLine(1, "ConnectionString=")
        TypeConn.ConnectionString = Decrypta(TogliReg(LineInput(X)))

If Len(Trim(TypeConn.ConnectionString)) = 0 Then
            TypeConn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & TypeConn.MyDirPath & "\Database\Archivio.mdb" & ";Jet OLEDB:Database PassWord=iw0blpiw0fnb;"
        End If

'PrintLine(1, "DelPdf=True")
        TypeConn.DelPdf = TogliReg(LineInput(X))
        'PrintLine(1, "NCry=1")
        TypeConn.NCry = TogliReg(LineInput(X))
        Dim Stringa As String = TogliReg(LineInput(X))
        If Stringa = "True" Then
            TypeConn.FatturaCartaIntestata = True
        Else
            TypeConn.FatturaCartaIntestata = False
        End If
        '************************************************* 10/9/2010
        Stringa = TogliReg(LineInput(X))
        If Stringa = "True" Then
            TypeConn.MForzaPDFPrinter = True
        Else
            TypeConn.MForzaPDFPrinter = False
        End If

'FileClose(1)

If Dir(TypeConn.MyDirPath & "\INI\NONScriveNeiRegistry.ini", FileAttribute.Normal) <> "" Then
            NONScriveNeiRegistry = True
        Else
            NONScriveNeiRegistry = False
        End If

FileClose(X)

Exit Sub
Errore:

FileClose(X)

MsgBox("Uscita anomala da LeggiRegINIGlobale " & Err.Description, MsgBoxStyle.Information, "Anomalia")

ScriviRegINIGlobale()
        LeggiRegINIGlobale()

End Sub

Public Sub SalvaRegINIGlobale()
        On Error GoTo Errore
        FileOpen(1, TypeConn.MyDirPath & "\INI\Registry.ini", OpenMode.Output)
        PrintLine(1, "NomeDatabase=" & TypeConn.NomeDatabase)
        'TypeConn.NomeDatabase = TogliReg(LineInput(1))
        PrintLine(1, "PathDataBase=" & TypeConn.PathDataBase)
        'TypeConn.PathDataBase = TogliReg(LineInput(1))
        PrintLine(1, "MyDirPath=" & TypeConn.MyDirPath)
        'TypeConn.MyDirPath = TogliReg(LineInput(1))
        PrintLine(1, "Autenticazione=" & TypeConn.Autenticazione)
        'TypeConn.Autenticazione = TogliReg(LineInput(1))
        PrintLine(1, "PathDataBase=" & TypeConn.PathDataBase)
        'TypeConn.PathDataBase = TogliReg(LineInput(1))
        PrintLine(1, "NomeServer=" & TypeConn.NomeServer)
        'TypeConn.NomeServer = TogliReg(LineInput(1))
        PrintLine(1, "User=" & TypeConn.User)   ' login
        'TypeConn.User = TogliReg(LineInput(1))
        PrintLine(1, "PassWord=" & TypeConn.PassWord)
        'TypeConn.PassWord = TogliReg(LineInput(1))
        PrintLine(1, "DNS=" & TypeConn.DNS)
        'TypeConn.DNS = TogliReg(LineInput(1))
        PrintLine(1, "TipoConnessione=" & TypeConn.TipoConnessione)
        'TypeConn.TipoConnessione = TogliReg(LineInput(1))
        PrintLine(1, "Trasparenze=" & TypeConn.Trasparenze)
        'TypeConn.Trasparenze = TogliReg(LineInput(1))
        PrintLine(1, "DimensionaForm=" & TypeConn.DimensionaForm)
        'TypeConn.DimensionaForm = TogliReg(LineInput(1))
        PrintLine(1, "Rete=" & TypeConn.Rete)
        'TypeConn.Rete = TogliReg(LineInput(1))
        PrintLine(1, "Schermo=" & TypeConn.Schermo)
        If TypeConn.Schermo = "True" Then
            If Sfondo.Visible = False Then
                Sfondo.Visible = True
            End If
        Else
            If Sfondo.Visible = True Then
                Sfondo.Visible = False
            End If

End If

'TypeConn.Schermo = TogliReg(LineInput(1))
        PrintLine(1, "Backup=" & TypeConn.Backup)
        'TypeConn.Backup = TogliReg(LineInput(1))
        PrintLine(1, "BackupArch=" & TypeConn.BackupArch)
        'TypeConn.BackupArch = TogliReg(LineInput(1))
        PrintLine(1, "ConnectionString=" & Crypta(TypeConn.ConnectionString))
        'TypeConn.ConnectionString = TogliReg(LineInput(1))
        PrintLine(1, "DelPdf=" & TypeConn.DelPdf)
        'TypeConn.DelPdf = TogliReg(LineInput(1))
        PrintLine(1, "NCry=" & TypeConn.NCry)
        'TypeConn.NCry = TogliReg(LineInput(1))
        PrintLine(1, "FatturaCartaIntestata=" & TypeConn.FatturaCartaIntestata)
        PrintLine(1, "MForzaPDFPrinter=" & TypeConn.MForzaPDFPrinter)

FileClose(1)

Exit Sub
Errore:
        MsgBox("SalvaREGINIGlobale - " & Err.Description, MsgBoxStyle.Critical)

End Sub

Public Sub LeggiRegKeyGlobale()

Try
            TypeConn.PathDataBase = GetRegKey("PathDataBase")
        Catch ex As Exception

SetRegKey("PathDataBase", TypeConn.MyDirPath & "\Database\Archivio.mdb", RegistryValueKind.String)
            TypeConn.PathDataBase = TypeConn.MyDirPath & "\Database\Archivio.mdb"
        End Try

Try
            TypeConn.NomeDatabase = GetRegKey("NomeDatabase")
        Catch ex As Exception
            SetRegKey("NomeDatabase", "Archivio.mdb", RegistryValueKind.String)
            TypeConn.NomeDatabase = "Archivio.mdb"
        End Try

Try
            TypeConn.NCry = Val(GetRegKey("NCry"))   ' numero di Cryptazione
        Catch ex As Exception
            Err.Clear()
            SetRegKey("NCry", "1", RegistryValueKind.String)
            TypeConn.NCry = "1"
        End Try

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

'TypeConn.NCry = 1
        SectaArray(TypeConn.NCry)

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

Try
            TypeConn.Autenticazione = GetRegKey("Autenticazione")     ' "Autenticazione di Windows"
        Catch ex As Exception
            SetRegKey("Autenticazione", "1", RegistryValueKind.String)
            TypeConn.Autenticazione = "1"
        End Try

Try
            TypeConn.Backup = GetRegKey("Backup")              ' esegue backup sia dei sorgenti che del database in uscita da MENU
        Catch ex As Exception
            SetRegKey("Backup", "False", RegistryValueKind.String)
            TypeConn.Backup = "False"
        End Try
        Try
            TypeConn.BackupArch = GetRegKey("BackupArch")          ' esegue solamente il backup degli archivi (se database � MS ACCESS)
        Catch ex As Exception
            SetRegKey("BackupArch", "True", RegistryValueKind.String)
            TypeConn.BackupArch = "True"
        End Try
        Try
            TypeConn.ConnectionString = Decrypta(GetRegKey("ConnectionString"))    ' e' solo un tipo di connessione "[Gestione database SQL SERVER]"
        Catch ex As Exception
            SetRegKey("ConnectionString", "", RegistryValueKind.String)
            TypeConn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & TypeConn.MyDirPath & "\Database\Archivio.mdb" & ";Jet OLEDB:Database PassWord=iw0blpiw0fnb;"

End Try
        Try
            TypeConn.DelPdf = GetRegKey("DelPdf")    ' Cancella in uscita tutti i PDF prodotti
        Catch ex As Exception
            SetRegKey("DelPdf", "True", RegistryValueKind.String)
            TypeConn.DelPdf = "True"
        End Try
        Try
            TypeConn.DimensionaForm = GetRegKey("DimensionaForm")       ' 
        Catch ex As Exception
            SetRegKey("DimensionaForm", "True", RegistryValueKind.String)
            TypeConn.DimensionaForm = "True"
        End Try
        'Try
        '    TypeConn.PathDataBase = GetRegKey("PathDataBase")
        'Catch ex As Exception
        '    SetRegKey("PathDataBase", TypeConn.MyDirPath & "\Database\Archivio.mdb", RegistryValueKind.String)
        '    TypeConn.PathDataBase = TypeConn.MyDirPath & "\Database\Archivio.mdb"
        'End Try
        Try
            TypeConn.DNS = GetRegKey("DNS")
        Catch ex As Exception
            SetRegKey("DNS", "1", RegistryValueKind.String)
            TypeConn.DNS = "1"
        End Try
        'Try
        '    TypeConn.NomeDatabase = GetRegKey("NomeDatabase")
        'Catch ex As Exception
        '    SetRegKey("NomeDatabase", "Archivio.mdb", RegistryValueKind.String)
        '    TypeConn.NomeDatabase = "Archivio.mdb"
        'End Try
        Try
            TypeConn.NomeServer = GetRegKey("NomeServer")
        Catch ex As Exception
            SetRegKey("NomeServer", "1", RegistryValueKind.String)
            TypeConn.NomeServer = "1"
        End Try
        Try
            If TypeConn.MyDirPath <> GetRegKey("MyDirPath") Then
                SetRegKey("MyDirPath", TypeConn.MyDirPath, RegistryValueKind.String)
            End If
        Catch ex As Exception
            SetRegKey("MyDirPath", TypeConn.MyDirPath, RegistryValueKind.String)
        End Try

Try
            TypeConn.PassWord = Decrypta(GetRegKey("PassWord"))
        Catch ex As Exception
            SetRegKey("PassWord", "2", RegistryValueKind.String)
            TypeConn.PassWord = "2"
        End Try
        Try
            TypeConn.Rete = GetRegKey("Rete")
        Catch ex As Exception
            SetRegKey("Rete", "True", RegistryValueKind.String)
            TypeConn.Rete = "True"
        End Try
        Try
            TypeConn.Schermo = GetRegKey("Schermo")
        Catch ex As Exception
            SetRegKey("Schermo", "True", RegistryValueKind.String)
            TypeConn.Schermo = "True"
            If TypeConn.Schermo = "True" Then
                If Sfondo.Visible = False Then
                    Sfondo.Visible = True
                End If
            Else
                If Sfondo.Visible = True Then
                    Sfondo.Visible = False
                End If

End If

End Try
        Try
            TypeConn.Trasparenze = GetRegKey("Trasparenze")
        Catch ex As Exception
            SetRegKey("Trasparenze", "True", RegistryValueKind.String)
            TypeConn.Trasparenze = "True"
        End Try
        Try
            TypeConn.TipoConnessione = GetRegKey("TipoConnessione")
        Catch ex As Exception
            SetRegKey("TipoConnessione", "[Gestione database Aziendale]", RegistryValueKind.String)
            TypeConn.TipoConnessione = "[Gestione database Aziendale]"
        End Try
        Try
            TypeConn.User = GetRegKey("User")
        Catch ex As Exception
            SetRegKey("User", "1", RegistryValueKind.String)
            TypeConn.User = "1"
        End Try
        Try
            TypeConn.NCry = Val(GetRegKey("FatturaCartaIntestata"))   ' numero di Cryptazione
        Catch ex As Exception
            Err.Clear()
            SetRegKey("FatturaCartaIntestata", "False", RegistryValueKind.String)
            TypeConn.FatturaCartaIntestata = False
        End Try
        Try
            TypeConn.MForzaPDFPrinter = Val(GetRegKey("MForzaPDFPrinter"))   ' numero di Cryptazione
        Catch ex As Exception
            Err.Clear()
            SetRegKey("MForzaPDFPrinter", "False", RegistryValueKind.String)
            TypeConn.MForzaPDFPrinter = False
        End Try

' cancellazione Registro
        ' Registry.CurrentUser.DeleteSubKey(subkey)
    End Sub

End Module

Imports System
Imports Microsoft.Win32

Module RegistrySistema

'Chiave AdmCond

'Const NomeChiaveMadre As String = "AdmPolicy"

Public NomeChiaveMadre As String

Public Sub SetRegKey(ByVal NomeChiaveFiglia As String, ByVal Valore As String, ByVal MyVal As RegistryValueKind)
' questa sub inserisce un valore dentro ad una chiave

' se non esiste la inserisce

' NomeChiaveMadre inserire il nome dell'applicazione

' NomeChiaveFiglia inserire l'etichetta della chiave da inserire

' Valore inserire il valore della chiave stessa

' 0 nessun valueKing

' 1 RegistryValueKind.Binary

' 2 DWord

' 3 ExpandString

' 4 MultiString

' 5 QWord

' 6 String

' 7 Unknown

On Error GoTo errore
Const userRoot As String = "HKEY_CURRENT_USER\Software"
Dim subkey As String = NomeChiaveMadre
Dim keyName As String = userRoot & "\" & subkey

Registry.SetValue(keyName, NomeChiaveFiglia, Valore, MyVal)
Exit Sub

Errore:
MsgBox("SetRegKey : Errore :" & Err.Description, MsgBoxStyle.Information, "Errore")

End Sub

Public Function GetRegKey(ByVal NomeChiaveFiglia As String) As String
' legge e ritorna il valore di CHIAVE

Dim Errore As Boolean
' The name of the key must include a valid root.

Const userRoot As String = "HKEY_CURRENT_USER\Software"
Dim subkey As String = NomeChiaveMadre
Dim keyName As String = userRoot & "\" & subkey
GetRegKey = ""
Dim COnto As Long = 0
Rileggi:
'********************************************************************************

' se esiste deve uscire via altrimenti metterebbe sempre i valori di default

Dim Esiste As String

Esiste = Registry.GetValue(keyName, NomeChiaveFiglia, "Non Esiste")

If Trim(Esiste) <> "Non Esiste" And Trim(Esiste) <> "False" Then
GetRegKey = Esiste
Exit Function
Else
Err.Number = 5
SetRegKey(NomeChiaveFiglia, "False", RegistryValueKind.String)
Errore = True
COnto = COnto + 1
End If

If Errore = True Then
If COnto > 1 Then
GetRegKey = Esiste
Exit Function
End If
GoTo Rileggi

End If

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

End Function

Public Function EsisteKey(ByVal NomeChiave As String) As Boolean
'**********************************************

' verifica se la chiave esiste nel registro

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

EsisteKey = False
Const userRoot As String = "HKEY_CURRENT_USER\Software"
Dim subkey As String = NomeChiaveMadre
Dim keyName As String = userRoot & "\" & subkey
Dim Esiste As String = Registry.GetValue(keyName, NomeChiave, "")
If Esiste <> "" Then
'Beep()

EsisteKey = True
Else
EsisteKey = False
End If

End Function

Public Sub ScriviRegKeyGlobale()
'*********************************************************

' Se la chiave madre non esiste la SUB crea la struttura

' delle chiavi di registro dell'applicazione

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

Dim I As Long
TypeConn.MyDirPath = My.Application.Info.DirectoryPath
I = InStr(TypeConn.MyDirPath, "\bin\Debug")
If I > 0 Then
TypeConn.MyDirPath = Mid(TypeConn.MyDirPath, 1, I - 1)
End If

If Dir(TypeConn.MyDirPath & "\INI\GestioneRete.ini") <> "" Then
I = FreeFile()
FileOpen(I, TypeConn.MyDirPath & "\INI\GestioneRete.ini", OpenMode.Input)
TypeConn.TipoConnessione = LineInput(I)
TypeConn.PathDataBase = LineInput(I)
TypeConn.NomeDatabase = LineInput(I)
FileClose(I)
End If

SetRegKey("NomeDatabase", TypeConn.NomeDatabase, RegistryValueKind.String)
SetRegKey("PathDataBase", TypeConn.PathDataBase, RegistryValueKind.String)
SetRegKey("MyDirPath", TypeConn.MyDirPath, RegistryValueKind.String)
SetRegKey("Autenticazione", "1", RegistryValueKind.String)
SetRegKey("PathDataBase", TypeConn.PathDataBase, RegistryValueKind.String)
SetRegKey("NomeServer", "1", RegistryValueKind.String)
SetRegKey("User", "1", RegistryValueKind.String) ' login
SetRegKey("PassWord", "2", RegistryValueKind.String)
SetRegKey("DNS", "1", RegistryValueKind.String)
SetRegKey("TipoConnessione", "[Gestione database Aziendale]", RegistryValueKind.String)
SetRegKey("Trasparenze", "True", RegistryValueKind.String)
SetRegKey("DimensionaForm", "True", RegistryValueKind.String)
SetRegKey("Rete", "True", RegistryValueKind.String)
SetRegKey("Schermo", "True", RegistryValueKind.String)
SetRegKey("Backup", "False", RegistryValueKind.String)
SetRegKey("BackupArch", "True", RegistryValueKind.String)
SetRegKey("ConnectionString", "", RegistryValueKind.String)
SetRegKey("DelPdf", "True", RegistryValueKind.String)
SetRegKey("NCry", 1, RegistryValueKind.String)
SetRegKey("FatturaCartaIntestata", "False", RegistryValueKind.String)
SetRegKey("MForzaPDFPrinter", "True", RegistryValueKind.String)

End Sub

Public Sub ScriviRegINIGlobale()
Dim I As Long
TypeConn.MyDirPath = My.Application.Info.DirectoryPath
I = InStr(TypeConn.MyDirPath, "\bin\Debug")
If I > 0 Then
TypeConn.MyDirPath = Mid(TypeConn.MyDirPath, 1, I - 1)
End If

FileOpen(1, TypeConn.MyDirPath & "\INI\Registry.ini", OpenMode.Output)

If Len(GestioneRete.TextBox2.Text) <> 0 And Len(TypeConn.NomeDatabase) = 0 Then
TypeConn.NomeDatabase = GestioneRete.TextBox2.Text
End If

PrintLine(1, "NomeDatabase=" & TypeConn.NomeDatabase)
PrintLine(1, "PathDataBase=" & TypeConn.PathDataBase)
PrintLine(1, "MyDirPath=" & TypeConn.MyDirPath)
PrintLine(1, "Autenticazione=1")
PrintLine(1, "PathDataBase=" & TypeConn.PathDataBase)
PrintLine(1, "NomeServer=1")
PrintLine(1, "User=1") ' login
PrintLine(1, "PassWord=2")
PrintLine(1, "DNS=1")
PrintLine(1, "TipoConnessione=[Gestione database Aziendale]")
PrintLine(1, "Trasparenze=True")
PrintLine(1, "DimensionaForm=True")
PrintLine(1, "Rete=True")
PrintLine(1, "Schermo=True")
PrintLine(1, "Backup=False")
PrintLine(1, "BackupArch=True")
PrintLine(1, "ConnectionString=")
PrintLine(1, "DelPdf=True")
PrintLine(1, "NCry=1")
PrintLine(1, "FatturaCartaIntestata=False")
PrintLine(1, "MForzaPDFPrinter=True")

FileClose(1)

End Sub

Function TogliReg(ByVal NomeRegistro As String) As String
Dim M As Long
M = InStr(NomeRegistro, "=")
If M <> 0 Then
TogliReg = Mid(NomeRegistro, M + 1, Len(NomeRegistro))
Else
TogliReg = NomeRegistro
End If

End Function
Public Sub LeggiRegINIGlobale()
On Error GoTo Errore
Dim I As Long
TypeConn.MyDirPath = My.Application.Info.DirectoryPath
I = InStr(TypeConn.MyDirPath, "\bin\Debug")
If I > 0 Then
TypeConn.MyDirPath = Mid(TypeConn.MyDirPath, 1, I - 1)
End If

If Dir(TypeConn.MyDirPath & "\INI\Registry.ini") = "" Then
Exit Sub
End If
Dim X As Long = FreeFile()

FileOpen(X, TypeConn.MyDirPath & "\INI\Registry.ini", OpenMode.Input)
'PrintLine(1, "NomeDatabase=Archivio.mdb")

TypeConn.NomeDatabase = TogliReg(LineInput(X))
'PrintLine(1, "PathDataBase=" & TypeConn.MyDirPath & "\Database\Archivio.mdb")

TypeConn.PathDataBase = TogliReg(LineInput(X))
'PrintLine(1, "MyDirPath=" & TypeConn.MyDirPath)

TypeConn.MyDirPath = TogliReg(LineInput(X))
'PrintLine(1, "Autenticazione=1")

TypeConn.Autenticazione = TogliReg(LineInput(X))
'PrintLine(1, "PathDataBase=" & TypeConn.MyDirPath & "\Database\Archivio.mdb")

TypeConn.PathDataBase = TogliReg(LineInput(X))
'PrintLine(1, "NomeServer=1")

TypeConn.NomeServer = TogliReg(LineInput(X))
'PrintLine(1, "User=1") ' login

TypeConn.User = TogliReg(LineInput(X))
'PrintLine(1, "PassWord=2")

TypeConn.PassWord = TogliReg(LineInput(X))
'PrintLine(1, "DNS=1")

TypeConn.DNS = TogliReg(LineInput(X))
'PrintLine(1, "TipoConnessione=[Gestione database Aziendale]")

TypeConn.TipoConnessione = TogliReg(LineInput(X))
'PrintLine(1, "Trasparenze=True")

TypeConn.Trasparenze = TogliReg(LineInput(X))
'PrintLine(1, "DimensionaForm=True")

TypeConn.DimensionaForm = TogliReg(LineInput(X))
'PrintLine(1, "Rete=True")

TypeConn.Rete = TogliReg(LineInput(X))
'PrintLine(1, "Schermo=True")

TypeConn.Schermo = TogliReg(LineInput(X))
If TypeConn.Schermo = "False" Then
Sfondo.Visible = False
Else
Sfondo.Visible = True
End If

'PrintLine(1, "Backup=False")

TypeConn.Backup = TogliReg(LineInput(X))
'PrintLine(1, "BackupArch=True")

TypeConn.BackupArch = TogliReg(LineInput(X))
'PrintLine(1, "ConnectionString=")

TypeConn.ConnectionString = Decrypta(TogliReg(LineInput(X)))

If Len(Trim(TypeConn.ConnectionString)) = 0 Then
TypeConn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & TypeConn.MyDirPath & "\Database\Archivio.mdb" & ";Jet OLEDB:Database PassWord=iw0blpiw0fnb;"
End If

'PrintLine(1, "DelPdf=True")

TypeConn.DelPdf = TogliReg(LineInput(X))
'PrintLine(1, "NCry=1")

TypeConn.NCry = TogliReg(LineInput(X))
Dim Stringa As String = TogliReg(LineInput(X))
If Stringa = "True" Then
TypeConn.FatturaCartaIntestata = True
Else
TypeConn.FatturaCartaIntestata = False
End If
'************************************************* 10/9/2010

Stringa = TogliReg(LineInput(X))
If Stringa = "True" Then
TypeConn.MForzaPDFPrinter = True
Else
TypeConn.MForzaPDFPrinter = False
End If

'FileClose(1)

If Dir(TypeConn.MyDirPath & "\INI\NONScriveNeiRegistry.ini", FileAttribute.Normal) <> "" Then
NONScriveNeiRegistry = True
Else
NONScriveNeiRegistry = False
End If

FileClose(X)

Exit Sub
Errore:

FileClose(X)

MsgBox("Uscita anomala da LeggiRegINIGlobale " & Err.Description, MsgBoxStyle.Information, "Anomalia")

ScriviRegINIGlobale()
LeggiRegINIGlobale()

End Sub

Public Sub SalvaRegINIGlobale()
On Error GoTo Errore
FileOpen(1, TypeConn.MyDirPath & "\INI\Registry.ini", OpenMode.Output)
PrintLine(1, "NomeDatabase=" & TypeConn.NomeDatabase)
'TypeConn.NomeDatabase = TogliReg(LineInput(1))

PrintLine(1, "PathDataBase=" & TypeConn.PathDataBase)
'TypeConn.PathDataBase = TogliReg(LineInput(1))

PrintLine(1, "MyDirPath=" & TypeConn.MyDirPath)
'TypeConn.MyDirPath = TogliReg(LineInput(1))

PrintLine(1, "Autenticazione=" & TypeConn.Autenticazione)
'TypeConn.Autenticazione = TogliReg(LineInput(1))

PrintLine(1, "PathDataBase=" & TypeConn.PathDataBase)
'TypeConn.PathDataBase = TogliReg(LineInput(1))

PrintLine(1, "NomeServer=" & TypeConn.NomeServer)
'TypeConn.NomeServer = TogliReg(LineInput(1))

PrintLine(1, "User=" & TypeConn.User) ' login
'TypeConn.User = TogliReg(LineInput(1))

PrintLine(1, "PassWord=" & TypeConn.PassWord)
'TypeConn.PassWord = TogliReg(LineInput(1))

PrintLine(1, "DNS=" & TypeConn.DNS)
'TypeConn.DNS = TogliReg(LineInput(1))

PrintLine(1, "TipoConnessione=" & TypeConn.TipoConnessione)
'TypeConn.TipoConnessione = TogliReg(LineInput(1))

PrintLine(1, "Trasparenze=" & TypeConn.Trasparenze)
'TypeConn.Trasparenze = TogliReg(LineInput(1))

PrintLine(1, "DimensionaForm=" & TypeConn.DimensionaForm)
'TypeConn.DimensionaForm = TogliReg(LineInput(1))

PrintLine(1, "Rete=" & TypeConn.Rete)
'TypeConn.Rete = TogliReg(LineInput(1))

PrintLine(1, "Schermo=" & TypeConn.Schermo)
If TypeConn.Schermo = "True" Then
If Sfondo.Visible = False Then
Sfondo.Visible = True
End If
Else
If Sfondo.Visible = True Then
Sfondo.Visible = False
End If

End If

'TypeConn.Schermo = TogliReg(LineInput(1))

PrintLine(1, "Backup=" & TypeConn.Backup)
'TypeConn.Backup = TogliReg(LineInput(1))

PrintLine(1, "BackupArch=" & TypeConn.BackupArch)
'TypeConn.BackupArch = TogliReg(LineInput(1))

PrintLine(1, "ConnectionString=" & Crypta(TypeConn.ConnectionString))
'TypeConn.ConnectionString = TogliReg(LineInput(1))

PrintLine(1, "DelPdf=" & TypeConn.DelPdf)
'TypeConn.DelPdf = TogliReg(LineInput(1))

PrintLine(1, "NCry=" & TypeConn.NCry)
'TypeConn.NCry = TogliReg(LineInput(1))

PrintLine(1, "FatturaCartaIntestata=" & TypeConn.FatturaCartaIntestata)
PrintLine(1, "MForzaPDFPrinter=" & TypeConn.MForzaPDFPrinter)

FileClose(1)

Exit Sub
Errore:
MsgBox("SalvaREGINIGlobale - " & Err.Description, MsgBoxStyle.Critical)

End Sub

Public Sub LeggiRegKeyGlobale()

Dim I As Long
TypeConn.MyDirPath = My.Application.Info.DirectoryPath
I = InStr(TypeConn.MyDirPath, "\bin\Debug")
If I > 0 Then
TypeConn.MyDirPath = Mid(TypeConn.MyDirPath, 1, I - 1)
End If

Try
TypeConn.PathDataBase = GetRegKey("PathDataBase")
Catch ex As Exception

SetRegKey("PathDataBase", TypeConn.MyDirPath & "\Database\Archivio.mdb", RegistryValueKind.String)
TypeConn.PathDataBase = TypeConn.MyDirPath & "\Database\Archivio.mdb"
End Try

Try
TypeConn.NomeDatabase = GetRegKey("NomeDatabase")
Catch ex As Exception
SetRegKey("NomeDatabase", "Archivio.mdb", RegistryValueKind.String)
TypeConn.NomeDatabase = "Archivio.mdb"
End Try

Try
TypeConn.NCry = Val(GetRegKey("NCry")) ' numero di Cryptazione
Catch ex As Exception
Err.Clear()
SetRegKey("NCry", "1", RegistryValueKind.String)
TypeConn.NCry = "1"
End Try

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

'TypeConn.NCry = 1

SectaArray(TypeConn.NCry)

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

Try
TypeConn.Autenticazione = GetRegKey("Autenticazione") ' "Autenticazione di Windows"
Catch ex As Exception
SetRegKey("Autenticazione", "1", RegistryValueKind.String)
TypeConn.Autenticazione = "1"
End Try

Try
TypeConn.Backup = GetRegKey("Backup") ' esegue backup sia dei sorgenti che del database in uscita da MENU
Catch ex As Exception
SetRegKey("Backup", "False", RegistryValueKind.String)
TypeConn.Backup = "False"
End Try
Try
TypeConn.BackupArch = GetRegKey("BackupArch") ' esegue solamente il backup degli archivi (se database e' MS ACCESS)
Catch ex As Exception
SetRegKey("BackupArch", "True", RegistryValueKind.String)
TypeConn.BackupArch = "True"
End Try
Try
TypeConn.ConnectionString = Decrypta(GetRegKey("ConnectionString")) ' e' solo un tipo di connessione "[Gestione database SQL SERVER]"
Catch ex As Exception
SetRegKey("ConnectionString", "", RegistryValueKind.String)
TypeConn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & TypeConn.MyDirPath & "\Database\Archivio.mdb" & ";Jet OLEDB:Database PassWord=iw0blpiw0fnb;"

End Try
Try
TypeConn.DelPdf = GetRegKey("DelPdf") ' Cancella in uscita tutti i PDF prodotti
Catch ex As Exception
SetRegKey("DelPdf", "True", RegistryValueKind.String)
TypeConn.DelPdf = "True"
End Try
Try
TypeConn.DimensionaForm = GetRegKey("DimensionaForm") '
Catch ex As Exception
SetRegKey("DimensionaForm", "True", RegistryValueKind.String)
TypeConn.DimensionaForm = "True"
End Try
'Try

' TypeConn.PathDataBase = GetRegKey("PathDataBase")

'Catch ex As Exception

' SetRegKey("PathDataBase", TypeConn.MyDirPath & "\Database\Archivio.mdb", RegistryValueKind.String)

' TypeConn.PathDataBase = TypeConn.MyDirPath & "\Database\Archivio.mdb"

'End Try

Try
TypeConn.DNS = GetRegKey("DNS")
Catch ex As Exception
SetRegKey("DNS", "1", RegistryValueKind.String)
TypeConn.DNS = "1"
End Try
'Try

' TypeConn.NomeDatabase = GetRegKey("NomeDatabase")

'Catch ex As Exception

' SetRegKey("NomeDatabase", "Archivio.mdb", RegistryValueKind.String)

' TypeConn.NomeDatabase = "Archivio.mdb"

'End Try

Try
TypeConn.NomeServer = GetRegKey("NomeServer")
Catch ex As Exception
SetRegKey("NomeServer", "1", RegistryValueKind.String)
TypeConn.NomeServer = "1"
End Try
Try
If TypeConn.MyDirPath <> GetRegKey("MyDirPath") Then
SetRegKey("MyDirPath", TypeConn.MyDirPath, RegistryValueKind.String)
End If
Catch ex As Exception
SetRegKey("MyDirPath", TypeConn.MyDirPath, RegistryValueKind.String)
End Try

Try
TypeConn.PassWord = Decrypta(GetRegKey("PassWord"))
Catch ex As Exception
SetRegKey("PassWord", "2", RegistryValueKind.String)
TypeConn.PassWord = "2"
End Try
Try
TypeConn.Rete = GetRegKey("Rete")
Catch ex As Exception
SetRegKey("Rete", "True", RegistryValueKind.String)
TypeConn.Rete = "True"
End Try
Try
TypeConn.Schermo = GetRegKey("Schermo")
Catch ex As Exception
SetRegKey("Schermo", "True", RegistryValueKind.String)
TypeConn.Schermo = "True"
If TypeConn.Schermo = "True" Then
If Sfondo.Visible = False Then
Sfondo.Visible = True
End If
Else
If Sfondo.Visible = True Then
Sfondo.Visible = False
End If

End If

End Try
Try
TypeConn.Trasparenze = GetRegKey("Trasparenze")
Catch ex As Exception
SetRegKey("Trasparenze", "True", RegistryValueKind.String)
TypeConn.Trasparenze = "True"
End Try
Try
TypeConn.TipoConnessione = GetRegKey("TipoConnessione")
Catch ex As Exception
SetRegKey("TipoConnessione", "[Gestione database Aziendale]", RegistryValueKind.String)
TypeConn.TipoConnessione = "[Gestione database Aziendale]"
End Try
Try
TypeConn.User = GetRegKey("User")
Catch ex As Exception
SetRegKey("User", "1", RegistryValueKind.String)
TypeConn.User = "1"
End Try
Try
TypeConn.NCry = Val(GetRegKey("FatturaCartaIntestata")) ' numero di Cryptazione
Catch ex As Exception
Err.Clear()
SetRegKey("FatturaCartaIntestata", "False", RegistryValueKind.String)
TypeConn.FatturaCartaIntestata = False
End Try
Try
TypeConn.MForzaPDFPrinter = Val(GetRegKey("MForzaPDFPrinter")) ' numero di Cryptazione
Catch ex As Exception
Err.Clear()
SetRegKey("MForzaPDFPrinter", "False", RegistryValueKind.String)
TypeConn.MForzaPDFPrinter = False
End Try

If Dir(TypeConn.MyDirPath & "\INI\NONScriveNeiRegistry.ini", FileAttribute.Normal) <> "" Then
NONScriveNeiRegistry = True
Else
NONScriveNeiRegistry = False
End If

' cancellazione Registro

' Registry.CurrentUser.DeleteSubKey(subkey)

End Sub

End Module