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 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115
| Option Explicit
Dim oExec,MaTraceRoute,Titre,StartTime,DurationTime,MonSite
Titre = "Exemple de SplashScreen © Hackoo © 2014"
MonSite = "www.developpez.net"
Dim shell : Set shell = CreateObject("WScript.Shell")
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
Dim TempFolder : Set tempFolder = fso.GetSpecialFolder(2)
Dim SplashName : SplashName = "Splash.hta"
Dim TempFile : Set TempFile = TempFolder.CreateTextFile(SplashName)
MaTraceRoute = TempFolder & "\MaTraceroute.txt"
If fso.FileExists(MaTraceRoute) Then
fso.DeleteFile MaTraceRoute
End if
'**************************************************************************************************
Call CreateSplashScreen()
Call LancerSplashScreen()
StartTime = Timer'Début du Compteur Timer
Call ProgramPrincipal()
DurationTime = FormatNumber(Timer - StartTime, 0) & " seconds."'La durée de l'exécution du script ou de la procédure
Call FermerSplashScreen()
shell.popup "La TraceRoute vers "& DblQuote(MonSite) &" est terminée en "& vbcr & DurationTime,"5",Titre,64
shell.run MaTraceRoute
'**************************************************************************************************
Sub CreateSplashScreen()
tempFile.Writeline "<html>"
tempFile.Writeline "<head>"
tempFile.Writeline "<bgsound src=""http://hackoo.alwaysdata.net/pirates.mp3"" loop=""infinite"">"
tempFile.Writeline "<title>Splash Screen</title>"
tempFile.Writeline "<HTA:APPLICATION ID=""Splash Screen"""
tempFile.Writeline "APPLICATIONNAME=""Splash Screen"""
tempFile.Writeline "BORDER=""none"""
tempFile.Writeline "CAPTION=""no"""
tempFile.Writeline "SHOWINTASKBAR=""no"""
tempFile.Writeline "SINGLEINSTANCE=""yes"""
tempFile.Writeline "SYSMENU=""no"""
tempFile.Writeline "SCROLL=""no"""
tempFile.Writeline "WINDOWSTATE=""normal"">"
tempFile.Writeline "<link rel=""stylesheet"" media=""screen"" type=""text/css"" title=""design_encoder"" href=""http://hackoo.alwaysdata.net/design_encoder.css""/>"
tempFile.Writeline "</head>"
tempFile.Writeline"<SCRIPT LANGUAGE=""VBScript"">"
tempFile.Writeline "Sub CenterWindow(x,y)"
tempFile.Writeline "window.resizeTo x, y"
tempFile.Writeline "iLeft = window.screen.availWidth/2 - x/2"
tempFile.Writeline "itop = window.screen.availHeight/2 - y/2"
tempFile.Writeline "window.moveTo ileft, itop"
tempFile.Writeline "End Sub"
tempFile.Writeline "Sub Window_OnLoad"
tempFile.Writeline "CenterWindow 400,300"
tempFile.Writeline "End Sub"
tempFile.Writeline "Sub ShowSplash"
tempFile.Writeline "Splash.Style.Display = ""None"""
tempFile.Writeline "Window.Close()"
tempFile.Writeline "End Sub"
tempFile.Writeline "</SCRIPT>"
tempFile.Writeline "<body bgcolor=""black"">"
tempFile.Writeline "<DIV id=""Splash"">"
tempFile.Writeline "<CENTER>"
tempFile.Writeline "<p>"
tempFile.Writeline "<img src=""http://nsm05.casimages.com/img/2011/07/23//1107230741401311048506419.gif""/>"
tempFile.Writeline "<center onselectstart=""return false"" ondragstart=""return false"" oncontextmenu=""return false"">"
tempFile.Writeline "<marquee DIRECTION=""UP"" HEIGHT=""200"" WIDTH=""350"" SCROLLAMOUNT=""3"" onselectstart=""return false"">"
tempFile.Writeline "<center><font face=""Comic sans MS"" color=RED size=10><b><i> Exemple de SplashScreen </i></b></font></center><br><br>"
tempFile.Writeline "<center><font face=""Comic sans MS"" color=RED>Exemple de code pour attendre un peu jusqu'à la fin de la procèdure</b></font></center>"
tempFile.Writeline "<br><center><font face=""Comic sans MS"" color=RED>Exemple de code by © Hackoo 2014<br><br></font></center><center><img src=""http://nsm05.casimages.com/img/2011/07/23//1107230741401311048506419.gif""></center></marquee>"
tempFile.Writeline "</center>"
tempFile.Writeline "</p>"
tempFile.Writeline "</CENTER>"
tempFile.Writeline "</DIV>"
tempFile.Writeline "</body>"
tempFile.Writeline "</html>"
tempFile.Writeline "tempFile.Close"
End Sub
'**************************************************************************************************
Function Executer(StrCmd,Console)
Dim ws,MyCmd,Resultat
Set ws = CreateObject("wscript.Shell")
'La valeur 0 pour cacher la console MS-DOS
If Console = 0 Then
MyCmd = "CMD /C " & StrCmd & " "
Resultat = ws.run(MyCmd,Console,True)
If Resultat = 0 Then
'MsgBox "Success"
Else
MsgBox "Une erreur inconnue est survenue !",16,"Une erreur inconnue est survenue !"
End If
End If
'La valeur 1 pour montrer la console MS-DOS
If Console = 1 Then
MyCmd = "CMD /K " & StrCmd & " "
Resultat = ws.run(MyCmd,Console,False)
If Resultat = 0 Then
'MsgBox "Success"
Else
MsgBox "Une erreur inconnue est survenue !",16,"Une erreur inconnue est survenue !"
End If
End If
Executer = Resultat
End Function
'*********************************************************************************************************
Sub ProgramPrincipal()
Call Executer("Tracert " & MonSite & " >> MyTemp.txt & cmd /U /C Type MyTemp.txt >" & MaTraceRoute & " & Del MyTemp.txt",0)
End Sub
'********************************************************************************************************
Sub LancerSplashScreen()
Set oExec = shell.Exec("mshta.exe " & TempFolder & "\" & SplashName)
End Sub
'*********************************************************************************************************
Sub FermerSplashScreen()
oExec.Terminate
End Sub
'*********************************************************************************************************
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'********************************************************************************************************** |
Partager