استخراج آدرس لینک از فایل lnk

[SlowCode]

سلام
چطوری میشه آدرس لینک رو از فایل lnk بدست بیاریم؟
خودم به طور دستی فایل رو باز کردم و با instr , mid تونستم بدست بیارمش ولی این روش دقیق نیست.
تو نت هم بعد از کلی جستجو این رو پیدا کردم:

'First add Microsoft shell controls Reference
Dim s As Shell
Dim fi As FolderItem
Dim f As Folder
Dim l As ShellLinkObject
Dim i As Long

Set s = New Shell
Set f = s.BrowseForFolder(Me.hWnd, "Browse folder", 0, ssfDESKTOP)
For i = 0 To f.Items.Count - 1
Set fi = f.Items.Item(i)
If fi.IsLink Then
Set l = fi.GetLink
MsgBox l.Path
End If
Next
Set l = Nothing
Set fi = Nothing
Set f = Nothing
Set s = Nothing

این خیلی خوبه ولی نمیخوام صفحه BrowseForFolder باز بشه! میخوام خودم آدرس پوشه رو بدم و لینک ها رو دربیاره.:متفکر:

[محسن واژدی]

سلام علیکم
تابع زیر را در ماژول قرار بدین:
Private Function GetShortcutTargetPath(ByVal sShortcutFile$) As String
On Error Resume Next
Dim WshShell
Set WshShell = CreateObject("wscript.shell")
Set oShellLink = WshShell.CreateShortcut(sShortcutFile$)
GetShortcutTargetPath = oShellLink.TargetPath
Set WshShell = Nothing
Set oShellLink = Nothing
End Function

برای مثال:
Private Sub Command1_Click()
MsgBox "Shortcut target path: " & GetShortcutTargetPath("C:\myfile.lnk")
End Sub

موفق باشید

[tooraj_azizi_1035]

می تونی با استفاده از عبارات باقاعده این کار رو بکنی:


'Prepare a regular expression object
Dim myRegExp As RegExp
Dim myMatches As MatchCollection
Dim myMatch As Match
Set myRegExp = New RegExp
myRegExp.IgnoreCase = True
myRegExp.Global = True
myRegExp.Pattern = "regex"
Set myMatches = myRegExp.Execute(subjectString)
For Each myMatch in myMatches
MsgBox(myMatch.Value)
Next



روش استفاده :http://support.microsoft.com/kb/818802
http://www.regular-expressions.info/vb.html

الگوی لازم جهت استخراج:



Function RegExpTest(myPattern As String, myString As String)
‘Create objects.
Dim objRegExp As RegExp
Dim objMatch As Match
Dim colMatches As MatchCollection
Dim RetStr As String

‘ Create a regular expression object.
Set objRegExp = New RegExp

‘Set the pattern by using the Pattern property.
objRegExp.pattern = myPattern

‘ Set Case Insensitivity.
objRegExp.IgnoreCase = True

‘Set global applicability.
objRegExp.Global = True

‘Test whether the String can be compared.
If (objRegExp.Test(myString) = True) Then

‘Get the matches.
Set colMatches = objRegExp.Execute(myString) ‘ Execute search.

For Each objMatch In colMatches ‘ Iterate Matches collection.
RetStr = RetStr & “Match found at position ”
RetStr = RetStr & objMatch.FirstIndex & “. Match Value is ‘”
RetStr = RetStr & objMatch.Value & “‘.” & vbCrLf
Next

Else
RetStr = “The given string does not match the pattern”
End If
RegExpTest = RetStr
End Function

Calling the function in the command click event by passing the required parameters. The first parameter is the regex pattern and the second parameter is the url string to validate.

Private Sub Command1_Click()
Dim url_test As String
url_test = TestRegExp(”^http\://[a-zA-Z0-9\-\.]+\.[a-zA-Z]{2,3}(/\S*)?$”, “http://chrisranjana.com“ (http://chrisranjana.com%E2%80%9C))
MsgBox(url_test)
End Sub

[SlowCode]

می تونی با استفاده از عبارات باقاعده این کار رو بکنی:


'Prepare a regular expression object
Dim myRegExp As RegExp
Dim myMatches As MatchCollection
Dim myMatch As Match
Set myRegExp = New RegExp
myRegExp.IgnoreCase = True
myRegExp.Global = True
myRegExp.Pattern = "regex"
Set myMatches = myRegExp.Execute(subjectString)
For Each myMatch in myMatches
MsgBox(myMatch.Value)
Next



روش استفاده :http://support.microsoft.com/kb/818802
http://www.regular-expressions.info/vb.html

الگوی لازم جهت استخراج:



Function RegExpTest(myPattern As String, myString As String)
‘Create objects.
Dim objRegExp As RegExp
Dim objMatch As Match
Dim colMatches As MatchCollection
Dim RetStr As String

‘ Create a regular expression object.
Set objRegExp = New RegExp

‘Set the pattern by using the Pattern property.
objRegExp.pattern = myPattern

‘ Set Case Insensitivity.
objRegExp.IgnoreCase = True

‘Set global applicability.
objRegExp.Global = True

‘Test whether the String can be compared.
If (objRegExp.Test(myString) = True) Then

‘Get the matches.
Set colMatches = objRegExp.Execute(myString) ‘ Execute search.

For Each objMatch In colMatches ‘ Iterate Matches collection.
RetStr = RetStr & “Match found at position ”
RetStr = RetStr & objMatch.FirstIndex & “. Match Value is ‘”
RetStr = RetStr & objMatch.Value & “‘.” & vbCrLf
Next

Else
RetStr = “The given string does not match the pattern”
End If
RegExpTest = RetStr
End Function

Calling the function in the command click event by passing the required parameters. The first parameter is the regex pattern and the second parameter is the url string to validate.

Private Sub Command1_Click()
Dim url_test As String
url_test = TestRegExp(”^http\://[a-zA-Z0-9\-\.]+\.[a-zA-Z]{2,3}(/\S*)?$”, “http://chrisranjana.com“ (http://chrisranjana.com%E2%80%9C))
MsgBox(url_test)
End Sub

ممنون ولی اینکه شما دادین واسه url هست من منظورم فایل های لینک ویندوز بود که جواب رو آقای واژدی نوشتن.