Connexion avec vb6 et oracle 9i et exécution d'un fichier batch

0/5 (20 avis)

Vue 4 033 fois - Téléchargée 525 fois

Description

Ce projet m'a permis de connecter mon formulaire avec une table d'une base de données Oracle 9i et d'exécuter un ficher batch.

Source / Exemple :


Dim cn As New ADODB.Connection
Dim uti As New ADODB.Recordset
Dim sql As String
Dim zsauv

Sub connexion()
'Connexion avec la base Altbank
    Set cn = New ADODB.Connection
    cn.Open "Provider=MSDAORA.1;Password=bankafbcd30061979;User ID=altbank;Data Source=Altbank;Persist Security Info=True"
End Sub

Sub verif_CboNomUt()
    'Vérification du contenu du combo
        If CboNomUt.Text = "" Then
            MsgBox "Choisir un nom d'utilisateur dans la liste avant de continuer svp!", vbInformation, "Déconnexion Altbank"
            CboNomUt.SetFocus
        Else
            TxtPswd.Text = ""
            TxtPswd.SetFocus
        End If
End Sub

Sub valid_MotPasse()
    If TxtPswd.Text = "" Then
        If CboNomUt.Text = "" Then
            MsgBox "Choisir d'abord le nom d'utilisateur svp.", vbInformation, "Déconnexion Altbank"
            CboNomUt.SetFocus
        Else
            MsgBox "Le mot de passe doit être renseigné!", vbInformation, "Déconnexion Altbank"
            TxtPswd.SetFocus
        End If
    Else
        CmdValider.SetFocus
    End If
End Sub

Private Sub CboNomUt_GotFocus()
    'Désactivation de certains contrôles
    LblUt.Caption = ""
    Frame2.Enabled = False
    TxtPswd.Text = ""
End Sub

Private Sub CboNomUt_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        Call verif_CboNomUt
    End If
End Sub

Private Sub CboNomUt_Validate(Cancel As Boolean)
    Call verif_CboNomUt
End Sub

Private Sub CmdAnnuler_Click()
    Dim rep1
    Dim rep2
    rep1 = MsgBox("Etes-vous sûr de vouloir abandonner?", vbCritical + vbYesNo, "Déconnexion Altbank")
    If rep1 = vbYes Then
        MsgBox "A la prochaine!!!", vbExclamation, "Déconnexion Altbank"
        End
    Else
        If rep1 = vbNo Then
            rep2 = MsgBox("Continuer avec le même utilisateur?", vbYesNo, "Déconnexion Altbank")
            Select Case rep2
                Case Is = vbYes
                    CmdValider.SetFocus
                    Exit Sub
                Case Is = vbNo
                    CboNomUt = ""
                    TxtPswd = ""
                    CboNomUt.SetFocus
                    Exit Sub
            End Select
        End If
    End If
End Sub

Private Sub CmdNon_Click()
    MsgBox "Aucun utilisateur n'a été déconnecté!", vbInformation, "A la prochaine!"
    End
End Sub

Private Sub CmdOui_Click()
Dim EtatCon As String
Dim rep

        'Déconnexion proprement dite
        rep = MsgBox("Etes-vous sûr de vouloir déconnecter cet utilisateur?", vbExclamation + vbYesNo, "Déconnexion Altbank")
        If rep = vbYes Then
            Set uti = Nothing
            sql = "select * from utilisateur where coduti='" & CboNomUt & "'"
            uti.CursorType = adOpenKeyset
            uti.CursorLocation = adUseClient
            uti.LockType = adLockOptimistic
            uti.Open sql, cn, , , adCmdText
            On Error Resume Next
            Select Case uti!connecter
            Case Is = "O"
                uti!connecter = "N"
                uti.Update
                EtatCon = "ok"
            Case Is = "N"
                MsgBox "Cet utilisateur n'a pas besoin d'être déconnecté et peut donc travailler avec Altbank.", vbInformation, "Déconnexion Altbank"
                End
            End Select
                uti.Close
                
                'Vérification de l'effectivité de la déconnexion
                If EtatCon = "ok" Then
                    MsgBox "L'utilisateur a été déconnecté avec succcès. Il peut continuer à travailler dans Altbank!!!", _
                            vbInformation, "Déconnexion Altbank"
                    End
                End If
        End If
        
        If rep = vbNo Then
            MsgBox "L'utilisateur n'a pas été déconnecté!", vbInformation, "Déconnexion Altbank"
            End
        End If
            
