CONVERTISSEUR SQL->REQUETTE/ACCES ODBC DIRECT(ORACLE)

Dim Kar, karprec As String * 1
Dim CmdSQL(25), filesql As String
Dim i, k, m, q, X, y, zoe As Double
Dim Vtable, retour As String
Dim Vtableau(106, 2) As String
Dim automat, ero As Boolean


Private Sub bexe_Click()
TextBox2.Text = ""
ODBContact (TextBox1.Text) 'execute toute ou partie de requete SQL qui est dans le texbox1
End Sub

Private Sub bquitter_Click()
End
End Sub

Private Sub bVAuto_Click()
y = 0 'initialisation du compteur de requete
zoe = 0 'initilaisation du compteur de commande copier dans le goofy
automat = True 'interupteur à on
Open "C:\chorus\test\Goofy.sql" For Output Access Write As #2 'ouverture du fichier en ecriture

Goo 'appel procédure de convertion (insert, update -> select)

automat = False 'passage de l'interupteur à off
'MsgBox "traitement terminé", vbInformation, "Vérification automatique"

TextBox1.Text = "       // /////" & vbCrLf & "      \\  - -  //" & vbCrLf & "       (  @ @ )" & vbCrLf & "----oOOo--(_)-oOOo----------" & vbCrLf & "La vérification est terminé" & vbCrLf & "Résultat :" & vbCrLf & y & " commandes SQL examinées" & vbCrLf & zoe & " commandes ont échoués" & vbCrLf & vbCrLf & "les lignes SQL sont dans" & vbCrLf & "c:\Chorus\Goofy.sql " & vbCrLf & "---------------Ooooo--------" & vbCrLf & "               (   )" & vbCrLf & "      ooooO     ) /" & vbCrLf & "      (   )    (_/" & vbCrLf & "       \ (" & vbCrLf & "        \_)" & vbCrLf
TextBox1.Font = "fixedsys"
TextBox1.Font.Size = 9

Close #2
End Sub

