Est-il possible de faire un HTA (application html) qui peut rechercher un texte

Question

Je devais faire une boîte de recherche html avec un boutonclick que sur un clic il va chercher la phrase donnée dans les fichiers .txt (s) et les montrer? Si oui, comment et est-il possible d'en faire un qui fonctionne avec une entrée en temps réel? (Changer l'entrée recherchée automatiquement dès que quelque chose change dans l'entrée) merci.

Answer 1

Vous souhaitez créer une application Web? Votre question est indéfinie Vous ne pouvez pas faire une telle chose en utilisant HTML (HyperText Markup Language), ce n'est pas un langage de programmation. La chose que vous faites en HTML est un box/text field dans lequel vous tapez.

Et en passant, vous avez déjà une telle fonction dans tous les navigateurs, cliquez sur "CTRL+F" sur n'importe quelle page, et tapez quelque chose, cela fonctionne en temps réel en utilisant l'entrée.

Answer 2

Voici une façon peu efficace de le faire. Cela devrait fonctionner si la taille de votre fichier est assez petite. Je ne sais pas si c'est ce que vous voulez.

Set fso = CreateObject("Scripting.FileSystemObject") 
Set f = fso.OpenTextFile(filePath, 1) 
Do While f.AtEndOfStream <> True 
thisLine = f.ReadLine 
If InStr(thisLine, searchWord) then 
    MsgBox "Found: " & thisLine 
    Exit Do 
End If 
Loop 
f.Close 

Answer 3

Ceci est un vbscript du code d'origine: http://jacxl.free.fr/cours_xl/vbs/moteur_rech.vbs

juste, mettre à jour certaines fonctionnalités sur elle comme:

1. Ajout d'une fonction de la fonction BrowseForFolder pour le rendre plus convivial et facile à gérer le script.

2. Le résultat de la recherche est un type de fichier HTA au lieu d'un type de fichier HTML créé dans le dossier temporaire.
3. Ajouté Explorer() fonction intégré dans HTML pour explorer chaque partage de fichiers dans l'Explorateur Windows.
4. Ajout de Fonction HtmlEscape().
5. En ajoutant une barre d'attente dans HTA lors de la recherche d'utilisateurs attendent.

Search_engine.vbs

'********************************************************************************** 
'Description du script VBS : Rechercher dans le contenu des fichiers de type texte 
'********************************************************************************** 
'En balayant les fichiers de type "fichiers texte" (fichiers ".txt",".htm",".asp",".php",".rtf",".html",".htm",".hta",".xml",".csv",".vbs" etc...), 
'de les ouvrir les uns après les autres pour en extraire la portion de texte contenant le mot recherché. 
'Le petit moteur peut toutefois rendre service pour explorer (en local) de petits sites Intranet (sans indexation préalable des pages). 
'Code Original ==> http://jacxl.free.fr/cours_xl/vbs/moteur_rech.vbs 
'*************************************************************************************************************************************************************** 
'- Mise à jour par Hackoo en 19/12/2013 
'- Ajout d'une fonction pour parcourir le dossier à traiter par la fonction BrowseForFolder afin de rendre le script plus convivial et facile à manipuler 
'- le résultat de la recherche est dans un fichier de type HTA au lieu dans un fichier de type HTML crée dans le dossier temporaire 
'- Ajout de la fonction Explore() intégré dans le HTA pour explorer chaque fichier à part dans l'explorateur Windows 
'- Ajout de la fonction HtmlEscape() 
'*************************************************************************************************************************************************************** 
'- Mise à jour par Hackoo en 07/03/2014 
'- Ajout d'une barre d'attente en HTA lors de la recherche pour faire patienter l'utilisateur 
'*************************************************************************************************************************************************************** 
On Error Resume Next 
Dim ws,Titre,MsgTitre,MsgAttente,oExec,Temp,Copyright,Size 
dim tabl() 
dim tablold() 
redim tabl(1) 
tabl(0)="jetpack" 
num=1 
nbtot=0 
nboct=0 
nbssrep=0 
Copyright = "(Version modifié © Hackoo)" 
Titre = "Recherche dans le contenu des fichiers de type texte " & Copyright 
Set fs = CreateObject("Scripting.FileSystemObject") 
Set ws = CreateObject("wscript.Shell") 
Temp = ws.ExpandEnvironmentStrings("%Temp%") 
'choix du répertoire 
nomrep = Parcourir_Dossier() 
'choix du mot recherché 
mot_cherch=inputbox("Taper le mot pour effectuer la recherche ?",Titre,"Wscript") 
MsgTitre = "Recherche dans le contenu des fichiers de type texte " & Copyright 
MsgAttente = "Veuillez patienter.la recherche du mot <FONT COLOR='yellow'><B>" & DblQuote(mot_cherch) & "</B></FONT> est en cours..." 
If mot_cherch = "" Then WScript.Quit 

