1. 首頁
  2. 問答
  3. 是否可以使用JavaScript進行HTA的Windows資源管理器搜索？

是否可以使用JavaScript進行HTA的Windows資源管理器搜索？

2014-04-04 55 views
1

這是我一直在努力的代碼，這是行不通的。我希望它執行搜索並查看同一目錄中名爲「info」的文件夾。是否可以使用JavaScript進行HTA的Windows資源管理器搜索？

<html> 
<head> 
<title>Application Executer</title> 
<HTA:APPLICATION ID="oMyApp" 
    APPLICATIONNAME="Application Executer" 
    WINDOWSTATE="normal"> 
<script type="text/javascript" language="javascript"> 
    function RunFile() { 
    WshShell = new ActiveXObject("WScript.Shell"); 
    WshShell.Run("explorer.exe search-ms://query=somethinginapdf", 1, false); 
    } 
</script> 
</head> 
<body> 
<input type="button" value="Windows Search" onclick="RunFile();"/> 
</body> 
</html>

來源

2014-04-04 user3496614

回答

0

雖然它不完全符合您的要求，但根據您的需求，它可能會給您一個可用的結果。

繼續並查看cfg參數格式的代碼。

var fileFinder = function (cfg) { 
"use strict"; 
var debugMessages = false, 
    found = {}; 

function FileFinderException(value) { 
    var that = this; 
    this.value = value; 
    this.message = "fileFinder config error"; 
    this.toString = function() { 
     return [that.value, that.message].join(" "); 
    }; 
} 


if (cfg.Folder === undefined) { 
    throw new FileFinderException("Path Undefined"); 
} 

if (cfg.filePattern === undefined) { 
    cfg.filePattern = ".*"; 
} 

if (cfg.dirPattern === undefined) { 
    cfg.dirPattern = ".*"; 
} 

if (cfg.directorySeparator === undefined) { 
    cfg.directorySeparator = "\\"; 
} 

cfg.includeFiles = !!cfg.includeFiles; 
cfg.includeFolders = !!cfg.includeFolders; 


found.messages = []; 
found.files = cfg.includeFiles ? [] : null; 
found.folders = cfg.includeFolders ? [] : null; 

function walkDirectoryTree(folder, folder_name) { 
    var subfolders = folder.SubFolders, 
     en, 
     subfolder; 

    function walkDirectoryFilter(items, re_pattern, list) { 
     var e = new Enumerator(items), 
      item; 
     while (!e.atEnd()) { 
      item = e.item(); 
      if (item.name.match(re_pattern)) { 
       if (debugMessages) { 
        found.messages.push(item.name); 
       } 
       if (list) { 
        list.push(folder_name + cfg.directorySeparator + item.name); 
       } 
      } 
      e.moveNext(); 
     } 
    } 


    if (debugMessages) { 
     found.messages.push("Files in " + folder_name + " matching '" + cfg.filePattern + "':"); 
    } 
    walkDirectoryFilter(folder.files, cfg.filePattern, found.files); 

    if (debugMessages) { 
     found.messages.push("Folders in " + folder_name + " matching '" + cfg.dirPattern + "':"); 
    } 
    walkDirectoryFilter(subfolders, cfg.dirPattern, found.folders); 

    en = new Enumerator(subfolders); 
    while (!en.atEnd()) { 
     subfolder = en.item(); 
     walkDirectoryTree(subfolder, folder_name + cfg.directorySeparator + subfolder.name); 
     en.moveNext(); 
    } 
}

來源

2014-04-04 08:23:25

0 
<html> 
<head> 
<title>Application Executer</title> 
<HTA:APPLICATION ID="oMyApp" 
    APPLICATIONNAME="Application Executer" 
    WINDOWSTATE="normal"> 
<script type="text/javascript" language="javascript"> 
    function RunFile() { 
    WshShell = new ActiveXObject("WScript.Shell"); 
    WshShell.Run("explorer.exe \"search-ms://query=something\"", 1, false); 
    } 
</script> 
</head> 
<body> 
<input type="button" value="Windows Search" onclick="RunFile();"/> 
</body> 
</html>

來源

2014-04-08 16:31:27 user3496614

1

給它這樣的VBScript一試：

'********************************************************************************** 
'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 
'**********************************************************************************************

來源

2014-04-22 22:43:46 Hackoo

相關問題

 相關問題