juste pour le fun un fichier .vbs avec une image et du son.
ouvrez , monté le son je vous assure sa déchire grave
une fois lancer il faut allez au bout de la musique ou vous fermer du gestionnaire des taches
Se fichier es modifiable a volonté
Dans le code qui suis il suffit de changer vos 'En rouge' lien image et musique voila bonne amusement
En dessous du code le lien en rar
et pour ceux qui veule copier coller le code suffit d'enregistré en votre fichier .vbs
Option Explicit
Dim URL,ws,fso,Srcimage,Temp,PathOutPutHTML,fhta,stRep,stFichier,oShell,oFolder,oFichier,Dimensions
Dim arrSize,intLength,intHorizontalSize,intVerticalSize,Tab
URL = "http://chatonhubfrance.dyndns.org/Chatonhub/logo.png"
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 = Temp
Tab = split(url,"/")
stFichier = Tab(UBound(Tab))
Srcimage = stRep & "\" & stFichier
If Not fso.FileExists(Srcimage) Then
Call DownloadingFile(URL,Srcimage)
Set oShell = CreateObject("Shell.Application")
Set oFolder = oShell.Namespace(stRep)
Set oFichier = oFolder.Items.Item(stFichier)
Dimensions = oFolder.GetDetailsOf(oFichier,31)
arrSize = Split(Dimensions,"x")
'***************************************Important à savoir **********************************************
'Instead, we ended up retrieving item 31, which gave us the total dimensions of the picture,
'using an output format similar to this: ?150 x 354?
'http://blogs.technet.com/b/heyscripting ... width.aspx
'Un grand merci à omen999 ==>
'http://www.developpez.net/forums/d15046 ... ost8163406
intLength = Len(arrSize(0))
intHorizontalSize = Right(arrSize(0),intLength -1)
intLength = Len(arrSize(1))
intVerticalSize = Left(arrSize(1),intLength - 1)
'***************************************Important à savoir **********************************************
Call LoadImage(Srcimage,intHorizontalSize,intVerticalSize,Timeout(51))
ws.run "mshta.exe " & PathOutPutHTML
Else
Set oShell = CreateObject("Shell.Application")
Set oFolder = oShell.Namespace(stRep)
Set oFichier = oFolder.Items.Item(stFichier)
Dimensions = oFolder.GetDetailsOf(oFichier,31)
arrSize = Split(Dimensions,"x")
intLength = Len(arrSize(0))
intHorizontalSize = Right(arrSize(0),intLength -1)
intLength = Len(arrSize(1))
intVerticalSize = Left(arrSize(1),intLength - 1)
Call LoadImage(Srcimage,intHorizontalSize,intVerticalSize,Timeout(51))
ws.run "mshta.exe " & PathOutPutHTML
End If
'********************************************************************************************************
Function TimeOut(T)
TimeOut = T * 1000
End Function
'********************************************************************************************************
Sub LoadImage(Srcimage,intHorizontalSize,intVerticalSize,TimeOut)
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 = " & intHorizontalSize
fhta.WriteLine " height = " & intVerticalSize
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"","& TimeOut &")"
fhta.WriteLine " window.setInterval ""setfocus()"",100"
fhta.WriteLine " End Sub"
fhta.WriteLine " Function setfocus"
fhta.WriteLine " Window.Focus()"
fhta.WriteLine " End Function"
fhta.WriteLine " </script>"
fhta.WriteLine "<body>"
fhta.WriteLine "<bgsound src=""http://chatonhubfrance.dyndns.org/Chato ... sBells.mp3"">"
fhta.WriteLine "</body>"
fhta.WriteLine "</html>"
End Sub
'**********************************************************************************************
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'**********************************************************************************************
Sub DownloadingFile(URL,strHDLocation)
Dim Titre,objFSO,Ws,objXMLHTTP,PathScript,Tab,objADOStream,Command,Start,File
Dim MsgTitre,MsgAttente,StartTime,DurationTime,ProtocoleHTTP
Set objFSO = Createobject("Scripting.FileSystemObject")
Set Ws = CreateObject("wscript.Shell")
ProtocoleHTTP = "http://"
If Left(URL,7) <> ProtocoleHTTP Then
URL = ProtocoleHTTP & URL
End if
Tab = split(url,"/")
File = Tab(UBound(Tab))
File = Replace(File,"%20"," ")
File = Replace(File,"%28","(")
File = Replace(File,"%29",")")
Set objXMLHTTP = CreateObject("MSXML2.ServerXMLHTTP.3.0")
strHDLocation = PathScript & "\" & File
On Error Resume Next
objXMLHTTP.open "GET",URL,false
objXMLHTTP.send()
If Err.number <> 0 Then
MsgBox err.description,16,err.description
Exit Sub
Else
If objXMLHTTP.Status = 200 Then
strHDLocation = Temp & "\" & File
Set objADOStream = CreateObject("ADODB.Stream")
objADOStream.Open
objADOStream.Type = 1 'adTypeBinary
objADOStream.Write objXMLHTTP.ResponseBody
objADOStream.Position = 0 'Set the stream position to the start
objADOStream.SaveToFile strHDLocation,2 '2=adSaveCreateOverWrite
objADOStream.Close
Set objADOStream = Nothing
End If
End if
Set objXMLHTTP = Nothing
End Sub
teamaaz.rar
Oubliez pas de mettre du son
Petit clin d’œil au forum