Instancing
Résolu
Zylott
Messages postés
104
Date d'inscription
jeudi 25 juillet 2002
Statut
Membre
Dernière intervention
28 septembre 2006
-
31 mai 2006 à 22:09
PCPT Messages postés 13272 Date d'inscription lundi 13 décembre 2004 Statut Membre Dernière intervention 3 février 2018 - 2 juin 2006 à 17:49
PCPT Messages postés 13272 Date d'inscription lundi 13 décembre 2004 Statut Membre Dernière intervention 3 février 2018 - 2 juin 2006 à 17:49
6 réponses
PCPT
Messages postés
13272
Date d'inscription
lundi 13 décembre 2004
Statut
Membre
Dernière intervention
3 février 2018
47
1 juin 2006 à 01:08
1 juin 2006 à 01:08
salut,
la seule différence apparente est "Attribute VB_Exposed" (false en exe, dll en activex)
créé un nouveau projet exe
sur la form (assez grande), pose un listbox (grande aussi) et un bouton (pas trop lui)
Option Explicit
'
Private Sub Form_Load()
Me.OLEDropMode = 1
List1.Clear
End Sub
'
Private Sub Form_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim sFile As Variant
For Each sFile In Data.Files
If RightB$(LCase$(sFile), 8) = ".cls" Then List1.AddItem sFile
Next
End Sub
'
Private Sub Command1_Click()
If List1.ListCount > 0 Then
Dim aFiles() As String, i As Integer
ReDim aFiles(1 To List1.ListCount)
Me.Enabled = False 'pour pas glisser chef :p
For i = 1 To List1.ListCount
' sauve l'ancien + tableau
aFiles(i) = List1.List(i - 1)
Me.Caption = "Sauve " & i & "/" & List1.ListCount
FileCopy aFiles(i), aFiles(i) & ".BAK"
DoEvents
Next i
List1.Clear
' j'préfère faire en 2 boucles, au cas où (au moins tout est déjà sauvé).....
Dim FF As Integer, sBuffer As String
Dim sBig$, sEnd$, lPos As Long
For i = 1 To UBound (aFiles)
' récup contenu class
FF = FreeFile
Open aFiles(i) For Input As #FF
sBuffer = Input (LOF(FF), #FF)
Close #FF
' trouve la ligne
lPos = InStr(1, sBuffer, "Attribute VB_Exposed = False")
If lPos = 0 Then
' pas trouvé
List1.AddItem aFiles(i) & vbTab & vbTab & "INDEMNE"
Else
sBig = Left$(sBuffer, lPos - 1)
sEnd = Right$(sBuffer, Len (sBuffer) - lPos - 29)
' on écrit
FF = FreeFile
Open aFiles(i) For Output As #FF
Print #FF, sBig & "Attribute VB_Exposed = True" & vbCrLf & sEnd
Close #FF
List1.AddItem aFiles(i) & vbTab & vbTab & "MODIFIé"
End If
sBuffer = vbNullString
Me.Caption = "Fichier " & i & "/" & UBound (aFiles) & " traité"
DoEvents
Next i
Command1.Enabled = False
Me.Enabled = True
End If
End Sub
<small> Coloration
syntaxique automatique [AFCK]</small>
copie ce code, lance, déplace tes fichiers (drag and drop) sur la form (pas la listbox), même avec quelques intrus c'est pas grave...
puis click sur le seul bouton.
j'ai testé c'est ok mais bon, vérifie quand même...
et au pire, c'est sauvé (****.BAK)
tiens-nous au courant
++
PCPT [AFCK]
la seule différence apparente est "Attribute VB_Exposed" (false en exe, dll en activex)
créé un nouveau projet exe
sur la form (assez grande), pose un listbox (grande aussi) et un bouton (pas trop lui)
Option Explicit
'
Private Sub Form_Load()
Me.OLEDropMode = 1
List1.Clear
End Sub
'
Private Sub Form_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim sFile As Variant
For Each sFile In Data.Files
If RightB$(LCase$(sFile), 8) = ".cls" Then List1.AddItem sFile
Next
End Sub
'
Private Sub Command1_Click()
If List1.ListCount > 0 Then
Dim aFiles() As String, i As Integer
ReDim aFiles(1 To List1.ListCount)
Me.Enabled = False 'pour pas glisser chef :p
For i = 1 To List1.ListCount
' sauve l'ancien + tableau
aFiles(i) = List1.List(i - 1)
Me.Caption = "Sauve " & i & "/" & List1.ListCount
FileCopy aFiles(i), aFiles(i) & ".BAK"
DoEvents
Next i
List1.Clear
' j'préfère faire en 2 boucles, au cas où (au moins tout est déjà sauvé).....
Dim FF As Integer, sBuffer As String
Dim sBig$, sEnd$, lPos As Long
For i = 1 To UBound (aFiles)
' récup contenu class
FF = FreeFile
Open aFiles(i) For Input As #FF
sBuffer = Input (LOF(FF), #FF)
Close #FF
' trouve la ligne
lPos = InStr(1, sBuffer, "Attribute VB_Exposed = False")
If lPos = 0 Then
' pas trouvé
List1.AddItem aFiles(i) & vbTab & vbTab & "INDEMNE"
Else
sBig = Left$(sBuffer, lPos - 1)
sEnd = Right$(sBuffer, Len (sBuffer) - lPos - 29)
' on écrit
FF = FreeFile
Open aFiles(i) For Output As #FF
Print #FF, sBig & "Attribute VB_Exposed = True" & vbCrLf & sEnd
Close #FF
List1.AddItem aFiles(i) & vbTab & vbTab & "MODIFIé"
End If
sBuffer = vbNullString
Me.Caption = "Fichier " & i & "/" & UBound (aFiles) & " traité"
DoEvents
Next i
Command1.Enabled = False
Me.Enabled = True
End If
End Sub
<small> Coloration
syntaxique automatique [AFCK]</small>
copie ce code, lance, déplace tes fichiers (drag and drop) sur la form (pas la listbox), même avec quelques intrus c'est pas grave...
puis click sur le seul bouton.
j'ai testé c'est ok mais bon, vérifie quand même...
et au pire, c'est sauvé (****.BAK)
tiens-nous au courant
++
PCPT [AFCK]
cs_rt15
Messages postés
3874
Date d'inscription
mardi 8 mars 2005
Statut
Modérateur
Dernière intervention
7 novembre 2014
13
31 mai 2006 à 22:36
31 mai 2006 à 22:36
Bonjour,
Tu peux peut être travailler au niveau des fichiers (Faire un prog qui modifie les fichiers source).
Je peux malheureusement pas essayer là tout de suite, mais si tu édite
avec notepad le fichier d'une classe d'un exe et celui d'une classe
d'une dll, tu devrais pouvoir lister les différences, et savoir quelles
modifs tu dois effectuer.
Par contre, je te conseil de faire une copie de sauvegarde avant d'essayer de faire des modifs !
Tu peux peut être travailler au niveau des fichiers (Faire un prog qui modifie les fichiers source).
Je peux malheureusement pas essayer là tout de suite, mais si tu édite
avec notepad le fichier d'une classe d'un exe et celui d'une classe
d'une dll, tu devrais pouvoir lister les différences, et savoir quelles
modifs tu dois effectuer.
Par contre, je te conseil de faire une copie de sauvegarde avant d'essayer de faire des modifs !
PCPT
Messages postés
13272
Date d'inscription
lundi 13 décembre 2004
Statut
Membre
Dernière intervention
3 février 2018
47
1 juin 2006 à 01:12
1 juin 2006 à 01:12
True en dll/activex**, fallait-il lire ^^
PCPT
Messages postés
13272
Date d'inscription
lundi 13 décembre 2004
Statut
Membre
Dernière intervention
3 février 2018
47
1 juin 2006 à 20:06
1 juin 2006 à 20:06
çà te va ou pas?
sujet clos?
++
sujet clos?
++
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
Zylott
Messages postés
104
Date d'inscription
jeudi 25 juillet 2002
Statut
Membre
Dernière intervention
28 septembre 2006
2 juin 2006 à 17:28
2 juin 2006 à 17:28
Merci pour ce bout de code.
J'avais aussi remarqué Attribute VB_Exposed = False dans les modules de classes.
Seul inconvenient du drag&drop c'est que j'ai environ 350 classes reparties dans differents repetoires ... (you see what I mean ?).
J'ai donc ouvert le .vbp pour recupérer le path de toutes les classes.
mais je voulais surtout m'economiser à ecrire du code !!!
En tout cas merci encore !
J'avais aussi remarqué Attribute VB_Exposed = False dans les modules de classes.
Seul inconvenient du drag&drop c'est que j'ai environ 350 classes reparties dans differents repetoires ... (you see what I mean ?).
J'ai donc ouvert le .vbp pour recupérer le path de toutes les classes.
mais je voulais surtout m'economiser à ecrire du code !!!
En tout cas merci encore !
PCPT
Messages postés
13272
Date d'inscription
lundi 13 décembre 2004
Statut
Membre
Dernière intervention
3 février 2018
47
2 juin 2006 à 17:49
2 juin 2006 à 17:49
même si tu as 10 dossiers, tu n'as même pas à sélectionner que les .cls
tu glisses tous les fichiers et c'est parti
bout de code complet ;)
je me le suis d'ailleurs gardé (ensuite) pour les .vbp (description, titre, signature,etc....) en masse. bien pratique pour les groupes de projets conséquents.
++
tu glisses tous les fichiers et c'est parti
bout de code complet ;)
je me le suis d'ailleurs gardé (ensuite) pour les .vbp (description, titre, signature,etc....) en masse. bien pratique pour les groupes de projets conséquents.
++