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
Test de l'utilisation d'un fichier en VB6 [ par benvp ]
Bonjour,Dans mon application, je reçois des fichers toutes les 2 secondes, et je dois les analyser pour extraire le contenu intéressant et l'afficher
Question subsidiaire à VB6 et ajouter une feuille à un classeur. [ par LIBRE_MAX ]
Salut,J' ai résolu la question de l' ajout.Reste à savoir comment appliquerdynamiquement une mise en page.Mon but est faire une mise en forme (manuell
Connexion VB6 & base de donnée sans passer par ADO [ par Stag2 ]
BonjourJe cherche à faire communiquer une base de donnée ainsi que mon application VB6.Je ne souhaite pas passer par ADO car cette apllication sera in
Etat d'un formulaire dans vb6 [ par ngalino ]
bonjour, svp j'aimerais savoir comment faire pour désactiver le bouton Fermer situé à l'extrême droit d'un formulaire? entre autre, comment fixer un
Connexion VB6 et mysql [ par alailson2002 ]
J'ai une base de données sur my sql que je n'arrive pas à relié avec mon projet VB, es-ce un problime des pilotes de connexion?
Inclure une icone de mon prog dans la zone de notification... Comment faire sous VB6 ? [ par fab_vb6 ]
Salut à tous !Je souhaite inclure une icon de mon prog dans la zone de notification à droite... Comment faire sous VB6 ?Auriez vous une idée.Je pense
[Install] javasign.dll empeche l'installation de VB6 [ par helios44 ]
Bonjour,J'ai voulu installer à nouveau VB6 sur mon poste. En vain, j'ai le message suivant qui s'affiche :"La tentative d'enregistrement automatique d
forme du formulaire sous VB6 [ par tchak ]
slt je voudrais savoir si sous vb6 on peut modifier la forme du formulaire
support vb6 [ par tchak ]
ou est ce ke je peux trouver un support complet telechargeable comme la collection MSDN de vb6?
|
Derniers Blogs
UNE JOLIE-HORLOGE ET PAS QU'UN PEU !UNE JOLIE-HORLOGE ET PAS QU'UN PEU ! par neodante
Pour les possesseurs d'iPhone, ça y est Bijin Tokei - qui se traduit littéralement en Français par " Jolie Horloge " - est arrivé et GRATUITEMENT s'il vous plaît ! Après la version Tokyo, Hokkaido, night club, racing, Gal, "pour les mademoiselles'", . voi...
Cliquez pour lire la suite de l'article par neodante TECHDAYS PARIS 2010 : CONNECTEZ VOS DONNéES à SHAREPOINT 2010 AVEC LES BUSINESS CONNECTIVITY SERVICESTECHDAYS PARIS 2010 : CONNECTEZ VOS DONNéES à SHAREPOINT 2010 AVEC LES BUSINESS CONNECTIVITY SERVICES par ROMELARD Fabrice
Animé par: Gaetan Bouveret et Julien Chomarat Business Connectivity Services (BCS) est dans SharePoint 2010 la version 2 de Business Data Catalog (BDC dans SharePoint 2007). Il s'agit de la solution permettant de visualiser des données provenan...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice [DIVERS] SUIVRE VOS SéRIES PRéFéRéS SUR LA TOILE[DIVERS] SUIVRE VOS SéRIES PRéFéRéS SUR LA TOILE par orion
Comme de nombreux geek, je suis un grand amateur de série TV et je rate régulièrement des épisodes de mes séries préférés. Une solution s'offre à vous avec ce merveilleux site : Tv Gorge - www.tvgorge.com Moteur de recherche à l'appui, vous pouvez ...
Cliquez pour lire la suite de l'article par orion TECHDAYS PARIS 2010 : LA BI DANS SHAREPOINT 2010TECHDAYS PARIS 2010 : LA BI DANS SHAREPOINT 2010 par ROMELARD Fabrice
Animé par: Vincent Bellet et Baptiste Giraudier La BI dans SharePoint 2010, Les nouveaux services d'application dans SP2010 et SQL Server Reporting services 2008 R2. La BI dans SharePoint est généralisée pour tous afin de permettre à tous les coll...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice
Logiciels
DB-MAIN (9.1.0)DB-MAIN (9.1.0)DB-MAIN is a data-modeling and data-architecture tool. It is designed to help developers and anal... Cliquez pour télécharger DB-MAIN Xilisoft DPG Convertisseur (5.1.37.0120)XILISOFT DPG CONVERTISSEUR (5.1.37.0120)Xilisoft DPG Convertisseur offre aux fans de Nintendo DS une bonne solution leur permettant de dé... Cliquez pour télécharger Xilisoft DPG Convertisseur GraphicsGale (2.01.01)GRAPHICSGALE (2.01.01)GraphicsGale est un logiciel de PixelArt avec de nombreuse fonctionnalités permettant de réalisé ... Cliquez pour télécharger GraphicsGale Architecte 3D (Platinum 2010)ARCHITECTE 3D (PLATINUM 2010)Architecte 3D Platinium vous permet de concevoir facilement les plans votre future maison, de l'é... Cliquez pour télécharger Architecte 3D TeamViewer 5 (TeamViewer 5)TEAMVIEWER 5 (TEAMVIEWER 5)Dépanner un ami,expliquer une manipulation devient un jeu d'enfant.
Prise en main d'un autre ord... Cliquez pour télécharger TeamViewer 5
|