Copier des fichiers d'une mème éxtensionRésolu

Question

Bonjour à tous
Dans une application de vb6, je dois copier et coller une vingtaine de fichiers d'une mème éxtension (.ocx)dans C:\Windows\System32 et donc je dois réécrirele code ci-dessous une vingtaine de fois.
 Y'a t'il un moyen de se servir d'une varible pour me permettre à ne pas récrire le code 20 fois.
merci


If Dir("C:\Windows\System32\MSDATGRD.OCX") = "" Then
    
        FileCopy App.Path & "\MSDATGRD.OCX ", "C:\Windows\System32\MSDATGRD.OCX"
    
        Shell "regsvr32 C:\Windows\System32\MSDATGRD.OCX", vbHide
    End If

cs_ghuysmans99 · Accepted Answer

La ligne à modifier :
  Shell "regsvr32 /s """ & Dest & CurFile & """", vbHide

VB.NET is good ... VB6 is better
Utilise Réponse acceptée quand un post répond à ta question

cs_Galain · Answer

Salut zidane22

1) Declare un tableau avec tes noms de fichiers 
    Private nomfich() as string ' tableau de fichiers visible dans toute la feuille

2) code chargement du tableau et boucle d'enregistrement des fichiers
   

   Redim nomfich (0 to 19) ' pour 20 fichiers    
   nomfich(0) = "MSDATGRD.OCX"
   nomfich(1) = suite des nom de fichiers
   ...............
   ...............
   nomfich(19) = "........." ' dernier nom de fichier
   for i& = 0 to 19
       Doevents
       EnregistrementOCX (nomfich(i&)) ' sous-programme d'enregistrement
   next i&
  
2)Crée un sous-programme

Private Sub EnregistremntOCX (fich as String)
    If Dir("C:\Windows\System32" & fich$) = "" Then
        FileCopy App.Path & "" & fich$, "C:\Windows\System32" & fich$
        Shell "regsvr32 C:\Windows\System32" & fich$, vbHide
    End If
End Sub 

Par contre ton C:\Windows\system32 est codé en dur ! tout le monde n'a pas Windows sur le disque C:\
Utilise l'API GetWindowsSystemdirectory pour avoir le répertoire system de Windows si tu penses distribuer ton programme


La théorie, c'est quand on sait tout et que rien ne fonctionne. La pratique, c'est quand tout fonctionne et que personne ne sait pourquoi.

GRENIER Alain

cs_zidane22 · Answer

Merci Galain
Mais il me semble qu'il y'a un probleme avec le code:
ReDim nomfich(0 To 19)
invalid outside procedure. (le zero sellectionné.)
merci

cs_Galain · Answer

Salut zidane22
As-tu déclaré le tableau des noms de fichiers ? (point 1 de ma réponse)

La théorie, c'est quand on sait tout et que rien ne fonctionne. La pratique, c'est quand tout fonctionne et que personne ne sait pourquoi.

GRENIER Alain

cs_ghuysmans99 · Answer

Devrait fonctionner (juste la chaine utilisée par le Split à modifier) :
Option Explicit
Private Declare Function GetWindowsDirectory Lib "kernel32.dll" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

Public Function GetSystem32Path() As String
 Dim Buffer As String: Buffer = Space$(255)
 Buffer = Left$(Buffer, GetWindowsDirectory(Buffer, 255))
 GetSystem32Path = Buffer & "\system32"
End Function

Private Sub DoCopy()
 Dim Files() As String: Files = Split("msdatgrd,xxx,xxx,xxx", ",")
 Dim i As Integer, CurFile As String, Dest As String
 Dest = GetSystem32Path
 For i = 0 To UBound(Files)
  CurFile = Files(i) & ".ocx"
  FileCopy CurFile, Dest & CurFile
  Shell "regsvr32 """ & Dest & CurFile & """", vbHide
  DoEvents
 Next i
End Sub

VB.NET is good ... VB6 is better
Utilise Réponse acceptée quand un post répond à ta question

cs_zidane22 · Answer

Merci à vous,
As-tu déclaré le tableau des noms de fichiers ?
J'ai fais quelque chose comme ça.
Private nomfich() As String
ReDim nomfich(0 To 6)
   nomfich(0) = "MSDATGRD.OCX"
   nomfich(1) = "ALLBUTTONS.ocx"
   nomfich(2) = "AResize.ocx"
   nomfich(3) = "msadodc.ocx"
   nomfich(4) = "MSCOMCT2.OCX"
   nomfich(5) = "comdlg32.ocx"
   nomfich(6) = "RICHTX32.ocx"

   For i& = 0 To 6
       DoEvents
       EnregistrementOCX (nomfich(i&))
   Next i&
End Sub

Compact error: invalid outside procedure. (le zero sellectionné.)
ReDim nomfich(0 To 19)

Devrait fonctionner (juste la chaine utilisée par le Split à modifier) : 
Malheureusement ça na pas fonctionné pour moi.
Private Sub DoCopy()
 Dim Files() As String: Files = Split("msdatgrd,AResize,ALLBUTTONS,comdlg32", ",")
 Dim i As Integer, CurFile As String, Dest As String
 Dest = GetSystem32Path
 For i = 0 To UBound(Files)
  CurFile = Files(i) & ".ocx"
  FileCopy CurFile, Dest & CurFile
  Shell "regsvr32 """ & Dest & CurFile & """", vbHide
  DoEvents
 Next i
End Sub


FileCopy CurFile, Dest & CurFile
message: file not found
Pourtant tous les fichiers listés sont dans le mème repertoire que le projet.
Merci

cs_ghuysmans99 · Answer

C'est que VB interprète ton programme dans son répertoire (VB98). Compile, sauve et re-lance VB, ça devrait fonctionner. Mais ça marchera de toutes façons en EXE compilé.

VB.NET is good ... VB6 is better
Utilise Réponse acceptée quand un post répond à ta question

cs_zidane22 · Answer

Bonjour j'ai pu trouver la solution pour le message d'érreur : file not find en indiquant le repertoire.

FileCopy App.Path & "" & CurFile, Dest & CurFile
Le code comme ça ça marche bien sauf qu'il donne des méssages au mème nombre de fichiers enregistrés.
Si par éxemple je dois enregistrer 20 fichiers , j'aurai 20 messages: 
Regsvr32: 
DLLRegisterServer dans c:\windows\system32........ .ocx reussi 
Voila 20 mesgboxes indiquant la reussite de l'operation pour le transfert et l'enregistrement des 20 fichier.
Question: Est-il possible d'éviter ces messages?
Merci encore.

cs_zidane22 · Answer

Mais ça marchera de toutes façons en EXE compilé. 
Oui c'ést vrai ça bien marché aprés compilation. 
Mais c'est toujours le problème des messages innombrables
cordialement

cs_zidane22 · Answer

Merci ghuysmans99
C'est résolu

cs_ghuysmans99 · Answer

De rien . Mets aussi en Réponse Acceptée le post dans lequel je t'ai passé le code original ... Ca pourrait aider d'autres gens.

VB.NET is good ... VB6 is better
Utilise Réponse acceptée quand un post répond à ta question

cs_zidane22 · Answer

Bonjour ghuysmans99
C'est encore moi.
J'ai deux petites questions:
1) Si le fichier est utilisé par l'application, je reçois un message d'érreur: Access denied.
Est-il possible de forcer le déplacement du fichier vers systeme32 mème s'il est en cours d'utilisation?
2)Est-il possible de copier et enregigistrer des fichiers dll au fur et à mesure que les ocx? J'ai éssayé ça mais ça pas marché.
CurFile = Files(i) & ".ocx"& ".dll" 
Merci d'avance

cs_ghuysmans99 · Answer

1) On peut simplement éviter la sortie brutale de l'appli VB, c'est tout. Faut la remplacer au boot pour être sûr qu'elle ne soit pas utilisée.

2) Oui ... Mais vu comme ce que tu proposes, j'en déduis que tu n'as pas compris le code que je t'ai donné, et c'est pourquoi je t'en donne un qui cette fois est commenté (à 76%)


Option Explicit 'Si on utilise quelque part une variable non déclarée => erreur de compilation. Evite de faire de grosses conneries
Private Declare Function GetWindowsDirectory Lib "kernel32.dll" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long 'On déclare l'utilisation de l'API GetWindowsDirectoryA

Public Function GetSystem32Path() As String
 Dim Buffer As String: Buffer = Space$(255) 'On initialise le tampon pour contenir 255 caractères
 Buffer = Left$(Buffer, GetWindowsDirectory(Buffer, 255)) 'On le coupe à la bonne longueur, retournée par GetWindowsDirectory
 GetSystem32Path = Buffer & "\system32" 'On ajoute \system32\ car l'API donne le chemin du répertoire WINDOWS
End Function

Private Sub DoCopy()
 Dim Files() As String, i As Integer
 Dim CurFile As String, Dest As String
 Files = Split("msdatgrd.ocx,malib.dll", ",") 'Files() est un tableau contenant les noms de fichier
 Dest = GetSystem32Path 'On charge ici la variable vu que le résultat de la fonction ne changera pas
 For i = 0 To UBound(Files) '//Pour chaque fichier,
  On Error Resume Next 'Evite les erreurs VB
  FileCopy App.Path & "" & Files(i), Dest & Files(i) 'Copie le fichier
  On Error GoTo 0 'Remet les erreurs
  If Err Then '//Si une erreur s'est produite
   MsgBox "Impossible d'écrire le fichier " & Dest & ".", vbExclamation, "Erreur" 'Message d'erreur (non, sans blague ?!)
   Err.Clear 'Efface le contenu de Err (comme s'il ne s'était rien passé)
  Else '//Sinon (ça c'était pas dûr à deviner)
   Shell "regsvr32.exe /s """ & Dest & CurFile & """", vbHide 'Enregistre l'objet COM
   DoEvents 'Attend un peu
  End If '//Fin si
 Next i '//Fin pour
End Sub

VB.NET is good ... VB6 is better
Utilise Réponse acceptée quand un post répond à ta question

cs_zidane22 · Answer

Merci beaucoup ghuysmans99 pour le nouveau code.
Mais j'ai besoin d'une petite clarification.
On peut simplement éviter la sortie brutale de l'appli VB
Comment peut-on éviter la sortie brutale de l'appli?
Et merci mille fois

cs_zidane22 · Answer

J'ai pensé à la creation d'une nouvelle form qui devait pas servir des ocx et dll en question mais elle sera pas une belle solution pour ma petite allication.
Existe t-il autres méthodes plus agreables?

Et merci infiniment

cs_ghuysmans99 · Answer

Crée une Sub Main() dans un module et dans les propriétés du projet, définis-la comme Sub de démarrage. Tu y feras l'installation de ces DLL et tu y ouvriras tes form (tonForm.Show)

VB.NET is good ... VB6 is better
Utilise Réponse acceptée quand un post répond à ta question

cs_zidane22 · Answer

Oui c'esy une trés bonne solution .
merci beaucoup ghuysmans99

cs_zidane22 · Answer

Excusez moi ghuysmans99
C'est peut ètre ma derniere question:
Est -il possible de modifier le code de tel sorte que si le fichier dll ou ocx existe dans system32, le programme ne copie pas ce fichier.
Je dis ça parce que si un fichier déja existe et on le remlace par un autre, on reçois un message de sécurité: Des fichier nécéssaires au fonctionnement de windows ont été remplacés, veuiller inserer le CD......
Désolé de mon dérangement

cs_ghuysmans99 · Answer

Option Explicit 'Si on utilise quelque part une variable non déclarée => erreur de compilation. Evite de faire de grosses conneries
Private Const INVALID_FILE_ATTRIBUTES As Long = -1 'Constante renvoyée par GetFileAttributes disant que le fichier/dossier n'existe pas
Private Declare Function GetFileAttributes Lib "kernel32.dll" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Private Declare Function GetWindowsDirectory Lib "kernel32.dll" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long 'On déclare l'utilisation de l'API GetWindowsDirectoryA

Public Function FileExists(FileName As String) As Boolean
 FileExists = GetFileAttributes(FileName) <> INVALID_FILE_ATTRIBUTES
End Function

Public Function GetSystem32Path() As String
 Dim Buffer As String: Buffer = Space$(255) 'On initialise le tampon pour contenir 255 caractères
 Buffer = Left$(Buffer, GetWindowsDirectory(Buffer, 255)) 'On le coupe à la bonne longueur, retournée par GetWindowsDirectory
 GetSystem32Path = Buffer & "\system32" 'On ajoute \system32\ car l'API donne le chemin du répertoire WINDOWS
End Function

Private Sub DoCopy()
 Dim Files() As String, i As Integer
 Dim CurFile As String, Dest As String
 Files = Split("msdatgrd.ocx,malib.dll", ",") 'Files() est un tableau contenant les noms de fichier
 Dest = GetSystem32Path 'On charge ici la variable vu que le résultat de la fonction ne changera pas
 For i = 0 To UBound(Files) '//Pour chaque fichier,
  If FileExists(Dest & Files(i)) = False Then '//Si fichier inexistant,
   On Error Resume Next 'Evite les erreurs VB
   FileCopy App.Path & "" & Files(i), Dest & Files(i) 'Copie le fichier
   On Error GoTo 0 'Remet les erreurs
   If Err Then '//Si une erreur s'est produite
    MsgBox "Impossible d'écrire le fichier " & Dest & ".", vbExclamation, "Erreur" 'Message d'erreur (non, sans blague ?!)
    Err.Clear 'Efface le contenu de Err (comme s'il ne s'était rien passé)
   Else '//Sinon (pas d'erreur)
    Shell "regsvr32.exe /s """ & Dest & CurFile & """", vbHide 'Enregistre l'objet COM
    DoEvents 'Attend un peu
   End If '//Fin si
  Else '//Sinon (fichier existant)
   MsgBox "Fichier ignoré : " & Files(i), vbInformation, "Info"
  End If '//Fin si
 Next i '//Fin pour
End Sub

VB.NET is good ... VB6 is better
Utilise Réponse acceptée quand un post répond à ta question

cs_zidane22 · Answer

Tout va trés bien maintenant
Merci mille fois!
Vraiment vous ètes un homme formidable!

Copier des fichiers d'une mème éxtension

20 réponses

Votre réponse

Discussions similaires