Récupérer la cible d'un lien windows
Soyez le premier à donner votre avis sur cette source.
Vue 10 598 fois - Téléchargée 547 fois
Description
Récupère le chemin détaillé de la cible d'un lien. Cet exemple n'utilise aucun appel API ou OCX, mais décrypte le fichier original.
Source / Exemple :
Private Function ResolveWindowsShortcut(fichier As String) As String 'Philippe PUECH - Mai 2001 'puech@inviweb.com 'http://www.inviweb.com ' 'Fonction "beta" permettant de résoudre un lien Windows en se passant de tous 'les appels aux API. ' 'Notes : '---------- 'Je ne me suis attardé que sur le "chemin" sur un réseau local. 'Notez que vous pourrez également adapter cette fonction pour retourner 'des informations concernant le fichier "cible", notamment sa taille et ses 'flags. 'C'est un décodage "simple" basé sur le travail de reverse engineering de 'Jesse Hager que j'ai trouvé sur un site détaillant les différents 'formats de fichiers (http://www.wotsit.org) 'Son document stipule que ce format de fichier LNK est susceptible de changer 'sans préavis et qu'il est préférable d'utiliser les fonctions IShellLink pour 'gérer les liens. Celles-ci étant mal documentées en VB, j'ai préféré adapter 'ses informations. ' 'Utilise deux sous fonctions : fnd et DecToB On Error GoTo erreur Dim fnum As Integer Dim ent() As Byte fnum = FreeFile(0) Open fichier For Binary As fnum debut = 1 'Chercher le L en première lettre ReDim ent(3) Get fnum, debut, ent If ent(0) = 76 Then 'c'est un fichier LNK 'GUID ReDim ent(15) Get fnum, , ent 'Flags ReDim ent(3) Get fnum, , ent fFlags = DecToB(fnd(CStr((ent(0))))) HasShellItemIDList = (Mid(fFlags, 1, 1) = "1") FileOrDirectory = (Mid(fFlags, 2, 1) = "1") HasDescriptionString = (Mid(fFlags, 3, 1) = "1") HasRelativePathString = (Mid(fFlags, 4, 1) = "1") HasWorkingDirectory = (Mid(fFlags, 5, 1) = "1") HasCommandLineArgs = (Mid(fFlags, 6, 1) = "1") HasCustomIcon = (Mid(fFlags, 7, 1) = "1") 'File attributes ReDim ent(3) Get fnum, , ent fFlags = DecToB(fnd(CStr((ent(0))))) f_readonly = (Mid(fFlags, 1, 1) = "1") f_hidden = (Mid(fFlags, 2, 1) = "1") f_system = (Mid(fFlags, 3, 1) = "1") f_volumelabel = (Mid(fFlags, 4, 1) = "1") f_directory = (Mid(fFlags, 5, 1) = "1") f_archive = (Mid(fFlags, 6, 1) = "1") f_encrypted = (Mid(fFlags, 7, 1) = "1") f_Normal = (Mid(fFlags, 8, 1) = "1") f_temporary = (Mid(fFlags, 9, 1) = "1") f_sparsefile = (Mid(fFlags, 10, 1) = "1") f_reparsepointdata = (Mid(fFlags, 11, 1) = "1") f_compressed = (Mid(fFlags, 12, 1) = "1") f_offline = (Mid(fFlags, 13, 1) = "1") 'Time 1 ReDim ent(7) Get fnum, , ent 'Time 2 ReDim ent(7) Get fnum, , ent 'Time 3 ReDim ent(7) Get fnum, , ent 'File length ReDim ent(3) Get fnum, , ent taille = Val("&H" + fnd(CStr(Hex(ent(3)))) + fnd(CStr(Hex(ent(2)))) + fnd(CStr(Hex(ent(1)))) + fnd(CStr(Hex(ent(0))))) 'Icon Number ReDim ent(3) Get fnum, , ent 'ShowWnd ReDim ent(3) Get fnum, , ent 'HotKey ReDim ent(3) Get fnum, , ent 'Unknown ReDim ent(3) Get fnum, , ent 'Unknown ReDim ent(3) Get fnum, , ent If HasShellItemIDList Then 'ShellItemidLength ReDim ent(1) Get fnum, , ent skip = Val("&H" + fnd(CStr(Hex(ent(1)))) + fnd(CStr(Hex(ent(0))))) ReDim ent(skip - 1) Get fnum, , ent End If 'File Location Info 'Length departfli = Loc(fnum) ReDim ent(3) Get fnum, , ent tailleFLI = Val("&H" + fnd(CStr(Hex(ent(3)))) + fnd(CStr(Hex(ent(2)))) + fnd(CStr(Hex(ent(1)))) + fnd(CStr(Hex(ent(0))))) '1c ReDim ent(3) Get fnum, , ent 'Flags ReDim ent(3) Get fnum, , ent tailleFLI = Val("&H" + fnd(CStr(Hex(ent(3)))) + fnd(CStr(Hex(ent(2)))) + fnd(CStr(Hex(ent(1)))) + fnd(CStr(Hex(ent(0))))) 'Offset Local VolumeInfo ReDim ent(3) Get fnum, , ent offvolinf = Val("&H" + fnd(CStr(Hex(ent(3)))) + fnd(CStr(Hex(ent(2)))) + fnd(CStr(Hex(ent(1)))) + fnd(CStr(Hex(ent(0))))) 'Offset BasePath Local ReDim ent(3) Get fnum, , ent offbase = Val("&H" + fnd(CStr(Hex(ent(3)))) + fnd(CStr(Hex(ent(2)))) + fnd(CStr(Hex(ent(1)))) + fnd(CStr(Hex(ent(0))))) 'Offset Network Volume Info ReDim ent(3) Get fnum, , ent offnetw = Val("&H" + fnd(CStr(Hex(ent(3)))) + fnd(CStr(Hex(ent(2)))) + fnd(CStr(Hex(ent(1)))) + fnd(CStr(Hex(ent(0))))) 'Offset Remaining Pathname ReDim ent(3) Get fnum, , ent offrem = Val("&H" + fnd(CStr(Hex(ent(3)))) + fnd(CStr(Hex(ent(2)))) + fnd(CStr(Hex(ent(1)))) + fnd(CStr(Hex(ent(0))))) If offbase <> 0 Then Seek fnum, departfli + offbase + 1 ch = "" ReDim ent(0) continuer = True While continuer Get fnum, , ent If ent(0) = 0 Then continuer = False Else ch = ch + Chr(ent(0)) End If Wend f_basepath = ch End If If offrem <> 0 Then Seek fnum, departfli + offrem + 1 ch = "" ReDim ent(0) continuer = True While continuer Get fnum, , ent If ent(0) = 0 Then continuer = False Else ch = ch + Chr(ent(0)) End If Wend f_rem = ch End If ResolveWindowsShortcut = f_rem + f_basepath Else ResolveWindowsShortcut = "Not a link file" End If Close fnum Exit Function erreur: ResolveWindowsShortcut = "Error occured in function 'ResolveWindowsShortcut' for " + """" + fichier + """" + "." End Function Public Function DecToB(NDecimal As Double) As String 'http://www.ifrance.com/LeSiteWeb/index.htm Dim NLoop Dim pd As Long, i As Long If NDecimal = 0 Then DecToB = "0" Exit Function End If If NDecimal = 1 Then DecToB = "1" Exit Function End If NDecimal = NDecimal + 1 NLoop = -1 Do Until pd >= NDecimal NLoop = NLoop + 1 pd = 2 ^ NLoop Loop DecToB = "1" NDecimal = NDecimal - 2 ^ (NLoop - 1) For i = NLoop - 2 To 0 Step -1 If 2 ^ i < NDecimal Then DecToB = DecToB & "1" NDecimal = NDecimal - 2 ^ i Else DecToB = DecToB & "0" End If Next i End Function Public Function fnd(x As String) As String 'ajoute un zéro devant un chiffre de 1 caractère ex : 1=>01 If Len(x) = 1 Then fnd = "0" + x Else fnd = x End If End Function Private Sub Dir1_Change() File1.Path = Dir1.Path End Sub Private Sub Drive1_Change() Dir1.Path = Drive1.Drive End Sub Private Sub File1_Click() MsgBox ResolveWindowsShortcut(File1.Path + "\" + File1.filename) End Sub
Codes Sources
A voir également
- Ent 3 sources
- Inviweb - Meilleures réponses
- Klink - classe de gestion des liens windows - Codes sources - C / C++ / C++.NET (Système)
- Meme popup cible pour plusieurs liens - Codes sources - Javascript (Divers)
- Recuperer la cible d'un fichier raccourci - Codes sources - Visual Basic / VB.NET (Fichier / Disque)
- Visual Basic / VB.NET : Recuperer la cible d'un raccourci - CodeS SourceS - Guide
- Récupérer la date d'installation de windows ✓ - Forum - Visual Basic 6
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.