lire le code
Source / Exemple :
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
Conclusion :
ouvre un fichier .sql contenant des insert/update ou delete,
converti tout ce beau monde en select les transmet au serveur ODBC(ici une base oracle)
si elles ne sont pas présente sur le serveur il génere un fichier goofy.sql contenant les insert /update qui ne sont pas présent sur la base
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.