Waiting Bar in HTA and CSS

Question

I got a little code to simulate a waiting bar that uses HTML and CSS, so I had the idea to add in a HTA to generate after dynamically with a vbscript. If any of you can give

Answer 1

I solved my problem like this example in Vbscript that generate the Waiting bar in HTA :

'Détermination de l'itinéraire vers les URL(s) saisi par l'utilisateur dans l'InputBox avec la commande DOS "Tracert" animé par une barre de progression
'Date de Création le 06/09/2013 © Hackoo
'Mise à jour le 04/05/2014 : Ajout d'un message d'attente animé par la balise 
'*********************************Déclaration des variables globales*******************************
Option Explicit
Dim oExec,fso,ws,Temp,Voice,Copyright,Title
Copyright = " Hackoo © 2014"
Set ws = CreateObject("wscript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject") 
Temp = ws.ExpandEnvironmentStrings("%Temp%")
Set Voice = CreateObject("SAPI.SpVoice")
'**************************************************************************************************
'Appel au programme principal ou on peut intégrer la barre de progression
Call MonProgramme() 
'**************************************************************************************************
Sub MonProgramme()
    Dim Command,Command2,Res,LogFile,StrCommand,Argum,startlog,MsgTitre,Titre,MsgAttente,StartTime,DurationTime
    MsgTitre = "Traceroute d'une URL © Hackoo © 2014"
    StrCommand = "Tracert"
    Argum = InputBox("Taper l'adresse d'une URL pour déterminer son itinéraire avec la commande DOS "& DblQuote("Tracert"),MsgTitre,"www.stackoverflow.com")
    LogFile = StrCommand & "Log.txt"
    If fso.FileExists(LogFile) Then fso.DeleteFile LogFile
    Command = "Cmd /c "& StrCommand & " " & Argum &" >> "&LogFile&""
    Titre = "La traceroute vers "& DblQuote(Argum) &" est en cours..."
    Title = Titre + Copyright
    MsgAttente = Titre
    Call CreateProgressBar(Titre,MsgAttente)'Creation de barre de progression
    Voice.Speak "Please Wait a While !"
    Call LancerProgressBar()'Lancement de la barre de progression
    StartTime = Timer'Début du Compteur Timer
    Res = Ws.Run(Command,0,True)'Exécution de la Commande
    DurationTime = FormatNumber(Timer - StartTime, 0) & " seconds."'La durée de l'exécution du script
    Call Formater(LogFile)'Pour formater et remplacer les caractères spéciaux unicode dans le LogFile
    Call FermerProgressBar()'Fermeture de barre de progression
    Voice.Speak "Process of TraceRoute finished in "& DurationTime &" !"
    ws.popup "La TraceRoute vers "& DblQuote(Argum) &" est terminée dans "& vbcr & DurationTime,"2",MsgTitre,64
    ws.popup Formater(LogFile),"5",MsgTitre,64
    Command2 = "Cmd /c Start "&LogFile&""
    startlog = Ws.Run(Command2,0,False)
End Sub
'****************************************************************************************************
Sub CreateProgressBar(Titre,MsgAttente)
    Dim ws,fso,f,f2,ts,ts2,Ligne,i,fread,LireTout,NbLigneTotal,Temp,PathOutPutHTML,fhta,oExec
    Set ws = CreateObject("wscript.Shell")
    Set fso = CreateObject("Scripting.FileSystemObject")
    Temp = WS.ExpandEnvironmentStrings("%Temp%")
    PathOutPutHTML = Temp & "\Barre.hta"
    Set fhta = fso.OpenTextFile(PathOutPutHTML,2,True)
    fhta.WriteLine ""
    fhta.WriteLine ""
    fhta.WriteLine ""
    fhta.WriteLine ""
    fhta.WriteLine ""
    fhta.WriteLine ""
    fhta.WriteLine "
"
    fhta.WriteLine "" & MsgAttente &""
    fhta.WriteLine "
"
    fhta.WriteLine ""
    fhta.WriteLine ""
    fhta.WriteLine ""
    fhta.WriteLine ""
    fhta.WriteLine ""
    fhta.WriteLine ""
    fhta.WriteLine ""
    fhta.WriteLine "
"
    fhta.WriteLine ""
    fhta.close
End Sub
'**********************************************************************************************
Sub LancerProgressBar()
    Set oExec = Ws.Exec("mshta.exe " & Temp & "\Barre.hta")
End Sub
'**********************************************************************************************
Sub FermerProgressBar()
    oExec.Terminate
End Sub
'**********************************************************************************************
'Fonction pour ajouter les doubles quotes dans une variable
Function DblQuote(Str)
    DblQuote = Chr(34) & Str & Chr(34)
End Function
'**********************************************************************************************
'Fonction pour formater et remplacer les caractères spéciaux unicode dans le LogFile
Function Formater(File)
    Dim fso,fRead,fWrite,Text
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fRead = fso.OpenTextFile(File,1)
    Text = fRead.ReadAll
    fRead.Close
    Set fWrite = fso.OpenTextFile(File,2,True)
    Text = Replace(Text,"‚","é")
    Text = Replace(Text,"ے"," ")
    Text = Replace(Text,"ˆ","ê")
    Text = Replace(Text,"‡","ç")
    Text = Replace(Text,"“","ô")
    Text = Replace(Text,"…","à")
    Text = Replace(Text,"ٹ","è")
    Text = Replace(Text,"ƒ","â")
    Text = Replace(Text,"?"," ")
    fWrite.WriteLine Text
    Formater = Text
End Function
'***********************************************************************************************

    

             

                                                        
            
            

              
                
                0
              
                   
                
               讨论(0)
              
                                                  
              
              

                          
             
       
          
              
                                       

     查看其它2个回答


            
                         

                    



               
            

    发布评论:
    

         
                        
    
    
提交评论 
  
  

                    
                    

                    

                        

                        
                         加载中...
                        
                    
                
          
                              			
        
        
        

          

            
            

              
              

            
    


                                 
              
            
                          
    

        
         

                验证码
                

                  
                
                

                   看不清?
                
              
                                  

                    
   
                 
             
              
提交回复
            
          
        
      
       
      
    
    

          
 
     
 

        
热议问题