Private Sub bVMan_Click()
Goo 'lancement de la procédure d'analyse(etant compris l'affichage si l'intérupteur est off
TextBox1.Font = "small fonts"
TextBox1.Font.Size = 7
End Sub

Private Sub Form_Load()
automat = False 'au démarrage l'intérupteur est off
ero = False
End Sub


Private Sub List1_Click()

TextBox1.Text = ""
TextBox2.Text = ""
List2.ListIndex = List1.ListIndex 'sélection dynamique de la ligne de la commande correspondand au select
Text1 = List1.ListIndex + 1
TextBox1.Text = List1.Text
ODBContact (List1.Text) 'procédure d'envoi au serveur et retour des informations
'Clipboard.SetText List1.Text copie dans le presse papier
End Sub

Private Sub Command1_Click()
    frmAbout.Show vbModal 'just for fun
    Unload frmAbout
    Set frmAbout = Nothing

End Sub
Public Sub Goo() 'Procédure d'analyse liée à l'interupteur pour les fonctions d'affichages
Dim test, ligne, filesql As String
Dim j, k As Integer
'Connection Information
 'On Error GoTo erro 'gestion d'une erreur éventuelle : ici l'adress fichier invalide
filesql = Text.Text

   ' TextBox.Text = ""
    List1.Clear
    List2.Clear
   
     ero = True
 Open filesql For Input Access Read As #1 'ouverture du fichier en lecture seulement
    
    i = 1
    karsuivant 'appel procédure qui pointe sur le caractère suivant et qui enregistre
    'la commandeSQL du insert/update jusqu'au point virgule
   ero = False
    While Not EOF(1) And Kar <> ";"
        If i <> 25 Then
            test = toaster(6) 'appel fonction toaster (un nombre de caractère)
            'elle permet d'analysé en une fois les (N)éléments suivants
            'exemple si les 6 premier caractère sont un "insert_" elle remvoit insert
            'MsgBox test
            '--------------------------------------------------------------------------
            If test = "INSERT" Then 'test du resultat de la fonction toaster :
                proinsert 'procédure insert voir plus loin
                'MsgBox CmdSQL(i), , "Votre aimable serviteur dit que :"
                
            'concaténation de la requete, un tableau à deux dimensionS contient dans une colonne
            'le nom des champs et de l'autre les valeurs correspondante
                ligne = "SELECT * " & vbCrLf & "FROM" & Vtable & vbCrLf & "WHERE " & Vtableau(0, 1) & " = " & Vtableau(0, 2) & vbCrLf
            
                For z = 1 To q - 1
                        If Vtableau(z, 2) <> "''" Then
                            ligne = ligne & " AND " & Vtableau(z, 1) & " = " & Vtableau(z, 2) & vbCrLf
                        End If
                Next
                ligne = ligne & ";"
            'fin concaténation
            'début de l'affichage si l'intérupteur est off
                If automat = False Then
                    List2.AddItem CmdSQL(i)
                    List1.AddItem ligne
                    Gridy.Cols = 0
                Else
                    ODBContact (ligne)
                End If
                ligne = ""
                Vtable = ""
                i = i + 1
            End If
            '-------------------------------------------------------------------------
            If test = "UPDATE" Then
                proupdate 'procédure update
                
            End If
            '-------------------------------------------------------------------------
            If test = "DELETE" Then
             While Kar <> ";"
                karsuivant
             Wend
                    If automat = False Then
                    MsgBox "ATTENTION IL Y A UNE COMMANDE DELETE", vbCritical, "ALERTE IMPORTANT"
                    Else
                    Print #2, CmdSQL(i)
                    End If
            i = i + 1
            End If
            '-------------------------------------------------------------------------
            
            
            toaster (3)
            
       Else 'limitation de l'éxecution pour gagner en rapidité et stabilité et mémoire
           'MsgBox "la limite des 25 est dépassé"
           For i = 1 To 25
            CmdSQL(i) = ""
           Next
           i = 1
       
       End If
    Wend
    NbCmd.Text = List1.ListCount 'compteur du nombre d'élément dans le listeboc equivalent au nombre de requete
   

erro:
If ero = True Then
MsgBox "le nom de fichier ou le chemin d'acces au fichier sont incorrect " & vbCrLf & "Sinon vérifier que le fichier n'est deja pas ouvert par une autre application" & vbCrLf & "merci de le corriger", vbCritical, "Erreur fichier"
erro = False
End If
Close #1 'fermeture du fichier
 NbCmd.Text = List1.ListCount 'compteur du nombre d'élément dans le listeboc equivalent au nombre de requete
   

End Sub

Private Sub List2_Click()
'dynamique d'affichage entre les listebox pointe vers le select correspondant
List1.ListIndex = List2.ListIndex

End Sub

Private Sub List2_DblClick()
List1.ListIndex = List2.ListIndex
TextBox1.Text = ""
Clipboard.SetText List2.Text 'copie la commande SQL dans le presse papier
TextBox1.Text = List2.Text 'affiche la commande sql dans le textbox

End Sub

Public Function toaster(param) 'revoie les n element suivant concaténé pour former un mot
Dim testost(10) As String
Dim o As Integer

For o = 0 To (param - 1)
testost(o) = Kar
karsuivant
Next

For o = 0 To (param - 1)
tampon = tampon & testost(o)
Next
toaster = tampon

End Function

Public Sub proinsert()

While Kar <> ";"
tampon = toaster(5)

    If tampon = " INTO" Then
    table 'procédure table
    Value ' procédure value
    End If

Wend
End Sub

Public Sub table() 'procédure qui extrait le nom de la table dans un insert ainsi que
'le nom des champs
Dim trampo As Variant

While Kar <> "("
    trampo = trampo & Kar
     karsuivant
Wend
Vtable = trampo
'msgbox Vtable
trampo = ""
If Kar = "(" Then
'MsgBox Kar, vbDefaultButton4, "Variable Kar dans table test d'entrée "
    karsuivant
    q = 0
    Gridy.Row = 0
    While Kar <> ")"
        If Kar <> "," Then
            trampo = trampo & Kar
            
        Else
            Vtableau(q, 1) = trampo
            'affichage au conditionnel puisque test de l'interupteur
                If automat = False Then
                Gridy.Cols = q + 2 'ajoute au fur et à mesure des colonnes pour les champs
                Gridy.Col = q
                Gridy.Text = Vtableau(q, 1)
                End If
            trampo = ""
           
            q = q + 1
        End If
        karsuivant
    Wend
Vtableau(q, 1) = trampo
            If automat = False Then
            Gridy.Cols = q + 1 'ajoute au fur et à mesure des colonnes pour les champs
            Gridy.Col = q
            Gridy.Text = Vtableau(q, 1)
            End If
            trampo = ""
           
            q = q + 1
End If

End Sub

Public Sub karsuivant() 'correspond à l'avancement du pointeur de 1
If Not EOF(1) Then
karprec = Kar 'kar correspond au caractère courrant et karprec au caratere précédent
Kar = Input(1, #1)
'Text1.Text = Text1.Text & Kar 'affichage du fichier dans le textbox
'concaténation des caratère pour former la commande SQL initiale
CmdSQL(i) = CmdSQL(i) & Kar
End If


End Sub

Public Sub Value() 'produre permettant d'extraire les valeurs contenue dans le insert
Dim garry As String
Dim w As Integer
Dim kara, karo As String * 1

'MsgBox "procédure Value"
karsuivant
karsuivant
garry = toaster(8)

w = 0
If garry = "VALUES (" Then
    While Kar <> ";"
        Gridy.Row = 1
        If Kar <> "," Then
            'prise en compte du format spécial des dates
            If kara = "," And karo = "T" And Kar = "O" Then ' definition du format de date
            
              While Kar <> ")"
             tampon = tampon & Kar
             karsuivant
             Wend
             tampon = tampon & ")"
            Else
                If Kar <> ")" Then
                tampon = tampon & Kar
                End If
            End If
        Else
        
        Vtableau(w, 2) = tampon
        tampon = ""
         'affichage au conditionnel puisque test de l'interupteur
            If automat = False Then
                If w <= 31 Then
                Gridy.Col = w
                Gridy.Text = Vtableau(w, 2)
                End If
            End If
        w = w + 1
        End If
        kara = karo
        karo = Kar
        karsuivant
    Wend
    Vtableau(w, 2) = tampon
        tampon = ""
         'affichage au conditionnel puisque test de l'interupteur
        If automat = False Then
        If w <= 31 Then ' sinon on atteint les limite du msflexgrid
        Gridy.Col = w
        Gridy.Text = Vtableau(w, 2)
        End If
        End If
Else
MsgBox "erreur dans la procédure value ne touve pas les caractères VALUES ("


End If
'MsgBox "fin procédure Value"
End Sub

Public Sub proupdate()
'procédure permettant de convertir les update en select
While Kar <> ";"
    While Kar <> "S"
    Vtable = Vtable & Kar
    karsuivant
    'MsgBox Vtable
    Wend
    'MsgBox Vtable
    tampon = toaster(3)
    
    If tampon = "SET" Then
        While Kar <> "W" And karprec <> ""
            If Kar <> "," Then
                If karprec = "=" And Kar = "T" Then
                While Kar <> ")"
                ligne2 = ligne2 & Kar
                karsuivant
                Wend
                ligne2 = ligne2 & ")"
                Else
                ligne2 = ligne2 & Kar
                End If
            Else
                ligne2 = ligne2 & vbCrLf & " AND "
            End If
            karsuivant
        Wend
        
        While Kar <> ";"
         ligne = ligne & Kar
         karsuivant
        Wend
    ligne = ligne & vbCrLf & "AND" & ligne2 & ";"
    
     ligne = "SELECT * " & vbCrLf & "FROM " & Vtable & vbCrLf & ligne
    End If
    
Wend
 'affichage au conditionnel puisque test de l'interupteur
If automat = False Then
            List2.AddItem CmdSQL(i)
             List1.AddItem ligne
             Gridy.Cols = 0
Else
             ODBContact (ligne)
End If

ligne = ""
Vtable = ""
i = i + 1
End Sub



Public Sub ODBContact(commande As String)
'procédure de connexion à la base de donnée odbc distante avec renvoi des données
Dim SI As Database
Dim qUEry As QueryDef
Dim enRegistre As Recordset
Dim fld As Field
Dim connect As String

connect = "UID=" & Nom.Text & ";PWD=" & secret.Text & ";DSN=" & server.Text & ";" ' concaténation de la chaine de connexion avec les information saisie
ero = True
On Error GoTo lafin
Set SI = OpenDatabase("", dbDriverNoPrompt, True, connect) ' configuration de l'objet Database

'MsgBox connexion.Name, , "Nom de la Base de donnée (DSN)"

Set qUEry = SI.CreateQueryDef("") 'cree une requete temporaire
qUEry.connect = "ODBC;" & connect 'important : configure la connexion de la requete

qUEry.SQL = commande 'affectation de la requete SQl à executer
'MsgBox commande
qUEry.ReturnsRecords = True
'MsgBox qUEry.Name
'MsgBox qUEry.SQL

' configuration de l'obet qui va stocker les enregistrement retourné la requete qui le défini
 Set enRegistre = qUEry.OpenRecordset(dbOpenForwardOnly, ReadOnly)

 
' bouleen disant si des données ont été envoyé ou pas (sens server -> client)
 If enRegistre.RecordCount = 0 Then
    If automat = False Then
    TextBox2.TextRTF = "il n' YA PAS d'enregistrement CORRESPONDANT à cette requète "
    End If
    If automat = True Then
    'MsgBox CmdSQL(i)
    zoe = zoe + 1
    Print #2, CmdSQL(i)
    End If
    
 Else
 'procédure d'affichage ou non suivant la position de l'interupateur
 If automat = False Then
        Text8.Text = enRegistre.RecordCount
        j = 0
        While Not enRegistre.EOF
        TextBox2.Text = TextBox2.Text & "------ " & j + 1 & " -----------------------------------------------------" & vbCrLf
       For Each fld In enRegistre.Fields
         TextBox2.Text = TextBox2.Text & fld.Name & " = " & fld.Value & vbCrLf
            Next fld
            
        enRegistre.MoveNext 'déplacement du curseur sur l'enregistrement suivant (fetch)
        j = j + 1
        Wend
     
        Text8.Text = j
        
        
    End If
End If
i = i + 1
y = y + 1
enRegistre.Close 'fermeture de recorset

qUEry.Close 'fermeture du query
SI.Close 'fermeture de la connexion à la base
'MsgBox i
ero = False

lafin:
If ero = True Then
    If automat = False Then
    MsgBox "Verif .SQL n'a pu établir la connexion avec le serveur distant." & vbCrLf & "Veuiller vérifier l'intégrité des sources ODBC " & vbCrLf & "Panneau de configuration / Source de donnée ODBC  "
    ero = False
    Else
    MsgBox enRegistre.RecordCount
    End If
End If

End Sub
Private Sub Text_dblClick()
With CommonDialog1
        .Filter = ("fichier SQL (*.sql)|*.sql")
        .ShowOpen
    End With
    Text = CommonDialog1.filename
End Sub