End Sub

Private Sub CmdValider_Click()

    'Arrêt du processus altbank
    Dim FinProcessus As Integer
    FinProcessus = Shell("C:\DeconAlt\ArretAltbank.bat", vbHide)

    Set uti = Nothing
    sql = "select * from utilisateur where coduti='" & CboNomUt & "'"
    uti.CursorType = adOpenKeyset
    uti.CursorLocation = adUseClient
    uti.LockType = adLockReadOnly
    uti.Open sql, cn, , , adCmdText
    On Error Resume Next
    While Not uti.EOF
        If CboNomUt.Text = "" Or TxtPswd.Text = "" Then
            MsgBox "Le nom d'utilisateur et le mot de passe doivent être renseignés pour valider.", vbInformation, "Déconnexion Altbank"
            CboNomUt.Text = ""
            TxtPswd.Text = ""
            CboNomUt.SetFocus
            Exit Sub
        Else
            If CboNomUt.Text = uti!coduti And TxtPswd.Text = "altbank" Then
                GoTo Valider
            Else
                GoTo NonValider
            End If
        End If
    Wend
    
'Activation du frame2 et affichage du nom de l'utilisateur à déconnecter
Valider:
                    Frame2.Enabled = True
                    LblUt.Caption = uti!nom
                    CmdOui.SetFocus
                    Exit Sub
                    
'Mot de passe non valide
NonValider:
                    zsauv = zsauv + 1
                    MsgBox "Ce mot de passe ne vous donne pas le pouvoir de déconnecter un utilisateur!!!", vbCritical, "Déconnexion Altbank"
                    If zsauv = 3 Then
                        MsgBox "Vous n'êtes pas habilité à utiliser ce logiciel. Contactez l'Administrateur svp!!!", vbExclamation, "Attention"
                        End
                    Else
                        CboNomUt.Text = ""
                        TxtPswd.Text = ""
                        CboNomUt.SetFocus
                    End If
                    Exit Sub
End Sub

Private Sub Form_Load()
    'Désactivation de certains contrôles
    Frame2.Enabled = False

    'Ouverture de la connexion
    Call connexion
    
    'Initialisation du jeu d'enregistrements des codes utilisateurs
    Set uti = Nothing
    sql = "select coduti from utilisateur where coduti not in ('long','wata','deja','AUTO','adm')"
    uti.CursorType = adOpenStatic
    uti.CursorLocation = adUseClient
    uti.LockType = adLockOptimistic
    uti.Open sql, cn, , , adCmdText
    'Chargement des codes utilisateurs dans le combo
    While uti.EOF = False
        CboNomUt.AddItem uti!coduti
        uti.MoveNext
    Wend
End Sub

Private Sub TxtPswd_GotFocus()
    'Désactivation de certains contrôles
    LblUt.Caption = ""
    Frame2.Enabled = False
    TxtPswd.Text = ""
End Sub

Private Sub TxtPswd_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
    Call valid_MotPasse
End If
End Sub

Private Sub TxtPswd_LostFocus()
    Call valid_MotPasse
End Sub

Private Sub TxtPswd_Validate(Cancel As Boolean)
    Call valid_MotPasse
End Sub

Conclusion :


Je crois que cela pourrait aider d'autres personnes et bon encodage chers amis.

Codes Sources

A voir également

Ajouter un commentaire Commentaires
Messages postés
63
Date d'inscription
jeudi 4 décembre 2003
Statut
Membre
Dernière intervention
23 avril 2013

Très bien.
Je te joins ci-dessous une base de Dev concernant le chargement de fichiers pour Oracle. Tu devras adapter le code mais il est simple(presque). Pour Sql Serveur c'est plus hard, car il faut tenir compte de la version du serveur et même de la realease (2008 et 2008R2 par exemple).
'-------------------------------------------------------------------------------
'Creation du fichier de format (.ctl) de chargement d'une table pour Oracle
'Creation du fichier de format (.fmt) de chargement d'une table pour SqlServeur
'-------------------------------------------------------------------------------

Public Function CreaFicFormat(ByVal TypeBase As TypeBaseDonnees, ByVal sNomTableCible As String, ByVal sRepertoire As String) As String
Dim FicCtlOra As String
Dim sScript As String
Dim i As Integer
Dim RstTmp As ADODB.Recordset
Dim iCan As Integer

