Open the target folder → VBS version - China DOS Union Forum

Just a little trick,
Conveniently and quickly open the target folder of the desktop shortcut.
http://zhenlove.com.cn/cndos/fileup/files/Open_Shortcut_Parent_Folder.rar

[ Last edited by baomaboy on 2007-3-18 at 04:06 AM ]

Dim WshSHell,FSO
On Error Resume Next
Set WshSHell = WScript.CreateObject("WScript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WinVer = WshSHell.Environment("Process")
Set Args = WScript.Arguments
CloseTime = 5
FileName = WScript.ScriptName
FileFullName = WScript.ScriptFullName
FilePath = FSO.GetParentFolderName(FileFullName)
InsPath = FSO.GetSpecialFolder(1)
InsFullName = FSO.BuildPath(InsPath ,FileName)
LnkPathNT = WshSHell.SpecialFolders(2)
LnkPath9X = WshSHell.SpecialFolders(14)
LnkPathAll = WshSHell.SpecialFolders("StartMenu")
OtherFileName="winclip.exe"
OtherFilePath=FSO.GetSpecialFolder(1)
TemFileName="无标题"
TemFilePath=FSO.GetSpecialFolder(2)
Copyright="Linglong Technology"
QQ="QQ:25926183"
Email="Email:fty1995@163.com"
InsTitle="Quickly Open the Directory Where the Shortcut Is Located"
InsAnswer="Open Target Folder"
RegPath0="HKEY_CLASSES_ROOT\lnkfile\shell\"
RegValue0="open"
RegForm0="REG_SZ"
RegPath1="HKEY_CLASSES_ROOT\lnkfile\shell\Open Folder\"
RegValue1="Open Target Folder"
RegForm1="REG_SZ"
RegPath2="HKEY_CLASSES_ROOT\lnkfile\shell\Open Folder\command\"
RegValue2="wscript.exe " & chr(34) & InsFullName & chr(34) & " " & chr(34) & "%L" & chr(34)
RegForm2="REG_SZ"
If WinVer("OS") = "Windows_NT" Then
LnkPath=LnkPathNT
Else
LnkPath=LnkPath9X
End If
IF FileFullName <> InsFullName then
intAnswer = MsgBox(" Add "+ InsAnswer +" to the shortcut right-click menu, "&Chr(10)&Chr(10)&" Remove "+ InsAnswer +" from the shortcut right-click menu. ", vbQuestion + vbYesNoCancel, "Installation - "+ InsTitle +" - "+ Copyright)
If intAnswer = vbYes Then
WshSHell.RegWrite RegPath0,RegValue0,RegForm0
WshSHell.RegWrite RegPath1,RegValue1,RegForm1
WshSHell.RegWrite RegPath2,RegValue2,RegForm2
FSO.GetFile(FileFullName).Copy(InsFullName)
WshSHell.popup _
"Add script file: "+chr(10)+InsFullName+chr(10)+chr(10)+ _
"Add registry entry: "+chr(10)+chr(34)+ RegPath1 +chr(34)+chr(10)+ _
chr(10) & CloseTime & " The window will close automatically after seconds!" +chr(10)+chr(10)+ _
chr(10) & "Copyright(C) " + Copyright +" " & QQ &" " + Email _
, CloseTime, "Installation Successful - "+ InsTitle +" - "+ Copyright, 0 + 64
end if
If intAnswer = vbNo Then
WshSHell.RegDelete RegPath2
WshSHell.RegDelete RegPath1
FSO.DeleteFile InsFullName
WshSHell.popup _
"Delete script file: "+chr(10)+InsFullName+chr(10)+chr(10)+ _
"Delete registry entry: "+chr(10)+chr(34)+ RegPath1 +chr(34)+chr(10)+ _
chr(10) & CloseTime & " The window will close automatically after seconds!" +chr(10)+chr(10)+ _
chr(10) & "Copyright(C) " + Copyright +" " & QQ &" " + Email _
, CloseTime, "Uninstallation Successful - "+ InsTitle +" - "+ Copyright, 0 + 64
end if
If intAnswer = vbCancel Then
end if
ELSE
if Args.count="0" then:WScript.Quit(0):end if
LinkName = Args(0)
Set Scut = WshSHell.CreateShortcut(linkname)
Folder = """" & FSO.GetParentFolderName(Scut.TargetPath) & """"
WshSHell.Run(Folder)
END IF
Set WshSHell = Nothing
Set FSO = Nothing
Set Args = Nothing
WScript.Quit(0)

　

[ Last edited by baomaboy on 2008-3-25 at 01:03 AM ]

Found a script using WMI

'==========================================================================
'
' NAME: ShowLnkTarget.vbs
'
' AUTHOR: SleepBoy
' DATE : 2006-1-12
'
' COMMENT: Quickly display the location of the "target" in the "shortcut" and keep the focus on the target.
'
' Installation instructions: 1. Place it in any directory, double-click the script directly to complete the installation.
' 2. After installation, right-click the shortcut, and there will be an item "Show Target Location".
' 3. If you move the location of the script, install it again.
' 4. The script name can be changed. After changing, install it again.
'
'==========================================================================

Option Explicit

Dim objArgs, WshShell
Set objArgs = WScript.Arguments
Set WshShell = WScript.CreateObject("WScript.Shell")

If objArgs.Count = 1 Then
ShowLnkTarget
ElseIf objArgs.Count = 0 Then
Setup
End If

'==========================================================================

Sub Setup
Dim QM
QM = """"
WshShell.RegWrite "HKCR\lnkfile\shell\ShowLnkTarget\", "Show Target Location"
WshShell.RegWrite "HKCR\lnkfile\shell\ShowLnkTarget\command\", _
QM & WScript.FullName & QM & " " & _
QM & WScript.ScriptFullName & QM & " " & _
QM & "%1" & QM
MsgBox "Installation completed!",64,WScript.ScriptName
End Sub

'---------------------------------------------------------------------------

Sub ShowLnkTarget
Dim lnkname, strComputer, objWMIService, colFiles, objFile
lnkname = Replace(objArgs(0),"\","\\")

strComputer = "."
Set objWMIService = GetObject _
("winmgmts:\\" & strComputer & "\root\cimv2")
Set colFiles = objWMIService.ExecQuery _
("Select * From Win32_ShortcutFile WHERE Name = " & "'" & lnkname & "'")

For Each objFile in colFiles
WshShell.Run ("explorer /n, /select," & objFile.Target)
Next
End Sub

'==========================================================================
'Uninstallation: Save the following code as REG
'REGEDIT4

'

　
[ Last edited by baomaboy on 2008-3-25 at 01:04 AM ]

There is another one. Hey, it's similar to the code on the second floor. I won't post it.

[ Last edited by baomaboy on 2007-4-11 at 06:27 AM ]

Is using this line simpler? explorer /select,%1

Originally posted by everest79 at 2007-4-11 06:30:
Is this line simpler? explorer /select,%1

everest79 may not have looked carefully. What needs to be opened is not the directory where the LNK is located, but the directory pointed to by the LNK.
Picture
Thunder.lnk, you opened the desktop, I opened C:\Program Files\Thunder

And I don't feel that the code is complicated. For example, the code on the third floor, the main idea is also like brother, just one line of explorer /select,%1
But the person who wrote the code did it for use rather than to tell a technology or trick, so there are those seemingly complicated and useless codes. Because he didn't want to change the registry to implement installation again, and to pass the obtained path parameters. In short, the seemingly useless code is piled up.
This is my guess about the original author's thoughts. I think he should also understand that the line explorer /select,%1 is simpler...

[ Last edited by baomaboy on 2007-4-11 at 12:39 PM ]

May I ask baomaboy if it's possible to use VBS to obtain the image resolution and size (jpg, gif, bmp) (script)

I want to ask here:

Folder = """" & FSO.GetParentFolderName(Scut.TargetPath) & """"
WshSHell.Run(Folder)

Then the quotes, is it okay to use any number of them? Or do they need to appear in even numbers??
How many do I need so that the program doesn't report an error??
Thx

Originally posted by zh159 at 2007-4-11 16:24:
May I ask, can baomaboy use VBS to obtain the image resolution and size (jpg, gif, bmp) (script)

Currently, only the file size can be obtained using fso.size. As for the resolution.... If I find out later, I will definitely add it later ^_^.

Originally posted by kich at 2007-4-12 22:23:
I want to ask here:

Folder = """" & FSO.GetParentFolderName(Scut.TargetPath) & """"
WshSHell.Run(Folder)

Are those quotes, just any few are okay...

Not just any, and not an even number, but follow the rules. In VBS, if the " symbol really needs to appear in the string, use two " symbols to represent it. As long as this rule is followed, it's okay.

For example, Folder = """" The " symbols at both ends of the "" just indicate that the middle is a string value. The two " in the middle are the main body (one "), that is, Folder = "

