1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54
| Option Explicit
Dim ws,fso,Srcimage,Temp,PathOutPutHTML,fhta,stRep,stFichier,oShell,oFolder,oFichier,Dimensions,W,H
Set ws = CreateObject("wscript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
Temp = WS.ExpandEnvironmentStrings("%Temp%")
PathOutPutHTML = Temp & "\image.hta"
Set fhta = fso.OpenTextFile(PathOutPutHTML,2,True)
stRep="E:\HackooTest"
stFichier ="MDR.gif"
Set oShell = CreateObject("Shell.Application")
Set oFolder = oShell.Namespace(stRep)
Set oFichier = oFolder.Items.Item(stFichier)
Dimensions = oFolder.GetDetailsOf(oFichier,31)
Dimensions = Split(Dimensions,"x")
W = Trim(Dimensions(0))
H = Trim(Dimensions(1))
msgbox "Largeur de l'image est " & W
msgbox "La hauteur de l'image est " & H
Srcimage = stRep & "\" & stFichier
Call LoadImage(Srcimage,W,H)
ws.run "mshta.exe " & PathOutPutHTML
'********************************************************************************************************
Sub LoadImage(Srcimage,W,H)
fhta.WriteLine "<html>"
fhta.WriteLine " <hta:application id=""oHTA"" "
fhta.WriteLine " border=""none"" "
fhta.WriteLine " caption=""no"" "
fhta.WriteLine " contextmenu=""no"" "
fhta.WriteLine " innerborder=""no"" "
fhta.WriteLine " scroll=""no"" "
fhta.WriteLine " showintaskbar=""no"" "
fhta.WriteLine " />"
fhta.WriteLine "<style>"
fhta.WriteLine "{ margin: 0; padding: 0; }"
fhta.WriteLine "body {background: url(" & DblQuote(Srcimage) & ") no-repeat center center fixed;}"
fhta.WriteLine "</style>"
fhta.WriteLine " <script language=""VBScript"">"
fhta.WriteLine " Sub Window_OnLoad()"
fhta.WriteLine " width = "& W &" "
fhta.WriteLine " height = "& H &" "
fhta.WriteLine " window.resizeTo width, height"
fhta.WriteLine " window.moveTo screen.availWidth\2 - width\2, screen.availHeight\2 - height\2"
fhta.WriteLine " idTimer = window.setTimeout(""vbscript:window.close"",10000)"
fhta.WriteLine " End Sub"
fhta.WriteLine " </script>"
fhta.WriteLine "<body>"
fhta.WriteLine "</body>"
fhta.WriteLine "</html>"
End Sub
'**********************************************************************************************
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'********************************************************************************************** |
Partager