Accueil > > > SUPPRESSEUR DE LA DÉPENDACE À VB6FR.DLL REND LES EXES VB6 AUTONOMES
SUPPRESSEUR DE LA DÉPENDACE À VB6FR.DLL REND LES EXES VB6 AUTONOMES
Information sur la source
Description
Redirige la dépendance à VB6FR.DLL pour les EXEs VB6 vers MSBVVM60.DLL dont ils sont déja dépendants et qui est présent sur tous les PC donc une indépendance au DLLs Sous forme d'un explorateur convivial et informatif il permet de patcher d'un click autant d'EXEs que vous voulez conservation ou non des dates originales Réversible en cas de besoin
Source
- Option Explicit
- '*******************************************************
- '* RENDEZ VOUS EXEs VB6 AUTONOMES, PLUS BESOIN DE DLL *
- '* DELEPLACE 2009 *
- '*******************************************************
-
- 'Ces déclaration pour pouvoir redater les fichiers modifiés
- Private Type FILETIME
- LowDateTime As Long
- HighDateTime As Long
- End Type
- Private Const G_READ = &H80000000, G_WRITE = &H40000000, F_SH_READ = 1, F_SH_W_R = 3
- Private Const OPEN_EXISTING = 3
- Private Declare Function CreateFileA& Lib "kernel32" (ByVal lpFileName$, ByVal dwDesiredAccess&, ByVal dwShareMode&, lpSecurityAttributes As Any, ByVal dwCreationDisposition&, ByVal dwFlagsAndAttributes&, ByVal hTemplateFile&)
- Private Declare Sub SetFileTime Lib "kernel32" (ByVal hFile&, lpCreationTime As Any, lpLastAccessTime As Any, lpLastWriteTime As Any)
- Private Declare Sub GetFileTime Lib "kernel32" (ByVal hFile&, cree As FILETIME, access As FILETIME, modif As FILETIME)
- Private Declare Sub CloseHandle Lib "kernel32" (ByVal hObject&)
-
- Dim Path1$, DoNot%, IClick%
- Dim cree As FILETIME, Acces As FILETIME, modif As FILETIME
-
- Private Sub Form_Load()
- 'Affiche les Infos sur les EXEs VB6 dans le dossier courant
- RefreshFile File1.Path
- End Sub
-
- 'partie Explorateur
- Private Sub Drive1_Change()
- On Error Resume Next
- Dir1.Path = UCase(Left(Drive1, 2)) & "\"
- If Err Then Exit Sub
- RefreshFile Dir1.Path
- End Sub
-
- Private Sub Dir1_Click()
- On Error Resume Next
- 'Affiche les Infos sur les EXEs VB6 dans le nouveau dossier
- RefreshFile Dir1.List(Dir1.ListIndex)
- End Sub
-
- Private Sub RefreshFile(Path$)
- Dim I%, INF$
- Text2.Visible = False
- On Error Resume Next
- File1.Path = Path
- If Len(Path) > 3 Then Path1 = Path & "\" Else Path1 = Path
- If Err Then Exit Sub
- MousePointer = 11 'Sablier
- File1.Refresh 'File1 est caché, les seul fichiers identifiés comme VB6
- List1.Clear 'seront affichés dans List1
- Text1 = ""
- For I = 0 To File1.ListCount - 1
- INF = Info(File1.List(I))
- If Len(INF) Then List1.AddItem INF
- Next
- If List1.ListCount Then List1.Selected(0) = True
- MousePointer = 0 ' fin du sablier
- End Sub
-
- Private Function Info$(File$)
- 'renvoie le NomduFichier,l'adresse et le nom de la DLL si identifié comme VB6
- Dim I&, J&, A$, B$
- On Error Resume Next
- If Len(Dir(Path1 & File)) Then 'vérifie la présence du fichier
- 'La longueur des EXEs VB6 est tjs multiple de 4096 . pourquoi ?
- If FileLen(Path1 & File) And &HFFF& Then Exit Function
- Open Path1 & File For Binary As 1
- If Err Then Exit Function
- A = Space(LOF(1)): Get 1, , A: Close 1 'tout le fichier est dans la chaine A$
- bcl: I = InStr(I + 1, A, "VB5!") 'localise le nom de la DLL
- If I = 0 Then Exit Function
- B = RTrim(Replace(Mid(A, I + 6, 12), Chr(0), " "))
- If Right(B, 4) <> ".DLL" Then GoTo bcl
- J = 50 - Len(File): If J < 1 Then J = 1
- 'Renvoie les infos
- Info = File & String(J, 32) & "0x" & Hex(I + 5) & " " & B
- End If
- End Function
-
- Private Sub DLLReplace_Click(I%)
- If Not DoNot% Then 'DoNot sert à bloquer un accés récurssif
- DoNot = -1
- DLLReplace(1 - I) = 0
- DLLReplace(I) = 1
- DoNot = 0
- End If
- End Sub
-
- Private Sub Help_Click()
- Text2.Visible = True
- End Sub
-
- Private Sub List1_Click()
- IClick = List1.ListIndex
- Text1 = List1.List(IClick)
- End Sub
-
- Private Sub RemplaceSEL_Click()
- Dim I%
- For I = 0 To List1.ListCount - 1
- If List1.Selected(I) Then IReplace I
- Next
- End Sub
-
- Private Sub RemplaceALL_Click()
- Dim I%
- For I = 0 To List1.ListCount - 1
- IReplace I
- Next
- End Sub
-
- Private Sub RemplaceTXT_Click()
- If IClick < List1.ListCount Then IReplace IClick
- End Sub
-
- Private Sub IReplace(I%) ' Patcher List1(I)
- Dim A$, F$, DLL$, OF7&, J%, K%, DL$, DLR$, DLV$
- A = List1.List(I)
- J = InStrRev(A, " 0x"): K = InStr(J + 1, A, " ")
- OF7 = 1 + Val("&H" & Mid(A, J + 3, K - J - 3) & "&")
- DLL = Mid(A, K + 1, 12)
- DLL = Left(DLL, InStr(DLL & " ", " ") - 1)
- DLL = DLL & String(12 - Len(DLL), 0)
- : A = Left(A, K + 9)
- DLV = DLLReplace(DLLReplace(1)).Caption
- DLR = DLV & String(12 - Len(DLV), 0)
- If DLL <> DLR Then
- F = Path1 & RTrim(Left(A, J))
- If SaveDates(F) Then 'sauve les dates du fichier et en même temps vérifi la présence
- Open F For Binary As 1
- DL = Space(12)
- Get 1, OF7, DL
- If DL = DLL Then
- On Error Resume Next
- Put 1, OF7, DLR
- If Err Then A = A & " Refusé" Else A = Left(A, K) & DLV
- Else
- A = A & " Erreur"
- End If
- Close 1
- If Redate Then Redates F
- Else
- A = A & " Non trouvé"
- End If
- End If
- List1.List(I) = A
- If I = IClick Then Text1 = A
- End Sub
-
- Private Function SaveDates%(F$) 'sauve les dates du fichiers
- Dim H&: H = CreateFileA(F, G_READ, F_SH_READ, ByVal 0&, OPEN_EXISTING, vbArchive, 0)
- If H <> -1 Then GetFileTime H, cree, Acces, modif: CloseHandle H: SaveDates = -1
- End Function
-
- Private Sub Redates(F$) 'redate avec les dates initiales
- Redate3 F, cree, Acces, modif
- End Sub
-
- Private Sub Redate3(F$, cree As FILETIME, Acces As FILETIME, modif As FILETIME)
- Dim H&: H = CreateFileA(F, G_WRITE, F_SH_W_R, ByVal 0&, OPEN_EXISTING, 0, 0)
- If H <> -1 Then SetFileTime H, cree, Acces, modif: CloseHandle H
- End Sub
-
Option Explicit
'*******************************************************
'* RENDEZ VOUS EXEs VB6 AUTONOMES, PLUS BESOIN DE DLL *
'* DELEPLACE 2009 *
'*******************************************************
'Ces déclaration pour pouvoir redater les fichiers modifiés
Private Type FILETIME
LowDateTime As Long
HighDateTime As Long
End Type
Private Const G_READ = &H80000000, G_WRITE = &H40000000, F_SH_READ = 1, F_SH_W_R = 3
Private Const OPEN_EXISTING = 3
Private Declare Function CreateFileA& Lib "kernel32" (ByVal lpFileName$, ByVal dwDesiredAccess&, ByVal dwShareMode&, lpSecurityAttributes As Any, ByVal dwCreationDisposition&, ByVal dwFlagsAndAttributes&, ByVal hTemplateFile&)
Private Declare Sub SetFileTime Lib "kernel32" (ByVal hFile&, lpCreationTime As Any, lpLastAccessTime As Any, lpLastWriteTime As Any)
Private Declare Sub GetFileTime Lib "kernel32" (ByVal hFile&, cree As FILETIME, access As FILETIME, modif As FILETIME)
Private Declare Sub CloseHandle Lib "kernel32" (ByVal hObject&)
Dim Path1$, DoNot%, IClick%
Dim cree As FILETIME, Acces As FILETIME, modif As FILETIME
Private Sub Form_Load()
'Affiche les Infos sur les EXEs VB6 dans le dossier courant
RefreshFile File1.Path
End Sub
'partie Explorateur
Private Sub Drive1_Change()
On Error Resume Next
Dir1.Path = UCase(Left(Drive1, 2)) & "\"
If Err Then Exit Sub
RefreshFile Dir1.Path
End Sub
Private Sub Dir1_Click()
On Error Resume Next
'Affiche les Infos sur les EXEs VB6 dans le nouveau dossier
RefreshFile Dir1.List(Dir1.ListIndex)
End Sub
Private Sub RefreshFile(Path$)
Dim I%, INF$
Text2.Visible = False
On Error Resume Next
File1.Path = Path
If Len(Path) > 3 Then Path1 = Path & "\" Else Path1 = Path
If Err Then Exit Sub
MousePointer = 11 'Sablier
File1.Refresh 'File1 est caché, les seul fichiers identifiés comme VB6
List1.Clear 'seront affichés dans List1
Text1 = ""
For I = 0 To File1.ListCount - 1
INF = Info(File1.List(I))
If Len(INF) Then List1.AddItem INF
Next
If List1.ListCount Then List1.Selected(0) = True
MousePointer = 0 ' fin du sablier
End Sub
Private Function Info$(File$)
'renvoie le NomduFichier,l'adresse et le nom de la DLL si identifié comme VB6
Dim I&, J&, A$, B$
On Error Resume Next
If Len(Dir(Path1 & File)) Then 'vérifie la présence du fichier
'La longueur des EXEs VB6 est tjs multiple de 4096 . pourquoi ?
If FileLen(Path1 & File) And &HFFF& Then Exit Function
Open Path1 & File For Binary As 1
If Err Then Exit Function
A = Space(LOF(1)): Get 1, , A: Close 1 'tout le fichier est dans la chaine A$
bcl: I = InStr(I + 1, A, "VB5!") 'localise le nom de la DLL
If I = 0 Then Exit Function
B = RTrim(Replace(Mid(A, I + 6, 12), Chr(0), " "))
If Right(B, 4) <> ".DLL" Then GoTo bcl
J = 50 - Len(File): If J < 1 Then J = 1
'Renvoie les infos
Info = File & String(J, 32) & "0x" & Hex(I + 5) & " " & B
End If
End Function
Private Sub DLLReplace_Click(I%)
If Not DoNot% Then 'DoNot sert à bloquer un accés récurssif
DoNot = -1
DLLReplace(1 - I) = 0
DLLReplace(I) = 1
DoNot = 0
End If
End Sub
Private Sub Help_Click()
Text2.Visible = True
End Sub
Private Sub List1_Click()
IClick = List1.ListIndex
Text1 = List1.List(IClick)
End Sub
Private Sub RemplaceSEL_Click()
Dim I%
For I = 0 To List1.ListCount - 1
If List1.Selected(I) Then IReplace I
Next
End Sub
Private Sub RemplaceALL_Click()
Dim I%
For I = 0 To List1.ListCount - 1
IReplace I
Next
End Sub
Private Sub RemplaceTXT_Click()
If IClick < List1.ListCount Then IReplace IClick
End Sub
Private Sub IReplace(I%) ' Patcher List1(I)
Dim A$, F$, DLL$, OF7&, J%, K%, DL$, DLR$, DLV$
A = List1.List(I)
J = InStrRev(A, " 0x"): K = InStr(J + 1, A, " ")
OF7 = 1 + Val("&H" & Mid(A, J + 3, K - J - 3) & "&")
DLL = Mid(A, K + 1, 12)
DLL = Left(DLL, InStr(DLL & " ", " ") - 1)
DLL = DLL & String(12 - Len(DLL), 0)
: A = Left(A, K + 9)
DLV = DLLReplace(DLLReplace(1)).Caption
DLR = DLV & String(12 - Len(DLV), 0)
If DLL <> DLR Then
F = Path1 & RTrim(Left(A, J))
If SaveDates(F) Then 'sauve les dates du fichier et en même temps vérifi la présence
Open F For Binary As 1
DL = Space(12)
Get 1, OF7, DL
If DL = DLL Then
On Error Resume Next
Put 1, OF7, DLR
If Err Then A = A & " Refusé" Else A = Left(A, K) & DLV
Else
A = A & " Erreur"
End If
Close 1
If Redate Then Redates F
Else
A = A & " Non trouvé"
End If
End If
List1.List(I) = A
If I = IClick Then Text1 = A
End Sub
Private Function SaveDates%(F$) 'sauve les dates du fichiers
Dim H&: H = CreateFileA(F, G_READ, F_SH_READ, ByVal 0&, OPEN_EXISTING, vbArchive, 0)
If H <> -1 Then GetFileTime H, cree, Acces, modif: CloseHandle H: SaveDates = -1
End Function
Private Sub Redates(F$) 'redate avec les dates initiales
Redate3 F, cree, Acces, modif
End Sub
Private Sub Redate3(F$, cree As FILETIME, Acces As FILETIME, modif As FILETIME)
Dim H&: H = CreateFileA(F, G_WRITE, F_SH_W_R, ByVal 0&, OPEN_EXISTING, 0, 0)
If H <> -1 Then SetFileTime H, cree, Acces, modif: CloseHandle H
End Sub
Conclusion
Utile, voire indispensable Toutes vos applis autonomes
Historique
- 27 février 2009 18:04:47 :
- Avertissement
- 01 mars 2009 02:57:21 :
- au lieu de remplacer la dépendance à VB6FR.DLL
par une dépendance à MSVBVM60.DLL (dont l'EXE est déja dépendant)
ce qui a supprimé des inconvenient que j'avais mentionné
Sources du même auteur
Sources de la même categorie
Commentaires et avis
Discussions en rapport avec ce code source dans le forum
Problème de compilation sur VB6 [ par leperejack ]
J'ai un logiciel que je n'arrive plus à compiler sur VB6 sur un PC de bureau (XP). Sur mon portable, la compilation ne pose pas de problème.Lorsque je
[vb6] appli portable sans installation [ par Philippe734 ]
Bonjour, Quelles sont les solutions, ou guides, ou liens internet, ou tuto pour réaliser une application portable ? C'est à dire que je cherche des ar
Raffraichir les données de crystal report 4.6 + vb6 [ par nadid ]
Bonjour, Je dévloppe une petite solution de gestion de stock, alors mon probléme est comme suite : j'ai crée un état a partir de crystal report 4.6, d
Vb6 et format de base de données [ par NSUADI ]
Bonsoir à tous!! j'aimerai bien créer une petite application avec connexion à une base donnée en passant par le contrôle "data": je renseigne le chem
ping avec vb6 [ par ranitta ]
bonjour tout le monde, priere j'ai besoin d votre aide, dans le cadre du projet de fin d'etudes je cherche une petite application en vb6 qui teste la
VB6 erreur inattendu sous windows seven [ par mariam1987 ]
Bonjour à tous, j'ai développer une application en VB6 sous windows xp sp3, j'ai créer le setup avec l'outil empaquetage et déploiement, lorsque je l
migration macro VBA vers application VB6 [ par the_little_big_man ]
bonjour. je rencontre un problème en migrant une macro realiser en vba dans une application VB dans ma macro je recupère la dernière cellule de la co
Compatibilite Office 2010 64 bits vb6 [ par capricorne83 ]
Bonjour, Je voudrais vous signaler un problème rencontré hier suite à l'installation de la suite Office 2010 64 bits. Tout s'est déroulé correctement.
[Catégorie modifiée .Net --> VB6] VB6: Soft Actuel avec BDD Excel, help [ par morbak01 ]
Bonjour, J'ai écrit un soft en VB6 il y a plusieurs années. Ce soft lit/écrit dans une base de données excel. Je soucis c'est que: 1- il faut que exc
Utilisation d'excel à partir de vb6 [ par the_little_big_man ]
bonjour; je rencontre un petit problème et j'espère que quelqu'un pourra m'éclairer. j'ai realisé une petite application en vb6 qui permet de calcul
|
Derniers Blogs
DéMARRONS AVEC LES TASKSDéMARRONS AVEC LES TASKS par richardc
Que vous le vouliez ou non, le développement multi-tâche est maintenant une obligation pour toute nouvelle application. Il est donc vital d'en comprendre les mécanismes et de s'y mettre le plus tôt possible.
En attendant le .NET Framework 4.5 avec le...
Cliquez pour lire la suite de l'article par richardc SLIDE & DéMO TECHDAYS 2012 - FAST & FURIOUS XAML APPSSLIDE & DéMO TECHDAYS 2012 - FAST & FURIOUS XAML APPS par Vko
Retrouvez les slides et les démo de ma session Fast & Furious XAML Apps. A ceux qui se posent la question : "est-ce que le code de la DataGrid est disponible?", je vous répondrais "pas encore". Je vais mettre en place un projet codeplex pour part...
Cliquez pour lire la suite de l'article par Vko XNA IS DEAD!XNA IS DEAD! par richardc
Depuis la semaine dernière (et grâce aux TechDays 2012), je me penche activement sur la nouvelle version de Windows, aka Windows 8. Vous me direz, il était temps puisque la première preview date de Septembre dernier.
OK. Remarquez, on n'en est qu'aux...
Cliquez pour lire la suite de l'article par richardc TECHDAYS PARIS 2012 : WINDOWS SERVER "8" QUOI DE 9 !TECHDAYS PARIS 2012 : WINDOWS SERVER "8" QUOI DE 9 ! par ROMELARD Fabrice
Speakers: Fabrice Meillon et Stanislas Quastana Cette session est basée entièrement sur celle donnée lors de la BUILD cet hiver. Il n'y a pas d'ajout d'information en rapport avec cet évènement passé. Windows 8 Server sera intégralem...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice [HTML5] AUTOUR DU W3C : NOUVEAUX STANDARDS ET WEB MOBILE (LILLE)[HTML5] AUTOUR DU W3C : NOUVEAUX STANDARDS ET WEB MOBILE (LILLE) par Gio
Je m'y prends un peu tard je sais, mais bon je suis développeur web et donc hyper fainéant ! Toujours dans le cadre des technologies émergentes, ici HTML5, parce qu'on aime HTML5 chez Wyg , nous seront présent, le vieux ( Aurélien V.) et moi, pour pr...
Cliquez pour lire la suite de l'article par Gio
Logiciels
DocTranslate (V3.1.0.0)DOCTRANSLATE (V3.1.0.0)DocTranslate est un traducteur de document Microsoft Word, PowerPoint et Excel. Il permet d'autom... Cliquez pour télécharger DocTranslate Tribler (2012)TRIBLER (2012)Tribler est un client pair à pair (P2P/Peer-to-Peer) open source avec la capacité de regarder des... Cliquez pour télécharger Tribler OneSwarm (2012)ONESWARM (2012)Le peer-to-peer qui protège votre vie privée, c'est OneSwarm.
Ce logiciel de peer-to-peer crypté... Cliquez pour télécharger OneSwarm PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)PONAMEDIA TV DEVIENS HELLLOOO FLASH
LA TV SUR VOTRE ORDINATEUR.
Toute une plateforme Multi... Cliquez pour télécharger PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO Academy System (17.2.1.0)ACADEMY SYSTEM (17.2.1.0)Logiciel de gestion des établissements.
- élèves/étudiants (inscription, dossier, absence...)
-... Cliquez pour télécharger Academy System
|