' Открывает на 10 секунд изображение под курсором (jpeg;jpg;gif;bmp)
' можно открывать несколько по очереди
' параметры %P%N
'==================== Изменяемые пути ===================================
FuncPlus = "%COMMANDER_PATH%\Scripts\Include\FunctionsPlus.vbs"
'========================================================================
If WScript.Arguments.Count = 0 Then
MsgBox "Не хватает параметров! Должен прописан Один параметр %P%N",_
vbOKOnly & vbInformation, "Кратковременый просмотр изображений"
WScript.Quit
End If
FuncPlus = CreateObject("WScript.Shell").ExpandEnvironmentStrings(FuncPlus)
strPictFile = WScript.Arguments(0)
Set FSO = CreateObject("Scripting.FileSystemObject")
strArgExt = LCase(FSO.GetExtensionName(strPictFile))
If InStr(";jpeg;jpg;gif;bmp;png;", ";" & strArgExt & ";") = 0 Then WsEnd
If Not FSO.FileExists(strPictFile) Then WsEnd
Execute FSO.OpenTextFile(FuncPlus).ReadAll
Set objShell = CreateObject("Shell.Application")
strArgParent = FSO.GetParentFolderName(strPictFile)
strArgFileName = FSO.GetFileName(strPictFile)
Set objFolder = objShell.NameSpace(strArgParent)
Set objItem = objFolder.ParseName(strArgFileName)
strDimensions = objFolder.GetDetailsOf(objItem, 31) ' размер изображения
If InStr(strDimensions, " x ") > 0 Then
strSize = Replace(strDimensions, " x ", ", ") : strSize = Mid(strSize,2,Len(strSize)-2)
ii = InStr(strSize, ",") : w = Left(strSize, ii - 1) + 20 : h = Mid(strSize, ii + 1) + 20
strSize = w & ", " & h
End If
Text = "<HTML>" & vbNewLine &_
"<HTA:Application" & vbNewLine &_
"Caption=" & Chr(34) & "no" & Chr(34) & vbNewLine &_
"Borderstyle="&Chr(34)&"complex"&Chr(34) & vbNewLine &_
"Scroll=" & Chr(34) & "no" & Chr(34) & ">" & vbNewLine &_
"<SCRIPT Language=" & Chr(34) & "VBScript" & Chr(34) & ">" & vbNewLine &_
"Sub Window_OnLoad" & vbNewLine &_
"Window.resizeTo " & strSize & vbNewLine &_
"idTimer = window.setTimeout(" & Chr(34) & "CloseShop" & Chr(34) &_
", " & CStr(10 * 1000) & ", " & Chr(34) & "VBScript" & Chr(34) & ")" & vbNewLine &_
"End Sub" & vbNewLine &_
"Sub CloseShop" & vbNewLine &_
"window.clearTimeout(idTimer)" & vbNewLine &_
"self.close()" & vbNewLine &_
"End Sub" & vbNewLine &_
"</SCRIPT>" & vbNewLine &_
"<BODY background=" & Chr(34) & strPictFile & Chr(34) & ">" & vbNewLine &_
"</BODY>" & vbNewLine &_
"</HTML>"
strHTAname = FFNoExistCount(FSO.GetSpecialFolder(2) & "\Temp0.hta")
FSO.CreateTextFile strHTAname, True
FSO.GetFile(strHTAname).OpenAsTextStream(2, 0).Write Text
CreateObject("WScript.Shell").Run "mshta.exe " & Chr(34) & strHTAname & Chr(34), 0, True
FSO.DeleteFile strHTAname
Set objFolder = Nothing : Set objItem = Nothing : Set objShell = Nothing : WsEnd
Sub WsEnd : Set FSO = Nothing : WScript.Quit : End Sub |
