|
baomaboy
银牌会员
积分 1513
发帖 554
注册 2005-12-30
状态 离线
|
|
 2007-3-18 04:05 |
|
|
baomaboy
银牌会员
积分 1513
发帖 554
注册 2005-12-30
状态 离线
|
『第
2 楼』:
| Quote: | 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="玲珑科技"
QQ="QQ:25926183"
Email="Email:fty1995@163.com"
InsTitle="迅速打开快捷方式所在目录"
InsAnswer="打开目标文件夹"
RegPath0="HKEY_CLASSES_ROOT\lnkfile\shell\"
RegValue0="open"
RegForm0="REG_SZ"
RegPath1="HKEY_CLASSES_ROOT\lnkfile\shell\Open Folder\"
RegValue1="打开目标文件夹"
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("【是】将“"+ InsAnswer +"”加入到快捷方式右键菜单，"&Chr(10)&Chr(10)&"【否】将“"+ InsAnswer +"”从快捷方式右键菜单删除。 ", vbQuestion + vbYesNoCancel, "安装 - "+ 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 _
"添加脚本文件："+chr(10)+InsFullName+chr(10)+chr(10)+ _
"添加注册表项："+chr(10)+chr(34)+ RegPath1 +chr(34)+chr(10)+ _
chr(10) & CloseTime & " 秒钟后本窗口将自动关闭!" +chr(10)+chr(10)+ _
chr(10) & "Copyright(C) " + Copyright +" " & QQ &" " + Email _
, CloseTime, "安装成功 - "+ InsTitle +" - "+ Copyright, 0 + 64
end if
If intAnswer = vbNo Then
WshSHell.RegDelete RegPath2
WshSHell.RegDelete RegPath1
FSO.DeleteFile InsFullName
WshSHell.popup _
"删除脚本文件："+chr(10)+InsFullName+chr(10)+chr(10)+ _
"删除注册表项："+chr(10)+chr(34)+ RegPath1 +chr(34)+chr(10)+ _
chr(10) & CloseTime & " 秒钟后本窗口将自动关闭!" +chr(10)+chr(10)+ _
chr(10) & "Copyright(C) " + Copyright +" " & QQ &" " + Email _
, CloseTime, "卸载成功 - "+ 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 ]
|
好多菩提树，好多明镜台。本来好多物，好多的尘埃。 |
|
|
2007-4-11 06:20 |
|
|
baomaboy
银牌会员
积分 1513
发帖 554
注册 2005-12-30
状态 离线
|
『第
3 楼』:
搜索到一个利用WMI的
| Quote: | '==========================================================================
'
' NAME: ShowLnkTarget.vbs
'
' AUTHOR: SleepBoy
' DATE : 2006-1-12
'
' COMMENT: 快速显示“快捷方式”中“目标”所在的位置，并把焦点停留在目标上。
'
' 安装说明：1. 放在任意目录中，直接双击脚本，即可完成安装。
' 2. 安装好之后，右键单击快捷方式，会出现一项“显示目标位置”。
' 3. 如果移动了脚本的位置，请再安装一次。
' 4. 脚本名字可以改变。改好之后，请再安装一次。
'
'==========================================================================
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\", "显示目标位置"
WshShell.RegWrite "HKCR\lnkfile\shell\ShowLnkTarget\command\", _
QM & WScript.FullName & QM & " " & _
QM & WScript.ScriptFullName & QM & " " & _
QM & "%1" & QM
MsgBox "安装完毕！",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
'==========================================================================
'卸载：下列代码保存为REG
'REGEDIT4
' |
|
[ Last edited by baomaboy on 2008-3-25 at 01:04 AM ]
|
好多菩提树，好多明镜台。本来好多物，好多的尘埃。 |
|
|
2007-4-11 06:22 |
|
|
baomaboy
银牌会员
积分 1513
发帖 554
注册 2005-12-30
状态 离线
|
|
|
2007-4-11 06:25 |
|
|
everest79
金牌会员
一叶枝头，万树皆春
积分 2564
发帖 1127
注册 2006-12-25
状态 离线
|
『第
5 楼』:
用这一行不是更简单？explorer /select,%1
|
|
|
2007-4-11 06:30 |
|
|
baomaboy
银牌会员
积分 1513
发帖 554
注册 2005-12-30
状态 离线
|
『第
6 楼』:
| Quote: | Originally posted by everest79 at 2007-4-11 06:30:
用这一行不是更简单？ explorer /select,%1 |
|
everest79可能没仔细看吧 要打开的不是 LNK所在的目录 而是LNK指向的目录
图
迅雷.lnk 你打开了桌面 我打开了C:\Program Files\Thunder
并且没感觉代码复杂，如三楼代码 主旨也如兄一样就一句explorer /select,%1
但那个写代码的人是为了使用而不是为了诉说一个技术或技巧，所以才有的那看起来是复杂无用的代码，因为他不想再改注册表实现安装 为了传递取得路径参数 总之那貌似无用的代码就堆砌而成了。
我是这么猜测原作者思想的，我觉得他也应该明白explorer /select,%1一行更简单 。。。。
[ Last edited by baomaboy on 2007-4-11 at 12:39 PM ]
|
好多菩提树，好多明镜台。本来好多物，好多的尘埃。 |
|
|
2007-4-11 11:55 |
|
|
everest79
金牌会员
一叶枝头，万树皆春
积分 2564
发帖 1127
注册 2006-12-25
状态 离线
|
|
|
2007-4-11 15:11 |
|
|
zh159
金牌会员
积分 3687
发帖 1467
注册 2005-8-8
状态 离线
|
『第
8 楼』:
借问 baomaboy 能不能用 VBS 获取图象分辨率、大小（jpg、gif、bmp）（脚本）
|
|
|
2007-4-11 16:24 |
|
|
kich
中级用户
积分 397
发帖 168
注册 2006-10-8
状态 离线
|
『第
9 楼』:
想问一下这里:
Folder = """" & FSO.GetParentFolderName(Scut.TargetPath) & """"
WshSHell.Run(Folder)
那引号,是不是随便几个都OK啊?还是偶数出现呢??
到底要几个,程序不会报错??
Thx
|
|
|
2007-4-12 22:23 |
|
|
baomaboy
银牌会员
积分 1513
发帖 554
注册 2005-12-30
状态 离线
|
『第
10 楼』:
| Quote: | Originally posted by zh159 at 2007-4-11 16:24:
借问 baomaboy 能不能用 VBS 获取图象分辨率、大小（jpg、gif、bmp）（脚本） |
|
目前只能用fso.size 获取文件大小，至于分辩率....以后若查到一定再来补上^_^。
|
好多菩提树，好多明镜台。本来好多物，好多的尘埃。 |
|
|
2007-4-13 07:47 |
|
|
baomaboy
银牌会员
积分 1513
发帖 554
注册 2005-12-30
状态 离线
|
『第
11 楼』:
| Quote: | Originally posted by kich at 2007-4-12 22:23:
想问一下这里:
Folder = """" & FSO.GetParentFolderName(Scut.TargetPath) & """"
WshSHell.Run(Folder)
那引号,是不是随便几个都O ... |
|
不随便，也不是偶数，而是遵循规则，VBS中若字符串中确实需要 " 符号出现，则用两个 " 符号表示，只要遵循此规则就可以了。
如Folder = """" 中两端的 " 符号只是表明中间是字符串值。中间的两个 " 才是主体(一个 " )，即Folder ="
[ Last edited by baomaboy on 2007-4-13 at 07:59 AM ]
|
好多菩提树，好多明镜台。本来好多物，好多的尘埃。 |
|
|
2007-4-13 07:58 |
|
|
3742668
荣誉版主
积分 2013
发帖 718
注册 2006-2-18
状态 离线
|
『第
12 楼』:
利用强大的Shell.Application也可以实现:
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 此方法的局限性在于它只是老实地读取"起始位置"处的路径,如果想更可靠地获得目录名的话可以利用oLink.Path来获得源文件,然后分离出目录。
另外也可以通过Adodb.Stream来读取二进制流来获得所需要的信息。(代码略,只需要知道了Lnk的格式可以很简单地写出对应的代码.有需要的可以参考著名的＜The_Windows_Shortcut_File_Format.pdf＞)
附件
1:  The_Windows_Shortcut_File_Format.pdf (2007-4-13 08:34, 43.98 K, 下载附件所需积分 1 点
,下载次数： 8)
|
|
|
2007-4-13 08:34 |
|
|
3742668
荣誉版主
积分 2013
发帖 718
注册 2006-2-18
状态 离线
|
『第
13 楼』:
| Quote: | Originally posted by zh159 at 2007-4-11 16:24:
借问 baomaboy 能不能用 VBS 获取图象分辨率、大小（jpg、gif、bmp）（脚本） |
|
方法１，利用LoadPicture函数:
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 方法２，利用强大的Shell.Application组件:
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 方法３，利用Adodb.Stream读取二进制流来分析:
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 方法一无疑是最简单的，但是可以获得的信息也是最少的．
方法二比较中庸，相对方法一可以获得的信息比较多，而且可交互性比较强一些．
方法三应该是最灵活的，缺点是需要对各种格式的图片分别处理，这就需要对各种格式比较了解．
|
|
|
2007-4-13 08:44 |
|
|
baomaboy
银牌会员
积分 1513
发帖 554
注册 2005-12-30
状态 离线
|
|
|
2007-4-13 08:46 |
|
|
baomaboy
银牌会员
积分 1513
发帖 554
注册 2005-12-30
状态 离线
|
『第
15 楼』:
| Quote: | Originally posted by 3742668 at 2007-4-13 08:44:
方法１，利用LoadPicture函数:
[code]
Dim sFile,str
sFile = "a.bmp"
Set oPicture = LoadPicture(sFile)
str = "文件:" & vbTab & sFile & vbCr ... |
|
精彩！
|
好多菩提树，好多明镜台。本来好多物，好多的尘埃。 |
|
|
2007-4-13 08:49 |
|
