Attribute VB_Name = "Module1"
Option Explicit
'
'
     Global Stringa As String '
     Public DbAz As Connection
     Public Rs As Recordset
     Public DbName As String
     Public MyDirPath As String
     Public Riavvia As Boolean   ' serve a riavviare il form
    ' **************************************************
    ' Variabili Colori Pagina HTML
     Public ColoreRiga1 As String
     Public ColoreRiga2 As String
     Public Chiaro1 As String
     Public Chiaro2 As String
'
'*****************************************************************************************

Function Replica(ByVal Chr As String, ByVal Num As Long) As String
'*****************************************************************************************
            Dim I As Long
            Dim Mstr As String
            For I = 1 To Num
            Mstr = Mstr & Chr
            Next
            Replica = Mstr
End Function


'*********************************************************
'*                                                       *
Public Function DestraDec(ByVal Mstringa As String, ByVal Mspaz As Long) As String
'*                                                       *
'*********************************************************
   If Len(Mstringa) = Mspaz Then
         DestraDec = Mstringa
         Exit Function
   End If
Dim C As Long
'c = InStr(1, MStringa, ",")
    If Mstringa <> "0" Then
          Mstringa = Format(CDbl(Mstringa), "###,###,###,###.00")
    End If
    Do While Len(Mstringa) < Mspaz
          Mstringa = " " & Mstringa
    Loop
    DestraDec = Mstringa
End Function



           '*********************************************************
          '*                                                       *
          Public Function Destra(ByVal Stringa As String, ByVal spazio As Long)
          '*                                                       *
          '*********************************************************
          Dim DifferenzaSpazio As Integer
               If IsNull(Stringa) Then
                Stringa = " "
               End If
                If Len(Stringa) > spazio Then
                 Stringa = Mid(Stringa, 1, spazio)
                End If
           DifferenzaSpazio = spazio - Len(Stringa)
           Destra = Space(DifferenzaSpazio) & Stringa
           End Function



          '*********************************************************
          '*                                                       *
          Public Function Sinistra(ByVal Stringa As String, ByVal spazio As Long)
          '*                                                       *
          '*********************************************************
          On Error Resume Next
          Dim DifferenzaSpazio As Integer
               If Len(Stringa) > spazio Then
                Stringa = Mid(Stringa, 1, spazio)
               End If
           DifferenzaSpazio = spazio - Len(Stringa)
           Sinistra = Stringa & Space(DifferenzaSpazio)
           End Function


          '*********************************************************
          '*                                                       *
          Public Sub Main()
          '*                                                       *
          '*********************************************************
  
         If Dir(App.Path & "\INI", vbDirectory) = "" Then
             MkDir App.Path & "\INI"
         End If
  
 On Error Resume Next
        If Dir(App.Path & "\INI\ColoreGriglia.ini") <> "" Then
           Open App.Path & "\INI\ColoreGriglia.ini" For Input As #1
             Line Input #1, Stringa          ' #A8FFA8 -/- RGB(168.255.168)
            Line Input #1, ColoreRiga1 '##A8FFA8
             Line Input #1, Stringa            '0:
             Line Input #1, Stringa           '168:
             Line Input #1, Stringa            '255:
             Line Input #1, Stringa            '168:
             Line Input #1, Stringa              '****************************
             Line Input #1, Stringa             '#00A800 -/- RGB(0.168.0)
            Line Input #1, ColoreRiga2       '##00A800
            Line Input #1, Stringa           '0:
           Line Input #1, Stringa            '0:
            Line Input #1, Stringa           '168:
            Line Input #1, Stringa           '0:
             Close #1
        Else
            ColoreRiga1 = "#FFFF99"
            ColoreRiga2 = "#FFFFFF"
            Chiaro1 = ""
            Chiaro2 = ""
        End If
  
        If Err.Number > 0 Then
        MsgBox "File Colori.ini corrotto, Ricompilazione in esecuzione ", vbCritical, "KO"
        Shell "Explorer.exe " & App.Path & "\ColoriNew.exe", vbNormalFocus
        End
        End If
  
       Menu.Show 1
  
  
       End Sub

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

          '*********************************************************
            Public Function ApriDatabase() As Boolean
'*****************************************************************************************

            MyDirPath = App.Path

             'Dim DbName As String
             DbName = Menu.TextPercorso.Text    ' "D:\Procedure\Frequenze Radio\database\Frequenze.mdb"

             If Dir(DbName) = "" Then
             MsgBox "Percorso o database inesistente ... controllare prego ", vbCritical, "Errore !!"
             Menu.TextPercorso.SetFocus
             ApriDatabase = False
             Exit Function
             End If

               On Error Resume Next
                     Set DbAz = New Connection
                     DbAz.CursorLocation = adUseClient
'''                      DbAz.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & DbName ' & 'D:\Procedure\Frequenze Radio\database\Frequenze.mdb
    '               DbAz.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & DbName   & Chr(34) & ";Mode=ReadWrite|Share Deny None;Persist Security Info=False"
DbAz.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & DbName & ";Mode=ReadWrite|Share Deny None;Persist Security Info=False"
                     ApriDatabase = True

  '                   If Err.Number <> 0 Then
  '                         Set DbAz = New Connection
  '                         DbAz.CursorLocation = adUseClient
'                           DbAz.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & DbName & ";Mode=ReadWrite|Share Deny None;Persist Security Info=False"
 '                  DbAz.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & DbName & ";Mode=ReadWrite|Share Deny None;Persist Security Info=False"
                           If Err.Number <> 0 Then
                           Set DbAz = New Connection
                           DbAz.CursorLocation = adUseClient
                           Err.Clear
                Stringa = InputBox("Inserisci la password per accedere al database", "Inserisci la password per accedere al database")
                        If Stringa <> "" Then
                            DbAz.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & DbName & ";Jet OLEDB:Database Password=" & Stringa
                       Else
                            Err.Number = 10
                       End If
                   End If
                   If Err.Number <> 0 Then
                                 MsgBox "Errore nella connessione al Database " & Chr(13) & Err.Number & " " & Err.Description & Chr(13) & "FINE PROCEDURA", vbCritical, "Errore di COnnessione al Database"
                                            'End
                                  ApriDatabase = False
                                  Exit Function
                                  
                   End If
                     ApriDatabase = True

                

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