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 6 349 fois - Téléchargée 1 193 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

Signaler
cs_PROGRAMMIX
Messages postés
1134
Date d'inscription
mercredi 2 octobre 2002
Statut
Membre
Dernière intervention
24 juillet 2011
 1
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).
Signaler
cs_PaTaTe
Messages postés
2081
Date d'inscription
mercredi 21 août 2002
Statut
Contributeur
Dernière intervention
16 mars 2020
 2
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).
Signaler
cs_PROGRAMMIX
Messages postés
1134
Date d'inscription
mercredi 2 octobre 2002
Statut
Membre
Dernière intervention
24 juillet 2011
 1
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 ?
Signaler
deleplace
Messages postés
40
Date d'inscription
mardi 4 octobre 2005
Statut
Membre
Dernière intervention
2 mars 2009
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
Signaler
ghuysmans99
Messages postés
2501
Date d'inscription
jeudi 14 juillet 2005
Statut
Contributeur
Dernière intervention
5 juin 2016
 1
@ 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)