Union site: www.cn-dos.net Forum site: www.cn-dos.net/forum
DOS stands for freedom, openness and progress. Let us work hard, learn from the openness and GNU spirit of FreeDOS and Linux, and together build and grow a free GNU GPL world!
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)
'==========================================================================
'
' 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
'
Originally posted by everest79 at 2007-4-11 06:30:
Is this line simpler? explorer /select,%1
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)
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...
Found a method using WMI...
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_Windows_Shortcut_File_Format.pdf (43.98 KiB, Credits to download 1 pts, Downloads: 8)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)
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
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
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 FunctionOriginally 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 ...