'traiter le cas où nomrep est un disque ou un nom non valide 
'if not fs.folderexists(nomrep) then 'or ucase(fs.getdrivename(nomrep))=ucase(replace(nomrep,"\","")) then 
' MsgBox "nom de répertoire non valide" 
' wscript.quit 
'end if 
tabl(1)=nomrep 

'créer le fichier texte et l'ouvrir en appending 
Dim tempFolder : Set tempFolder = fs.GetSpecialFolder(2) 
Dim tempfile : tempFile = tempFolder & "\liste_fichiers.hta" 
'msgbox tempFile 
fichresult = tempFile 
Set nouv_fich = fs.OpenTextFile(fichresult,2,true,-1) 
nouv_fich.close 
Set nouv_fich = fs.OpenTextFile(fichresult,8,false,-1) 
Call CreateProgressBar(MsgTitre,MsgAttente)'Creation de barre de progression 
Call LancerProgressBar()'Lancement de la barre de progression 
StartTime = Timer 'Debut du Compteur Timer 
nouv_fich.writeline("<html><title>"&Titre&"</title><HTA:APPLICATION SCROLL=""yes"" WINDOWSTATE=""Maximize""icon=""verifier.exe"">"&_ 
"<meta content=""text/html; charset=UTF-8"" http-equiv=""content-type"">"&_ 
"<body text=white bgcolor=#1234568><style type='text/css'>"&_ 
"a:link {color: #F19105;}"&_ 
"a:visited {color: #F19105;}"&_ 
"a:active {color: #F19105;}"&_ 
"a:hover {color: #FF9900;background-color: rgb(255, 255, 255);}"&_ 
"</style>") 
nouv_fich.writeline "<SCRIPT LANGUAGE=""VBScript"">" 
nouv_fich.writeline "Function Explore(filename)" 
nouv_fich.writeline "Set ws=CreateObject(""wscript.Shell"")" 
nouv_fich.writeline "ws.run ""Explorer /n,/select,""&filename&""""" 
nouv_fich.writeline "End Function" 
nouv_fich.writeline "</script>" 

'boucler sur les niveaux jusqu'à ce qu'il n'y ait 
'plus de sous répertoires dans le niveau 
do while num>0 '------------------------------------ 

'recopie tabl 
    redim tablold(ubound(tabl)) 
    for n=0 to ubound(tabl) 
     tablold(n)=tabl(n) 
    next 

'réinitialiser tabl 
    redim tabl(0) 
    tabl(0)="zaza" 

'explorer le ss répertoire 
    for n=1 to ubound(tablold) 
     expl(tablold(n)) 'ajoute ds le tableau tabl les ss rep de tablold(n) 
    next 
loop '---------------------------------------------- 

nouv_fich.writeline("</BODY></HTML>") 
nouv_fich.close 
Call FermerProgressBar()'Fermeture de barre de progression 
DurationTime = FormatNumber(Timer - StartTime, 0) & " seconds." 'La duree de l'execution du script 

Set Dossier = fs.getfolder(nomrep) 
SizeKo = Round(FormatNumber(Dossier.Size)/(1024),2) & " Ko" 'Taille en Ko avec 2 chiffres apres la Virgule 
SizeMo = Round(FormatNumber(Dossier.Size)/(1048576),2) & " Mo" 'Taille en Mo avec 2 chiffres apres la Virgule 
SizeGo = Round(FormatNumber(Dossier.Size)/(1073741824),2) & " Go" 'Taille en Go avec 2 chiffres apres la Virgule 

If Dossier.size < 1024 Then 
    Size = Dossier.size & " Octets" 
elseif Dossier.size < 1048576 Then 
    Size = SizeKo 
elseif Dossier.size < 1073741824 Then 
    Size = SizeMo 
else 
    Size = SizeGo 
end If 
set nouv_fich=nothing 
If Err <> 0 Then 
    'MsgBox Err.Number & VbCrLF & Err.Description,16,MsgTitre 
    On Error GoTo 0 
End if 
'nboct2= int(fs.getfolder(nomrep).size/1024/1024) 
set fs=nothing 
'afficher le résultat dans un Popup 
Ws.Popup "La recherche est terminée en "& DurationTime & " !"& vbCr &_ 
"Recherche effectuée dans " & vbCrLF & nbtot & " fichiers pour " & Size & " dans " & DblQuote(nomrep) &_ 
" et ses " & nbssrep & " sous-répertoires (total " & Size & ")","6",MsgTitre,64 

Set sh = CreateObject("WScript.Shell") 
sh.run "explorer " & fichresult 
set sh=nothing 
'************************************************************************* 
Function Parcourir_Dossier() 
    Set objShell = CreateObject("Shell.Application") 
    Set objFolder = objShell.BrowseForFolder(0, "Veuillez choisir un dossier pour la recherche " & Copyright,1,"c:\Programs") 
    If objFolder Is Nothing Then 
     Wscript.Quit 
    End If 
    NomDossier = objFolder.title 
    Parcourir_Dossier = objFolder.self.path 
end Function 
'************************************************************************* 
sub expl(nomfich) 
'ajoute dans le tableau tabl() tous les sous répertoires de nomfich 
'et ajoute dans le fichier nouv_fich les noms des fichiers et leurs caractéristiques 

    Set rep=fs.getFolder(nomfich) 
    num=ubound(tabl) 
'parcourir les sous répertoires de nomfich 
    for each ssrep in rep.subfolders 
     num=num+1 
     redim preserve tabl(num) 
     tabl(num)= ssrep.path 
     nbssrep=nbssrep+1 
    next 
'parcourir les fichiers de nomfich 
    for each fich in rep.files 
     nbtot=nbtot+1 
     nboct=nboct+fich.size 
'********************************************************************************************************************************************************************************************** 
'chercher dans le fichier (vous pouvez commenter cette ligne si vous voulez juste afficher les fichiers qui contient seulement le mot à rechercher) 
'nouv_fich.writeline fich.path & "<br><FONT COLOR=""yellow""><B>(" & int(fich.size/1024) & " ko, cr&eacute;&eacute; " & fich.DateCreated & ", acc " & fich.DateLastAccessed & ")</B></FONT><br>" 
'********************************************************************************************************************************************************************************************** 
     Dim Ext 
'ici dans ce tableau vous pouvez ajouter d'autres extensions de type texte 
     Ext = Array(".txt",".asp",".php",".rtf",".html",".htm",".hta",".xml",".csv",".vbs",".js",".css",".ini",".inf") 
     For i=LBound(Ext) To UBound(Ext) 
      if instr(lcase(fich.name),Ext(i)) > 0 Then 
       Set fich_sce = fs.OpenTextFile(fich.path,1,false,-2) 
       txtlu=fich_sce.readall 
       txtlu = HtmlEscape(txtlu) 
       fich_sce.close 
'txtlu=tt(txtlu) 
       pos=instr(lcase(txtlu),lcase(mot_cherch)) 
       if pos>0 then 
        nouv_fich.writeline ("<HR><A href=""#"" OnClick='Explore("""& fich.Path & """)'>" & fich.Path & "</A>") 
        do while pos>0 
         nbav=50 
         if pos-1<nbav then nbav=pos-1 
         nbapr=50 
         if len(txtlu)-pos-len(mot_cherch)+1<nbapr then nbapr=len(txtlu)-pos-len(mot_cherch)+1 
         txx= tt(mid(txtlu,pos-nbav,nbav)) & "<FONT COLOR='Yellow'><B>" & tt(mid(txtlu,pos,len(mot_cherch))) & "</B></FONT>" & mid(txtlu,pos+len(mot_cherch),nbapr) 
         if nbav=50 then txx="..." & txx 
         if nbapr=50 then txx=txx & "..." 
         txx="<BR>&nbsp;&nbsp;&nbsp;" & txx 
         nouv_fich.writeline txx 
         txtlu=right(txtlu,len(txtlu)-pos+1-len(mot_cherch)) 
         pos=instr(lcase(txtlu),lcase(mot_cherch)) 
        loop 
       end if 
      end if 
     next 
    next 
    set rep=nothing 
end sub 
'************************************************************************* 
function tt(txte) 
    tt=txte 
    tt=replace(tt,"<","&lt;") 
    tt=replace(tt,">","&gt;") 
end function 
'************************************************************************* 
Function HtmlEscape(strRawData) 
'http://alexandre.alapetite.fr/doc-alex/alx_special.html 
    Dim strHtmlEscape 
    strHtmlEscape = strRawData 
    strHtmlEscape = Replace(strHtmlEscape, "&", "&amp;") 
    strHtmlEscape = Replace(strHtmlEscape, "<", "&lt;") 
    strHtmlEscape = Replace(strHtmlEscape, ">", "&gt;") 
    strHtmlEscape = Replace(strHtmlEscape, """", "&quot;") 
    strHtmlEscape = Replace(strHtmlEscape, "à", "&agrave;") 
    strHtmlEscape = Replace(strHtmlEscape, "è", "&egrave;") 
    strHtmlEscape = Replace(strHtmlEscape, "é", "&eacute;") 
    strHtmlEscape = Replace(strHtmlEscape, "©", "&copy;") 
    strHtmlEscape = Replace(strHtmlEscape, "ê", "&ecirc;") 
'strHtmlEscape = Replace(strHtmlEscape, vbCrLf, "<br>") 
'strHtmlEscape = Replace(strHtmlEscape, vbCr, "<br>") 
'strHtmlEscape = Replace(strHtmlEscape, vbLf, "<br>") 
'strHtmlEscape = Replace(strHtmlEscape, vbTab, "&nbsp;&nbsp;&nbsp;&nbsp;") 
'strHtmlEscape = Replace(strHtmlEscape, " ", "&nbsp;&nbsp;") 
    HtmlEscape = strHtmlEscape 
End Function 
'**************************************************************************************************** 
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 "<HTML>" 
    fhta.WriteLine "<HEAD>" 
    fhta.WriteLine "<Title> " & Titre & "</Title>" 
    fhta.WriteLine "<HTA:APPLICATION" 
    fhta.WriteLine "ICON = ""magnify.exe"" " 
    fhta.WriteLine "BORDER=""THIN"" " 
    fhta.WriteLine "INNERBORDER=""NO"" " 
    fhta.WriteLine "MAXIMIZEBUTTON=""NO"" " 
    fhta.WriteLine "MINIMIZEBUTTON=""NO"" " 
    fhta.WriteLine "SCROLL=""NO"" " 
    fhta.WriteLine "SYSMENU=""NO"" " 
    fhta.WriteLine "SELECTION=""NO"" " 
    fhta.WriteLine "SINGLEINSTANCE=""YES"">" 
    fhta.WriteLine "</HEAD>" 
    fhta.WriteLine "<BODY text=""white""><CENTER><DIV><SPAN ID=""ProgressBar""></SPAN>" 
    fhta.WriteLine "<span><marquee DIRECTION=""LEFT"" SCROLLAMOUNT=""3"" BEHAVIOR=ALTERNATE><font face=""Comic sans MS"">" & MsgAttente &"</font></marquee></span></DIV></CENTER></BODY></HTML>" 
    fhta.WriteLine "<SCRIPT LANGUAGE=""VBScript""> " 
    fhta.WriteLine "Set ws = CreateObject(""wscript.Shell"")" 
    fhta.WriteLine "Temp = WS.ExpandEnvironmentStrings(""%Temp%"")" 
    fhta.WriteLine "Sub window_onload()" 
    fhta.WriteLine " CenterWindow 480,90" 
    fhta.WriteLine " Self.document.bgColor = ""1234568"" " 
    fhta.WriteLine " End Sub" 
    fhta.WriteLine " Sub CenterWindow(x,y)" 
    fhta.WriteLine " Dim iLeft,itop" 
    fhta.WriteLine " window.resizeTo x,y" 
    fhta.WriteLine " iLeft = window.screen.availWidth/2 - x/2" 
    fhta.WriteLine " itop = window.screen.availHeight/2 - y/2" 
    fhta.WriteLine " window.moveTo ileft,itop" 
    fhta.WriteLine "End Sub" 
    fhta.WriteLine "</script>" 
    fhta.close 
End Sub 
'********************************************************************************************** 
Sub LancerProgressBar() 
    Set oExec = Ws.Exec("mshta.exe " & Temp & "\Barre.hta") 
End Sub 
'********************************************************************************************** 
Sub FermerProgressBar() 
    oExec.Terminate 
End Sub 
'********************************************************************************************** 
Function DblQuote(Str) 
    DblQuote = Chr(34) & Str & Chr(34) 
End Function 
'**********************************************************************************************