'
On Error Resume Next
'
Set RstTmp = New ADODB.Recordset
RstTmp.CacheSize = 1
RstTmp.CursorLocation = adUseServer
RstTmp.LockType = adLockPessimistic
RstTmp.MaxRecords = 1
RstTmp.Open "Select * from " & sNomTableCible, dbConn, adOpenStatic, adLockOptimistic, adAsyncFetch
Do While RstTmp.State > 1
DoEvents
Loop
If dbConn.Errors.Count > 0 Then
CreaFicFormat = ""
Set RstTmp = Nothing
Exit Function
End If
'
'ORACLE creation du fichier de format (.ctl) de chargement d'une table depuis un fichier texte
If TypeBase = Base_Oracle Then
'Creation de l'entête du fichier
sScript = "Load Data" & vbCrLf & _
"INTO TABLE " & sNomTableCible & " Append " & vbCrLf & _
"FIELDS TERMINATED BY ';' TRAILING NULLCOLS " & vbCrLf & _
"(" & vbCrLf

For i = 0 To RstTmp.Fields.Count - 1
sScript = sScript & Trim(UCase(RstTmp.Fields(i).Name)) & " "
'traitement des dates If RstTmp.Fields(i).Type adDate Or RstTmp.Fields(i).Type adDBDate Or RstTmp.Fields(i).Type = adDBTime Or RstTmp.Fields(i).Type = adDBTimeStamp Then
sScript = sScript & " " & """" & "to_date(:" & RstTmp.Fields(i).Name & ",'DD/MM/YYYY HH24:MI:SS')" & """"
'Traitement des valeurs numériques ElseIf RstTmp.Fields(i).Type adBigInt Or RstTmp.Fields(i).Type adCurrency Or RstTmp.Fields(i).Type = adDecimal Or RstTmp.Fields(i).Type = adDouble Or RstTmp.Fields(i).Type = adInteger Or RstTmp.Fields(i).Type = adNumeric Or RstTmp.Fields(i).Type = adSingle Or RstTmp.Fields(i).Type = adSmallInt Then
If Not IsNull(RstTmp.Fields(i).NumericScale) Then
If Val(RstTmp.Fields(i).NumericScale) > 0 Then
sScript = sScript & " " & """" & "to_number(:" & RstTmp.Fields(i).Name & ",'" & String((Val(RstTmp.Fields(i).Precision) - Val(RstTmp.Fields(i).NumericScale)), "9") & "D" & String(Val(RstTmp.Fields(i).NumericScale), "9") & "','NLS_NUMERIC_CHARACTERS=''.,''')" & """"
Else
sScript = sScript & " " & """" & "to_number(:" & RstTmp.Fields(i).Name & ")" & """"
End If
End If
'Traitement Des Chaines
Else
If Not IsNull(RstTmp.Fields(i).DefinedSize) Then
If Val(RstTmp.Fields(i).DefinedSize) > 254 Then
sScript = sScript & " " & " CHAR(4000)"
Else
sScript = sScript & " " & """" & "to_char(:" & RstTmp.Fields(i).Name & ")" & """"
End If
End If
End If
If i < (RstTmp.Fields.Count - 1) Then sScript = sScript & "," & vbCrLf
Next i
sScript = sScript & vbCrLf & ")"
If Right(sRepertoire, 1) <> "" Then sRepertoire = sRepertoire & ""
FicCtlOra = sRepertoire & sNomTableCible & ".ctl"
Err.Clear
iCan = FreeFile(1)
Open FicCtlOra For Output As #iCan
If Err.Number = 0 Then
Print #iCan, sScript
Close #iCan
CreaFicFormat = FicCtlOra
Else
CreaFicFormat = ""
End If
End If
Set RstTmp = Nothing
End Function

