Copier des fichiers d'une mème éxtension [Résolu]

Messages postés
67
Date d'inscription
jeudi 1 juillet 2010
Dernière intervention
13 octobre 2010
- - Dernière réponse : cs_zidane22
Messages postés
67
Date d'inscription
jeudi 1 juillet 2010
Dernière intervention
13 octobre 2010
- 16 août 2010 à 22:03
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
Afficher la suite 

Votre réponse

20 réponses

Meilleure réponse
Messages postés
3983
Date d'inscription
jeudi 14 juillet 2005
Dernière intervention
30 juin 2013
3
Merci
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

Merci cs_ghuysmans99 3

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources a aidé 100 internautes ce mois-ci

Commenter la réponse de cs_ghuysmans99
Messages postés
3983
Date d'inscription
jeudi 14 juillet 2005
Dernière intervention
30 juin 2013
3
Merci
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

Merci cs_ghuysmans99 3

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources a aidé 100 internautes ce mois-ci

Commenter la réponse de cs_ghuysmans99
Messages postés
3983
Date d'inscription
jeudi 14 juillet 2005
Dernière intervention
30 juin 2013
3
Merci
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

Merci cs_ghuysmans99 3

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources a aidé 100 internautes ce mois-ci

Commenter la réponse de cs_ghuysmans99
Messages postés
3983
Date d'inscription
jeudi 14 juillet 2005
Dernière intervention
30 juin 2013
2
Merci
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
Commenter la réponse de cs_ghuysmans99
Messages postés
1270
Date d'inscription
mardi 11 novembre 2003
Dernière intervention
24 juillet 2013
0
Merci
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
Commenter la réponse de cs_Galain
Messages postés
67
Date d'inscription
jeudi 1 juillet 2010
Dernière intervention
13 octobre 2010
0
Merci
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
Commenter la réponse de cs_zidane22
Messages postés
1270
Date d'inscription
mardi 11 novembre 2003
Dernière intervention
24 juillet 2013
0
Merci
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
Commenter la réponse de cs_Galain
Messages postés
67
Date d'inscription
jeudi 1 juillet 2010
Dernière intervention
13 octobre 2010
0
Merci
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
Commenter la réponse de cs_zidane22
Messages postés
3983
Date d'inscription
jeudi 14 juillet 2005
Dernière intervention
30 juin 2013
0
Merci
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
Commenter la réponse de cs_ghuysmans99
Messages postés
67
Date d'inscription
jeudi 1 juillet 2010
Dernière intervention
13 octobre 2010
0
Merci
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.
Commenter la réponse de cs_zidane22
Messages postés
67
Date d'inscription
jeudi 1 juillet 2010
Dernière intervention
13 octobre 2010
0
Merci
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
Commenter la réponse de cs_zidane22
Messages postés
67
Date d'inscription
jeudi 1 juillet 2010
Dernière intervention
13 octobre 2010
0
Merci
Merci ghuysmans99
C'est résolu
Commenter la réponse de cs_zidane22
Messages postés
3983
Date d'inscription
jeudi 14 juillet 2005
Dernière intervention
30 juin 2013
0
Merci
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
Commenter la réponse de cs_ghuysmans99
Messages postés
67
Date d'inscription
jeudi 1 juillet 2010
Dernière intervention
13 octobre 2010
0
Merci
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
Commenter la réponse de cs_zidane22
Messages postés
3983
Date d'inscription
jeudi 14 juillet 2005
Dernière intervention
30 juin 2013
0
Merci
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
Commenter la réponse de cs_ghuysmans99
Messages postés
67
Date d'inscription
jeudi 1 juillet 2010
Dernière intervention
13 octobre 2010
0
Merci
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
Commenter la réponse de cs_zidane22
Messages postés
67
Date d'inscription
jeudi 1 juillet 2010
Dernière intervention
13 octobre 2010
0
Merci
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
Commenter la réponse de cs_zidane22
Messages postés
67
Date d'inscription
jeudi 1 juillet 2010
Dernière intervention
13 octobre 2010
0
Merci
Oui c'esy une trés bonne solution .
merci beaucoup ghuysmans99
Commenter la réponse de cs_zidane22
Messages postés
67
Date d'inscription
jeudi 1 juillet 2010
Dernière intervention
13 octobre 2010
0
Merci
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
Commenter la réponse de cs_zidane22
Messages postés
67
Date d'inscription
jeudi 1 juillet 2010
Dernière intervention
13 octobre 2010
0
Merci
Tout va trés bien maintenant
Merci mille fois!
Vraiment vous ètes un homme formidable!
Commenter la réponse de cs_zidane22

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.