[ Last edited by baomaboy on 2007-4-13 at 07:59 AM ]

Found a method using WMI...

Using the powerful Shell.Application can also achieve:


    Dim arrFile
    Dim oFile,oDir,oShell,oLink
    
    arrFile = MyGetFile()
Set oShell = CreateObject("Shell.Application")
Set oDir = oShell.NameSpace(arrFile(1) + "\")
Set oFile = oDir.ParseName(arrFile(0))
Set oLink = oFile.GetLink
WScript.Echo oLink.WorkingDirectory & "\"

Set oFile = Nothing
Set oDir = Nothing
Set oShell = Nothing

'***********************************************************************************
'Get the file to operate, return an array containing the file name and path
'***********************************************************************************
Function MyGetFile()

On Error Resume Next
Dim strFile,objFso,objFile
    If WScript.Arguments.Count < 1 Then
        Set objDialog = CreateObject("UserAccounts.CommonDialog")
        objDialog.Filter = "Lnk file|*.lnk"
        objDialog.ShowOpen
        strFile = objDialog.FileName
        Set objDialog = Nothing
    Else
        strFile = WScript.Arguments(0)
    end if
Set objFso = CreateObject("Scripting.FileSystemObject")
Set objFile = objFso.GetFile(strFile)
    If Err Then 
        If Err.Number = 5 Then WScript.Quit
        WScript.Echo Err.Description 
        Err.Clear
        WScript.Quit
    Else
        MyGetFile = Array(objFile.Name,objFile.ParentFolder)
    End If
    
Set objFile = Nothing
Set objFso = Nothing

End Function

The limitation of this method is that it simply reads the path at the "start position". If you want to get the directory name more reliably, you can use oLink.Path to get the source file, and then separate the directory.
In addition, you can also use Adodb.Stream to read the binary stream to get the information you need. (The code is omitted, you just need to know that the format of Lnk can easily write the corresponding code. If needed, you can refer to the famous <The_Windows_Shortcut_File_Format.pdf>)

Originally posted by zh159 at 2007-4-11 16:24:
May I ask, can baomaboy use VBS to obtain the image resolution and size (jpg, gif, bmp) (script)

Method 1, using the LoadPicture function:


    Dim sFile,str
    sFile = "a.bmp"
Set oPicture = LoadPicture(sFile)
    str = "File:" & vbTab & sFile & vbCrLf
    str = str & "Width:" & vbTab & Fix(oPicture.Width / 26.458) & vbCrLf
    str = str & "Height:" & vbTab & Fix(oPicture.Height / 26.458)
Set oPicture = Nothing
WScript.Echo str

Method 2, using the powerful Shell.Application component:


    Dim arrFile
    Dim oFile,oDir,oShell
    
    arrFile = MyGetFile()
Set oShell = CreateObject("Shell.Application")
Set oDir = oShell.NameSpace(arrFile(1) + "\")
Set oFile = oDir.ParseName(arrFile(0))
WScript.Echo oDir.GetDetailsOf(oFile,-1)

Set oFile = Nothing
Set oDir = Nothing
Set oShell = Nothing

'***********************************************************************************
'Get the file to operate, return an array containing the file name and path
'***********************************************************************************
Function MyGetFile()

On Error Resume Next
Dim strFile,objFso,objFile
    If WScript.Arguments.Count < 1 Then
        Set objDialog = CreateObject("UserAccounts.CommonDialog")
        objDialog.Filter = "bmp file|*.bmp|jpg file|*.jpg|ico file|*.ico|all files|*.*"
        objDialog.ShowOpen
        strFile = objDialog.FileName
        Set objDialog = Nothing
    Else
        strFile = WScript.Arguments(0)
    end if
Set objFso = CreateObject("Scripting.FileSystemObject")
Set objFile = objFso.GetFile(strFile)
    If Err Then 
        If Err.Number = 5 Then WScript.Quit
        WScript.Echo Err.Description 
        Err.Clear
        WScript.Quit
    Else
        MyGetFile = Array(objFile.Name,objFile.ParentFolder)
    End If
    
Set objFile = Nothing
Set objFso = Nothing

End Function

Method 3, using Adodb.Stream to read the binary stream for analysis:



    Dim sFile,str
    Dim oStream
    Dim bWidth,bHeight
    
    sFile = "a.bmp"
Set oStream = CreateObject("Adodb.Stream")
With oStream
    .Type = 1
    .Open
    .LoadFromFile sFile
End With

'If it is BMP format, then Position=18, read 4 bytes;
'If it is gif format, then it is Position=6, read 2 bytes;
'If it is png format, then Position=16, read 4 bytes
    oStream.Position = 18
    bWidth = oStream.Read(4)
    bHeight = oStream.Read(4)
    oStream.Close
    
    str = "File:" & vbTab & sFile & vbCrLf
    str = str & "Width:" & vbTab & Bin2Num(bWidth) & vbCrLf
    str = str & "Height:" & vbTab & Bin2Num(bHeight)
Set oStream = Nothing
WScript.Echo str

'Convert binary stream to value
Private Function Bin2Num(binStr)

    Dim i,numLen
    numLen = Lenb(binStr)
    For i = numLen To 1 Step -1
        Bin2Num = Bin2Num * 256 + Ascb(Midb(binStr,i,1))
    Next

End Function

Method one is undoubtedly the simplest, but the information that can be obtained is also the least.
Method two is relatively moderate. Compared with method one, more information can be obtained, and the interactivity is relatively stronger.
Method three should be the most flexible. The disadvantage is that various formats of images need to be processed separately, which requires more understanding of various formats.

The code and the book have both been collected. Thanks. I wonder if the book contains the LNK format of Office (non-self-built LNK). The path bar in its properties has no available information and is in a grayed-out and unavailable state.

Originally posted by 3742668 at 2007-4-13 08:44:

Method 1, using the LoadPicture function:
Dim sFile,str sFile = "a.bmp" Set oPicture = LoadPicture(sFile) str = "File:" & vbTab & sFile & vbCr ... Wonderful!

Floor1　baomaboy	Posted 2007-03-18 04:05
银牌会员　Posts 554　Credits 1,513
Just a little trick, Conveniently and quickly open the target folder of the desktop shortcut. http://zhenlove.com.cn/cndos/fileup/files/Open_Shortcut_Parent_Folder.rar [ Last edited by baomaboy on 2007-3-18 at 04:06 AM ]

Floor2　baomaboy	Posted 2007-04-11 06:20
银牌会员　Posts 554　Credits 1,513
Dim WshSHell,FSO On Error Resume Next Set WshSHell = WScript.CreateObject("WScript.Shell") Set FSO = CreateObject("Scripting.FileSystemObject") Set WinVer = WshSHell.Environment("Process") Set Args = WScript.Arguments CloseTime = 5 FileName = WScript.ScriptName FileFullName = WScript.ScriptFullName FilePath = FSO.GetParentFolderName(FileFullName) InsPath = FSO.GetSpecialFolder(1) InsFullName = FSO.BuildPath(InsPath ,FileName) LnkPathNT = WshSHell.SpecialFolders(2) LnkPath9X = WshSHell.SpecialFolders(14) LnkPathAll = WshSHell.SpecialFolders("StartMenu") OtherFileName="winclip.exe" OtherFilePath=FSO.GetSpecialFolder(1) TemFileName="无标题" TemFilePath=FSO.GetSpecialFolder(2) Copyright="Linglong Technology" QQ="QQ:25926183" Email="Email:fty1995@163.com" InsTitle="Quickly Open the Directory Where the Shortcut Is Located" InsAnswer="Open Target Folder" RegPath0="HKEY_CLASSES_ROOT\lnkfile\shell\" RegValue0="open" RegForm0="REG_SZ" RegPath1="HKEY_CLASSES_ROOT\lnkfile\shell\Open Folder\" RegValue1="Open Target Folder" RegForm1="REG_SZ" RegPath2="HKEY_CLASSES_ROOT\lnkfile\shell\Open Folder\command\" RegValue2="wscript.exe " & chr(34) & InsFullName & chr(34) & " " & chr(34) & "%L" & chr(34) RegForm2="REG_SZ" If WinVer("OS") = "Windows_NT" Then LnkPath=LnkPathNT Else LnkPath=LnkPath9X End If IF FileFullName <> InsFullName then intAnswer = MsgBox(" Add "+ InsAnswer +" to the shortcut right-click menu, "&Chr(10)&Chr(10)&" Remove "+ InsAnswer +" from the shortcut right-click menu. ", vbQuestion + vbYesNoCancel, "Installation - "+ InsTitle +" - "+ Copyright) If intAnswer = vbYes Then WshSHell.RegWrite RegPath0,RegValue0,RegForm0 WshSHell.RegWrite RegPath1,RegValue1,RegForm1 WshSHell.RegWrite RegPath2,RegValue2,RegForm2 FSO.GetFile(FileFullName).Copy(InsFullName) WshSHell.popup _ "Add script file: "+chr(10)+InsFullName+chr(10)+chr(10)+ _ "Add registry entry: "+chr(10)+chr(34)+ RegPath1 +chr(34)+chr(10)+ _ chr(10) & CloseTime & " The window will close automatically after seconds!" +chr(10)+chr(10)+ _ chr(10) & "Copyright(C) " + Copyright +" " & QQ &" " + Email _ , CloseTime, "Installation Successful - "+ InsTitle +" - "+ Copyright, 0 + 64 end if If intAnswer = vbNo Then WshSHell.RegDelete RegPath2 WshSHell.RegDelete RegPath1 FSO.DeleteFile InsFullName WshSHell.popup _ "Delete script file: "+chr(10)+InsFullName+chr(10)+chr(10)+ _ "Delete registry entry: "+chr(10)+chr(34)+ RegPath1 +chr(34)+chr(10)+ _ chr(10) & CloseTime & " The window will close automatically after seconds!" +chr(10)+chr(10)+ _ chr(10) & "Copyright(C) " + Copyright +" " & QQ &" " + Email _ , CloseTime, "Uninstallation Successful - "+ InsTitle +" - "+ Copyright, 0 + 64 end if If intAnswer = vbCancel Then end if ELSE if Args.count="0" then:WScript.Quit(0):end if LinkName = Args(0) Set Scut = WshSHell.CreateShortcut(linkname) Folder = """" & FSO.GetParentFolderName(Scut.TargetPath) & """" WshSHell.Run(Folder) END IF Set WshSHell = Nothing Set FSO = Nothing Set Args = Nothing WScript.Quit(0) 　 [ Last edited by baomaboy on 2008-3-25 at 01:03 AM ]

Floor3　baomaboy	Posted 2007-04-11 06:22
银牌会员　Posts 554　Credits 1,513
Found a script using WMI '========================================================================== ' ' NAME: ShowLnkTarget.vbs ' ' AUTHOR: SleepBoy ' DATE : 2006-1-12 ' ' COMMENT: Quickly display the location of the "target" in the "shortcut" and keep the focus on the target. ' ' Installation instructions: 1. Place it in any directory, double-click the script directly to complete the installation. ' 2. After installation, right-click the shortcut, and there will be an item "Show Target Location". ' 3. If you move the location of the script, install it again. ' 4. The script name can be changed. After changing, install it again. ' '========================================================================== Option Explicit Dim objArgs, WshShell Set objArgs = WScript.Arguments Set WshShell = WScript.CreateObject("WScript.Shell") If objArgs.Count = 1 Then ShowLnkTarget ElseIf objArgs.Count = 0 Then Setup End If '========================================================================== Sub Setup Dim QM QM = """" WshShell.RegWrite "HKCR\lnkfile\shell\ShowLnkTarget\", "Show Target Location" WshShell.RegWrite "HKCR\lnkfile\shell\ShowLnkTarget\command\", _ QM & WScript.FullName & QM & " " & _ QM & WScript.ScriptFullName & QM & " " & _ QM & "%1" & QM MsgBox "Installation completed!",64,WScript.ScriptName End Sub '--------------------------------------------------------------------------- Sub ShowLnkTarget Dim lnkname, strComputer, objWMIService, colFiles, objFile lnkname = Replace(objArgs(0),"\","\\") strComputer = "." Set objWMIService = GetObject _ ("winmgmts:\\" & strComputer & "\root\cimv2") Set colFiles = objWMIService.ExecQuery _ ("Select * From Win32_ShortcutFile WHERE Name = " & "'" & lnkname & "'") For Each objFile in colFiles WshShell.Run ("explorer /n, /select," & objFile.Target) Next End Sub '========================================================================== 'Uninstallation: Save the following code as REG 'REGEDIT4 ' 　 [ Last edited by baomaboy on 2008-3-25 at 01:04 AM ]

Floor4　baomaboy	Posted 2007-04-11 06:25
银牌会员　Posts 554　Credits 1,513
There is another one. Hey, it's similar to the code on the second floor. I won't post it. [ Last edited by baomaboy on 2007-4-11 at 06:27 AM ]

Floor5　everest79	Posted 2007-04-11 06:30
金牌会员　Posts 1,127　Credits 2,564
Is using this line simpler? explorer /select,%1

Floor6　baomaboy	Posted 2007-04-11 11:55
银牌会员　Posts 554　Credits 1,513
Originally posted by everest79 at 2007-4-11 06:30: Is this line simpler? explorer /select,%1 everest79 may not have looked carefully. What needs to be opened is not the directory where the LNK is located, but the directory pointed to by the LNK. Picture Thunder.lnk, you opened the desktop, I opened C:\Program Files\Thunder And I don't feel that the code is complicated. For example, the code on the third floor, the main idea is also like brother, just one line of explorer /select,%1 But the person who wrote the code did it for use rather than to tell a technology or trick, so there are those seemingly complicated and useless codes. Because he didn't want to change the registry to implement installation again, and to pass the obtained path parameters. In short, the seemingly useless code is piled up. This is my guess about the original author's thoughts. I think he should also understand that the line explorer /select,%1 is simpler... [ Last edited by baomaboy on 2007-4-11 at 12:39 PM ]

Floor7　everest79	Posted 2007-04-11 15:11
金牌会员　Posts 1,127　Credits 2,564
I misread it.

Floor8　zh159	Posted 2007-04-11 16:24
金牌会员　Posts 1,467　Credits 3,687
May I ask baomaboy if it's possible to use VBS to obtain the image resolution and size (jpg, gif, bmp) (script)

Floor9　kich	Posted 2007-04-12 22:23
中级用户　Posts 168　Credits 397
I want to ask here: Folder = """" & FSO.GetParentFolderName(Scut.TargetPath) & """" WshSHell.Run(Folder) Then the quotes, is it okay to use any number of them? Or do they need to appear in even numbers?? How many do I need so that the program doesn't report an error?? Thx

Floor10　baomaboy	Posted 2007-04-13 07:47
银牌会员　Posts 554　Credits 1,513
Originally posted by zh159 at 2007-4-11 16:24: May I ask, can baomaboy use VBS to obtain the image resolution and size (jpg, gif, bmp) (script) Currently, only the file size can be obtained using fso.size. As for the resolution.... If I find out later, I will definitely add it later ^_^.

Floor11　baomaboy	Posted 2007-04-13 07:58
银牌会员　Posts 554　Credits 1,513
Originally posted by kich at 2007-4-12 22:23: I want to ask here: Folder = """" & FSO.GetParentFolderName(Scut.TargetPath) & """" WshSHell.Run(Folder) Are those quotes, just any few are okay... Not just any, and not an even number, but follow the rules. In VBS, if the " symbol really needs to appear in the string, use two " symbols to represent it. As long as this rule is followed, it's okay. For example, Folder = """" The " symbols at both ends of the "" just indicate that the middle is a string value. The two " in the middle are the main body (one "), that is, Folder = " [ Last edited by baomaboy on 2007-4-13 at 07:59 AM ]

Floor12　3742668	Posted 2007-04-13 08:34
荣誉版主　Posts 718　Credits 2,013
Found a method using WMI... Using the powerful Shell.Application can also achieve: Dim arrFile Dim oFile,oDir,oShell,oLink arrFile = MyGetFile() Set oShell = CreateObject("Shell.Application") Set oDir = oShell.NameSpace(arrFile(1) + "\") Set oFile = oDir.ParseName(arrFile(0)) Set oLink = oFile.GetLink WScript.Echo oLink.WorkingDirectory & "\" Set oFile = Nothing Set oDir = Nothing Set oShell = Nothing '********************************************************************************* 'Get the file to operate, return an array containing the file name and path '********************************************************************************* Function MyGetFile() On Error Resume Next Dim strFile,objFso,objFile If WScript.Arguments.Count < 1 Then Set objDialog = CreateObject("UserAccounts.CommonDialog") objDialog.Filter = "Lnk file\|.lnk" objDialog.ShowOpen strFile = objDialog.FileName Set objDialog = Nothing Else strFile = WScript.Arguments(0) end if Set objFso = CreateObject("Scripting.FileSystemObject") Set objFile = objFso.GetFile(strFile) If Err Then If Err.Number = 5 Then WScript.Quit WScript.Echo Err.Description Err.Clear WScript.Quit Else MyGetFile = Array(objFile.Name,objFile.ParentFolder) End If Set objFile = Nothing Set objFso = Nothing End Function The limitation of this method is that it simply reads the path at the "start position". If you want to get the directory name more reliably, you can use oLink.Path to get the source file, and then separate the directory. In addition, you can also use Adodb.Stream to read the binary stream to get the information you need. (The code is omitted, you just need to know that the format of Lnk can easily write the corresponding code. If needed, you can refer to the famous <The_Windows_Shortcut_File_Format.pdf>) Attachments* The_Windows_Shortcut_File_Format.pdf (43.98 KiB)

Floor13　3742668	Posted 2007-04-13 08:44
荣誉版主　Posts 718　Credits 2,013
Originally posted by zh159 at 2007-4-11 16:24: May I ask, can baomaboy use VBS to obtain the image resolution and size (jpg, gif, bmp) (script) Method 1, using the LoadPicture function: Dim sFile,str sFile = "a.bmp" Set oPicture = LoadPicture(sFile) str = "File:" & vbTab & sFile & vbCrLf str = str & "Width:" & vbTab & Fix(oPicture.Width / 26.458) & vbCrLf str = str & "Height:" & vbTab & Fix(oPicture.Height / 26.458) Set oPicture = Nothing WScript.Echo str Method 2, using the powerful Shell.Application component: Dim arrFile Dim oFile,oDir,oShell arrFile = MyGetFile() Set oShell = CreateObject("Shell.Application") Set oDir = oShell.NameSpace(arrFile(1) + "\") Set oFile = oDir.ParseName(arrFile(0)) WScript.Echo oDir.GetDetailsOf(oFile,-1) Set oFile = Nothing Set oDir = Nothing Set oShell = Nothing '********************************************************************************* 'Get the file to operate, return an array containing the file name and path '********************************************************************************* Function MyGetFile() On Error Resume Next Dim strFile,objFso,objFile If WScript.Arguments.Count < 1 Then Set objDialog = CreateObject("UserAccounts.CommonDialog") objDialog.Filter = "bmp file\|.bmp\|jpg file\|.jpg\|ico file\|.ico\|all files\|." objDialog.ShowOpen strFile = objDialog.FileName Set objDialog = Nothing Else strFile = WScript.Arguments(0) end if Set objFso = CreateObject("Scripting.FileSystemObject") Set objFile = objFso.GetFile(strFile) If Err Then If Err.Number = 5 Then WScript.Quit WScript.Echo Err.Description Err.Clear WScript.Quit Else MyGetFile = Array(objFile.Name,objFile.ParentFolder) End If Set objFile = Nothing Set objFso = Nothing End Function Method 3, using Adodb.Stream to read the binary stream for analysis: Dim sFile,str Dim oStream Dim bWidth,bHeight sFile = "a.bmp" Set oStream = CreateObject("Adodb.Stream") With oStream .Type = 1 .Open .LoadFromFile sFile End With 'If it is BMP format, then Position=18, read 4 bytes; 'If it is gif format, then it is Position=6, read 2 bytes; 'If it is png format, then Position=16, read 4 bytes oStream.Position = 18 bWidth = oStream.Read(4) bHeight = oStream.Read(4) oStream.Close str = "File:" & vbTab & sFile & vbCrLf str = str & "Width:" & vbTab & Bin2Num(bWidth) & vbCrLf str = str & "Height:" & vbTab & Bin2Num(bHeight) Set oStream = Nothing WScript.Echo str 'Convert binary stream to value Private Function Bin2Num(binStr) Dim i,numLen numLen = Lenb(binStr) For i = numLen To 1 Step -1 Bin2Num = Bin2Num 256 + Ascb(Midb(binStr,i,1)) Next End Function Method one is undoubtedly the simplest, but the information that can be obtained is also the least. Method two is relatively moderate. Compared with method one, more information can be obtained, and the interactivity is relatively stronger. Method three should be the most flexible. The disadvantage is that various formats of images need to be processed separately, which requires more understanding of various formats.

Floor14　baomaboy	Posted 2007-04-13 08:46
银牌会员　Posts 554　Credits 1,513
The code and the book have both been collected. Thanks. I wonder if the book contains the LNK format of Office (non-self-built LNK). The path bar in its properties has no available information and is in a grayed-out and unavailable state.

Floor15　baomaboy	Posted 2007-04-13 08:49
银牌会员　Posts 554　Credits 1,513
Originally posted by 3742668 at 2007-4-13 08:44: Method 1, using the LoadPicture function: Dim sFile,str sFile = "a.bmp" Set oPicture = LoadPicture(sFile) str = "File:" & vbTab & sFile & vbCr ... Wonderful!