中国DOS联盟

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 ]

    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



'***********************************************************************************

'获得要操作的文件,返回一个包含文件名和路径的数组

'***********************************************************************************

Function MyGetFile()



On Error Resume Next

Dim strFile,objFso,objFile

    If WScript.Arguments.Count < 1 Then

        Set objDialog = CreateObject("UserAccounts.CommonDialog")

        objDialog.Filter = "Lnk 文件|*.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

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>)

    Dim sFile,str

    sFile = "a.bmp"

Set oPicture = LoadPicture(sFile)

    str = "文件:" & vbTab & sFile & vbCrLf

    str = str & "宽度:" & vbTab & Fix(oPicture.Width / 26.458) & vbCrLf

    str = str & "高度:" & vbTab & Fix(oPicture.Height / 26.458)

Set oPicture = Nothing

WScript.Echo str

    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



'***********************************************************************************

'获得要操作的文件,返回一个包含文件名和路径的数组

'***********************************************************************************

Function MyGetFile()



On Error Resume Next

Dim strFile,objFso,objFile

    If WScript.Arguments.Count < 1 Then

        Set objDialog = CreateObject("UserAccounts.CommonDialog")

        objDialog.Filter = "bmp 文件|*.bmp|jpg 文件|*.jpg|ico 文件|*.ico|所有 文件|*.*"

        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

    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



'如果是BMP格式，则Position=18，读4字节；

'如果是gif格式，则为Position=6，读2字节；

'如果是png格式，则Position=16，读4字节

    oStream.Position = 18

    bWidth = oStream.Read(4)

    bHeight = oStream.Read(4)

    oStream.Close

    

    str = "文件:" & vbTab & sFile & vbCrLf

    str = str & "宽度:" & vbTab & Bin2Num(bWidth) & vbCrLf

    str = str & "高度:" & vbTab & Bin2Num(bHeight)

Set oStream = Nothing

WScript.Echo str



'二进制流转换为数值

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

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!