'-----------------------------------------------------------------------------
'-- Intégration d'enregistrements dans une table depuis un fichier texte
'-----------------------------------------------------------------------------
Public Function LoaderTable(ByVal TypeBase As TypeBaseDonnees, ByVal sNomTableCible As String, ByVal sFichier As String, ByVal sRepertoire As String, ByVal sFicFormat As String, ByVal bDelete As Boolean, Optional ByRef sMessage_Erreur As String) As Boolean
Dim sCmd As String
Dim Retval As Variant
Dim lNbLignes As Long
Dim sMsgErr As String
'
On Error Resume Next
sMessage_Erreur = ""
'
sRepertoire = Trim(sRepertoire)
If Right(sRepertoire, 1) <> "" Then sRepertoire = sRepertoire & ""
lNbLignes = NbLignesFic(sRepertoire & sFichier, ";", , sMsgErr)
If lNbLignes <= 0 And sMsgErr <> "" Then
sMessage_Erreur = sMsgErr
LoaderTable = False
Exit Function
End If
If bDelete Then
ExecuteCommande "Truncate table " & sNomTableCible, , , sMsgErr
If sMessage_Erreur <> "" Then sMessage_Erreur = sMessage_Erreur & vbCrLf
If sMsgErr <> "" Then sMessage_Erreur = sMessage_Erreur & sMsgErr
End If
If TypeBase = Base_Oracle Then
'Création d'un script d'exécution de l'utilitaire loader.exe Oracle
'control > indique au loader le fichier de format à utiliser
'data > indique au loader le fichier source (texte) à charger
'log > indique au loader le fichier log à générer
'discard > indique au loader le fichier des lignes rejetées à générer
'errors > renseigner le nombre d'erreurs autorisées avant que le chargement ne soit annulé.
'D'autres paramètres peuvent êtres passés à la commande (voir Doc Oracle)
If Dir(sRepertoire & sNomTableCible & ".log") Then Kill sRepertoire & sNomTableCible & ".log"
If Dir(sRepertoire & sNomTableCible & ".bad") Then Kill sRepertoire & sNomTableCible & ".bad"
If Dir(sRepertoire & sNomTableCible & ".lngRejet") <> "" Then Kill sRepertoire & sNomTableCible & ".lngRejet"
sCmd = "sqlldr userid=" & dbOraUserId & " " & _
"control='" & sFicFormat & "' " & _
"data='" & sRepertoire & sFichier & "' " & _
"log='" & sRepertoire & sNomTableCible & ".log" & "' " & _
"bad='" & sRepertoire & sNomTableCible & ".bad" & "' " & _
"discard='" & sRepertoire & sNomTableCible & ".lngRejet" & "' " & _
"errors=" & lNbLignes & " Rows=10000 bindsize=20000000"
Retval = Shell(sCmd, 1) If Retval > 0 Then LoaderTable True Else LoaderTable False
End If
End Function

'--------------------------------------------------------------------------------------------------------------
'-- Rechercher le nombre de ligne d'un fichier et en option, la cohérence du nombre de séparateurs de champs
'--------------------------------------------------------------------------------------------------------------
Public Function NbLignesFic(ByVal sNomFic, Optional ByVal sSeparateur As String, Optional ByRef iNbSeparateurs As Integer, Optional ByRef sMessageErreur As String) As Long
Dim iCan As Integer
Dim lNbLig As Long
Dim sLigne As String
Dim iNbSep As Integer
Dim iNbSepMin As Integer
Dim iNbSepMax As Integer
'
On Error Resume Next
'
sNomFic = Trim(sNomFic)
sMessageErreur = ""
NbLignesFic = 0
lNbLig = 0
'
'Ouverture du fichier texte
Err.Clear
iCan = FreeFile(1)
Open sNomFic For Input As #iCan
If Err.Number <> 0 Then
'Renseigner le message d'erreur et fixer le nombre de lignes à -1 pour indiquer l'échec d'ouverture
sMessageErreur = Err.Number & "/" & Err.Description
lNbLig = -1
Else
If LOF(iCan) > 0 Then
Do While Not EOF(iCan)
Line Input #iCan, sLigne
lNbLig = lNbLig + 1
'Rechercher le nombre de séparateur de champs (si renseigné) pour les 10 premières lignes (Le nombre peut être modifié en fonction des besoins)
' Cet opération ralenti le comptage des lignes c'est pourquoi le controle des champs est limité aux premières lignes
If lNbLig < 10 And sSeparateur <> "" Then
iNbSep = NbOccurence(sLigne, sSeparateur)
If lNbLig = 1 Then
iNbSepMin = iNbSep
Else
If iNbSep < iNbSepMin Then iNbSepMin = iNbSep
End If
If iNbSepMax < iNbSep Then iNbSepMax = iNbSep
End If
Loop
If sSeparateur <> "" Then
'Indiquer si le nombre de séparateurs de champs est cohérent (égal pour chaque ligne)
If iNbSepMin <> iNbSepMax Then
sMessageErreur = "Incohérence du nombre de colonnes dans les lignes du fichier."
End If
End If
Else
'Indiquer que le fichier est vide (0 octets)
lNbLig = 0
sMessageErreur = "Fichier valide mais Vide."
End If
Close #iCan
End If
NbLignesFic = lNbLig
End Function

