1. Accueil
  2. Visual Basic / VB.NET
  3. Sources Visual Basic / VB.NET
  4. Sources Exécution
  5. Suppresseur de la dépendace à vb6fr.dll rend les exes vb6 autonomes

Suppresseur de la dépendace à vb6fr.dll rend les exes vb6 autonomes

Soyez le premier à donner votre avis sur cette source.

Vue 7 125 fois - Téléchargée 1 262 fois

Télécharger le projet
Commenter

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 / Exemple : 


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
Télécharger le projet

Codes Sources

A voir également

Ajouter un commentaire Commentaires
cs_PROGRAMMIX Messages postés 1133 Date d'inscription mercredi 2 octobre 2002 Statut Membre Dernière intervention 24 juillet 2011 3
17 juin 2010 à 17:45
Merci pour l'info.
En fait, je ne développe pas sur une machine dont je ne suis pas Administrateur. Je développe à la maison et installe ensuite mes programmes au boulot. Et là, le nouveau PC est en compte limité.
Faudra certainement que je revois ça avec le responsable parce que ça me gonfle (même l'heure du PC ne peut être modifiée).
cs_PaTaTe Messages postés 2107 Date d'inscription mercredi 21 août 2002 Statut Contributeur Dernière intervention 19 février 2021 2
16 juin 2010 à 21:33
Pour les appels des DLL si tu utilise l'option P-Code pour la compilation, oui elles peuvent être dans le même répertoire que ton programme. Pour les OCX par contre c'est plus délicat. Si ils sont déjà enregistrés sur la machine pas de soucis par contre pour ceux qui ne le sont pas, un accès en écriture à la base de registre est nécessaire, autant éviter d'en utiliser. En même temps, développer sur une machine dont tu n'es pas administrateur dessus, c'est pas très logique (ni pratique).
cs_PROGRAMMIX Messages postés 1133 Date d'inscription mercredi 2 octobre 2002 Statut Membre Dernière intervention 24 juillet 2011 3
12 juin 2010 à 18:18
Au boulot, j'ai un compte limité sur le PC ; donc impossible d'installer quoi que ce soit qui modifie la base de registre.

Dès lors, est-ce qu'en mettant les OCX et DLL dans le même répertoire que l'EXE sur une clé USB, il me sera possible d'utiliser le programme ?
deleplace Messages postés 40 Date d'inscription mardi 4 octobre 2005 Statut Membre Dernière intervention 2 mars 2009
2 mars 2009 à 14:43
La dernière version proposée ne redirige plus la dépendance
à VB6FR.DLL vers MSDMO.DLL mais vers MSVBVM60.DLL
c'est plus logique, l'EXE est déja dépendant de MSVBVM60.DLL
et surtout cela supprime les problèmes constatés
différence avant et après patch:
les messages d'erreurs critiques(progamme planté)
sont en Anglais au lieu d'être en Français
ghuysmans99 Messages postés 2495 Date d'inscription jeudi 14 juillet 2005 Statut Contributeur Dernière intervention 5 juin 2016 1
28 févr. 2009 à 01:15
@ deleplace : J'ai l'impression que les heureux possesseurs de ces licences veulent les garder !
Afficher les 19 commentaires
S'inscrire maintenant

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.

Du même auteur (deleplace)