'---------------------------------------------------------------------------------------------
'Rechercher le nombre d'occurrence d'un caractère ou d'un goupe de caractères dans une chaine.
'----------------------------------------------------------------------------------------------
Public Function NbOccurence(sChaine As String, sSouS_Chaine As String) As Long
On Error Resume Next
NbOccurence = (Len(sChaine) - Len(Replace(sChaine, sSouS_Chaine, "", , , vbTextCompare))) / Len(sSouS_Chaine)
End Function
Messages postés
11
Date d'inscription
lundi 22 août 2011
Statut
Membre
Dernière intervention
4 septembre 2011

Merci pour le coup de pouce, j'ai trouvé mon bonheur, un peu compliqué mais adaptable.
Merci encore.
Messages postés
63
Date d'inscription
jeudi 4 décembre 2003
Statut
Membre
Dernière intervention
23 avril 2013

C'est carrément un cours particulier qu'il te faut, j'imagine que c'est pour ton boulot, dans ce cas il va falloir me donner une partie de ton salaire.
Je plaisante ...
Il faudrait que tu cherches un peu, il y a plein de sources sur ce sujet, pas simple j'en conviens. Pour oracle c'est un fichier control qu'il faut créer. Regarde ces liens et inspire-toi du code:
http://www.vbfrance.com/codes/CREATION-LOADER-ORACLE_6245.aspx
http://www.vbfrance.com/codes/EASY-LOADER-ORACLE_40967.aspx
http://www.vbfrance.com/codes/ORACLE-AUTOMATISATION-CREATION-FICHIER-CONTROLE_8456.aspx
Messages postés
11
Date d'inscription
lundi 22 août 2011
Statut
Membre
Dernière intervention
4 septembre 2011

Merveilleux, tout fonctionne sans plantage, merci encore.
Il me reste un problème, je ne parviens pas a créer un fichier format correct, aurais-tu une piste (là j'abuse un peu).
Messages postés
63
Date d'inscription
jeudi 4 décembre 2003
Statut
Membre
Dernière intervention
23 avril 2013

Il faut prendre du Totus les gars si vous avez un problème avec la mémoire, apparemment c'est un sujet qui vous omnibule.
Bon trèfle de plaisanterie, deux solutions.
soit tu renvoi un tableau de String et tu gères les types de données dans ta fonction comme dans l'exemple mais tu vas brider cette fonction à des chaînes de caractères elle sera moins générique. De toute façon, il est quand même rare que le nombre de champs renvoyés dépasse la cinquantaine non? , ce n'est pas inssupportable pour la mémoire!!
Soit tu renvoi un tableau en Variant qui sera brut de décoffrage, à condition bien sûr que le tableau récepteur de ta procédure appelante soit un Variant, et là tu traite les valeurs dans cette procédure. Attention si tu affectes une valeur nulle à une chaîne VB couinne et te dis que le type est incompatible. C'est vrai qu'il est important de savoir si des valeurs sont nulles, c'est pourquoi le type Variant est utilisé puis convertis en fontion des besoins.

sCommandeSav est static et mémorise la requête initiale passée en paramètre, chaque fois que la procédure appelante demande une ligne, la fonction sait si c'est bien pour la même requête sinon elle ferme le recordset et le réouvre avec la nouvelle requête. C'est une solution que j'ai trouvé mais ce n'est certainement pas la seule, il y a sûrement mieux et plus élégant, mais ça marche.
Dis-toi que la procédure appelante va appeler(évidemment) la fonction dans une boucle, il faut bien que les deux communiquent, la procédure pour demander d'ouvrir un recordset ou un nouveau recordset ainsi que le transfert des lignes une a une, et la fonction pour indiquer sa position dans le recorset et pour renvoyer les lignes. De plus la fonction contrôle si le dernier enregistrement est atteint et doit automatiquement fermer le recordset.

Attention, Null et vide sont identiques pour Oracle mais sqlserver fait la différence, pense-y lors des traitements de chaînes, si tu injecte une chaîne vide dans une base oracle, ce sera considéré comme un null et le résultat escompté n'est pas pas toujours atteint.

Bon Casse-Tête..

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.