help script VBS

help script VBS - VB/VBA/VBS - Programmation

Marsh Posté le 14-03-2014 à 15:27:40    

Bonjour a tous,
 
je vous explique mon problèmes j'essaye de faire un petit moteur de recherche (genre à la windows ) pour rechercher par mot clé et ensuite afficher le pdf qui est lié au mot clé  le problèmes  est que je n'arrive pas a charger le pdf :/
 
 
 

Code :
  1. '**********************************************************************************
  2. 'Description du script VBS : Rechercher dans le contenu des fichiers de type texte
  3. '**********************************************************************************
  4. On Error Resume Next
  5. Dim ws,Titre,MsgTitre,MsgAttente,oExec,Temp,Copyright,Size
  6. dim tabl()
  7. dim tablold()
  8. redim tabl(1)
  9. tabl(0)="jetpack"
  10. num=1
  11. nbtot=0
  12. nboct=0
  13. nbssrep=0
  14. Copyright = "(En3rgizz)"
  15. Titre = "Recherche dans le contenu des fichiers de type texte " & Copyright
  16. Set fs = CreateObject("Scripting.FileSystemObject" )
  17. Set ws = CreateObject("wscript.Shell" )
  18. Temp = ws.ExpandEnvironmentStrings("%Temp%" )
  19. 'choix du répertoire
  20. nomrep = Parcourir_Dossier()
  21. 'choix du mot recherché
  22. mot_cherch=inputbox("Taper le mot pour effectuer la recherche ?",Titre,"Wscript" )
  23. MsgTitre = "Recherche dans le contenu des fichiers de type texte " & Copyright
  24. MsgAttente = "Veuillez patienter.la recherche du mot <FONT COLOR='yellow'><B>" & DblQuote(mot_cherch) & "</B></FONT> est en cours..."
  25. If mot_cherch = "" Then WScript.Quit
  26. 'traiter le cas où nomrep est un disque ou un nom non valide
  27. 'if not fs.folderexists(nomrep) then 'or ucase(fs.getdrivename(nomrep))=ucase(replace(nomrep,"\","" )) then
  28. '    MsgBox "nom de répertoire non valide"
  29. '    wscript.quit
  30. 'end if
  31. tabl(1)=nomrep
  32. 'créer le fichier texte et l'ouvrir en appending
  33. Dim tempFolder : Set tempFolder = fs.GetSpecialFolder(2)
  34. Dim tempfile : tempFile = tempFolder & "\liste_fichiers.hta"
  35. 'msgbox tempFile
  36. fichresult = tempFile
  37. Set nouv_fich = fs.OpenTextFile(fichresult,2,true,-1)
  38. nouv_fich.close
  39. Set nouv_fich = fs.OpenTextFile(fichresult,8,false,-1)
  40. Call CreateProgressBar(MsgTitre,MsgAttente)'Creation de barre de progression
  41. Call LancerProgressBar()'Lancement de la barre de progression
  42. StartTime = Timer 'Debut du Compteur Timer
  43. nouv_fich.writeline("<html><title>"&Titre&"</title><HTA:APPLICATION SCROLL=""yes"" WINDOWSTATE=""Maximize""icon=""verifier.exe"">"&_
  44. "<meta content=""text/html; charset=UTF-8"" http-equiv=""content-type"">"&_
  45. "<body text=white bgcolor=#1234568><style type='text/css'>"&_
  46. "a:link {color: #F19105;}"&_
  47. "a:visited {color: #F19105;}"&_
  48. "a:active {color: #F19105;}"&_
  49. "a:hover {color: #FF9900;background-color: rgb(255, 255, 255);}"&_
  50. "</style>" )
  51. nouv_fich.writeline "<SCRIPT LANGUAGE=""VBScript"">"
  52. nouv_fich.writeline "Function Explore(filename)"
  53. nouv_fich.writeline "Set ws=CreateObject(""wscript.Shell"" )"
  54. nouv_fich.writeline "ws.run ""Explorer /n,/select,""&filename&"""""
  55. nouv_fich.writeline "End Function"
  56. nouv_fich.writeline "</script>"
  57. 'boucler sur les niveaux jusqu'à ce qu'il n'y ait
  58. 'plus de sous répertoires dans le niveau
  59. do while num>0 '------------------------------------
  60. 'recopie tabl
  61. redim tablold(ubound(tabl))
  62. for n=0 to ubound(tabl)
  63.  tablold(n)=tabl(n)
  64. next
  65. 'réinitialiser tabl
  66. redim tabl(0)
  67. tabl(0)="zaza"
  68. 'explorer le ss répertoire
  69. for n=1 to ubound(tablold)
  70.  expl(tablold(n)) 'ajoute ds le tableau tabl les ss rep de tablold(n)
  71. next
  72. loop '----------------------------------------------
  73. nouv_fich.writeline("</BODY></HTML>" )
  74. nouv_fich.close
  75. Call FermerProgressBar()'Fermeture de barre de progression
  76. DurationTime = FormatNumber(Timer - StartTime, 0) & " seconds." 'La duree de l'execution du script
  77. Set Dossier = fs.getfolder(nomrep)
  78. SizeKo = Round(FormatNumber(Dossier.Size)/(1024),2) & " Ko" 'Taille en Ko avec 2 chiffres apres la Virgule
  79. SizeMo = Round(FormatNumber(Dossier.Size)/(1048576),2) & " Mo" 'Taille en Mo avec 2 chiffres apres la Virgule
  80. SizeGo = Round(FormatNumber(Dossier.Size)/(1073741824),2) & " Go" 'Taille en Go avec 2 chiffres apres la Virgule
  81. If Dossier.size < 1024 Then
  82.      Size = Dossier.size & " Octets"
  83. elseif Dossier.size < 1048576 Then
  84.      Size = SizeKo
  85. elseif Dossier.size < 1073741824 Then
  86.      Size = SizeMo
  87. else
  88.      Size = SizeGo
  89. end If
  90. set nouv_fich=nothing
  91. If Err <> 0 Then
  92.      'MsgBox Err.Number & VbCrLF & Err.Description,16,MsgTitre
  93.      On Error GoTo 0
  94. End if
  95. 'nboct2= int(fs.getfolder(nomrep).size/1024/1024)
  96. set fs=nothing
  97. 'afficher le résultat dans un Popup
  98. Ws.Popup "La recherche est terminée en "& DurationTime & " !"& vbCr &_
  99. "Recherche effectuée dans " & vbCrLF & nbtot & " fichiers pour " & Size & " dans " & DblQuote(nomrep) &_
  100. " et ses " & nbssrep & " sous-répertoires (total " & Size & " )","6",MsgTitre,64
  101. Set sh = CreateObject("WScript.Shell" )
  102. sh.run "explorer " & fichresult
  103. set sh=nothing
  104. '*************************************************************************
  105. Function Parcourir_Dossier()
  106. Set objShell = CreateObject("Shell.Application" )
  107. Set objFolder = objShell.BrowseForFolder(0, "Veuillez choisir un dossier pour la recherche " & Copyright,1,"c:\Programs" )
  108. If objFolder Is Nothing Then
  109.  Wscript.Quit
  110. End If
  111. NomDossier = objFolder.title
  112. Parcourir_Dossier = objFolder.self.path
  113. end Function
  114. '*************************************************************************
  115. sub expl(nomfich)
  116. 'ajoute dans le tableau tabl() tous les sous répertoires de nomfich
  117. 'et ajoute dans le fichier nouv_fich les noms des fichiers et leurs caractéristiques
  118. Set rep=fs.getFolder(nomfich)
  119. num=ubound(tabl)
  120. 'parcourir les sous répertoires de nomfich
  121. for each ssrep in rep.subfolders
  122.  num=num+1
  123.  redim preserve tabl(num)
  124.  tabl(num)= ssrep.path
  125.  nbssrep=nbssrep+1
  126. next
  127. 'parcourir les fichiers de nomfich
  128. for each fich in rep.files
  129.  nbtot=nbtot+1
  130.  nboct=nboct+fich.size
  131. '**********************************************************************************************************************************************************************************************
  132. 'chercher dans le fichier (vous pouvez commenter cette ligne si vous voulez juste afficher les fichiers qui contient seulement le mot à rechercher)
  133. '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>"
  134. '**********************************************************************************************************************************************************************************************
  135.  Dim Ext
  136. 'ici dans ce tableau vous pouvez ajouter d'autres extensions de type texte
  137.  Ext = Array(".txt",".asp",".php",".rtf",".html",".htm",".hta",".xml",".csv",".vbs",".js",".css",".ini",".inf" )
  138.  For i=LBound(Ext) To UBound(Ext)
  139.   if instr(lcase(fich.name),Ext(i)) > 0 Then
  140.    Set fich_sce = fs.OpenTextFile(fich.path,1,false,-2)
  141.    txtlu=fich_sce.readall
  142.    txtlu = HtmlEscape(txtlu)
  143.    fich_sce.close
  144. 'txtlu=tt(txtlu)
  145.    pos=instr(lcase(txtlu),lcase(mot_cherch))
  146.    if pos>0 then
  147.     nouv_fich.writeline ("<HR><A href=""#"" OnClick='Explore("""& fich.Path & """ )'>" & fich.Path & "</A>" )
  148.     do while pos>0
  149.      nbav=50
  150.      if pos-1<nbav then nbav=pos-1
  151.      nbapr=50
  152.      if len(txtlu)-pos-len(mot_cherch)+1<nbapr then nbapr=len(txtlu)-pos-len(mot_cherch)+1
  153.      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)
  154.      if nbav=50 then txx="..." & txx
  155.      if nbapr=50 then txx=txx & "..."
  156.      txx="<BR>&nbsp;&nbsp;&nbsp;" & txx
  157.      nouv_fich.writeline txx
  158.      txtlu=right(txtlu,len(txtlu)-pos+1-len(mot_cherch))
  159.      pos=instr(lcase(txtlu),lcase(mot_cherch))
  160.     loop
  161.    end if
  162.   end if
  163.  next
  164. next
  165. set rep=nothing
  166. end sub
  167. '*************************************************************************
  168. function tt(txte)
  169. tt=txte
  170. tt=replace(tt,"<","&lt;" )
  171. tt=replace(tt,">","&gt;" )
  172. end function
  173. '*************************************************************************
  174. Function HtmlEscape(strRawData)
  175. 'http://alexandre.alapetite.fr/doc-alex/alx_special.html
  176. Dim strHtmlEscape
  177. strHtmlEscape = strRawData
  178. strHtmlEscape = Replace(strHtmlEscape, "&", "&amp;" )
  179. strHtmlEscape = Replace(strHtmlEscape, "<", "&lt;" )
  180. strHtmlEscape = Replace(strHtmlEscape, ">", "&gt;" )
  181. strHtmlEscape = Replace(strHtmlEscape, """", "&quot;" )
  182. strHtmlEscape = Replace(strHtmlEscape, "à", "&agrave;" )
  183. strHtmlEscape = Replace(strHtmlEscape, "è", "&egrave;" )
  184. strHtmlEscape = Replace(strHtmlEscape, "é", "&eacute;" )
  185. strHtmlEscape = Replace(strHtmlEscape, "©", "&copy;" )
  186. strHtmlEscape = Replace(strHtmlEscape, "ê", "&ecirc;" )
  187. 'strHtmlEscape = Replace(strHtmlEscape, vbCrLf, "<br>" )
  188. 'strHtmlEscape = Replace(strHtmlEscape, vbCr, "<br>" )
  189. 'strHtmlEscape = Replace(strHtmlEscape, vbLf, "<br>" )
  190. 'strHtmlEscape = Replace(strHtmlEscape, vbTab, "&nbsp;&nbsp;&nbsp;&nbsp;" )
  191. 'strHtmlEscape = Replace(strHtmlEscape, "  ", "&nbsp;&nbsp;" )
  192. HtmlEscape = strHtmlEscape
  193. End Function
  194. '****************************************************************************************************
  195. Sub CreateProgressBar(Titre,MsgAttente)
  196. Dim ws,fso,f,f2,ts,ts2,Ligne,i,fread,LireTout,NbLigneTotal,Temp,PathOutPutHTML,fhta,oExec
  197. Set ws = CreateObject("wscript.Shell" )
  198. Set fso = CreateObject("Scripting.FileSystemObject" )
  199. Temp = WS.ExpandEnvironmentStrings("%Temp%" )
  200. PathOutPutHTML = Temp & "\Barre.hta"
  201. Set fhta = fso.OpenTextFile(PathOutPutHTML,2,True)
  202. fhta.WriteLine "<HTML>"
  203. fhta.WriteLine "<HEAD>"
  204. fhta.WriteLine "<Title>  " & Titre & "</Title>"
  205. fhta.WriteLine "<HTA:APPLICATION"
  206. fhta.WriteLine "ICON = ""magnify.exe"" "
  207. fhta.WriteLine "BORDER=""THIN"" "
  208. fhta.WriteLine "INNERBORDER=""NO"" "
  209. fhta.WriteLine "MAXIMIZEBUTTON=""NO"" "
  210. fhta.WriteLine "MINIMIZEBUTTON=""NO"" "
  211. fhta.WriteLine "SCROLL=""NO"" "
  212. fhta.WriteLine "SYSMENU=""NO"" "
  213. fhta.WriteLine "SELECTION=""NO"" "
  214. fhta.WriteLine "SINGLEINSTANCE=""YES"">"
  215. fhta.WriteLine "</HEAD>"
  216. fhta.WriteLine "<BODY text=""white""><CENTER><DIV><SPAN ID=""ProgressBar""></SPAN>"
  217. fhta.WriteLine "<span><marquee DIRECTION=""LEFT"" SCROLLAMOUNT=""3"" BEHAVIOR=ALTERNATE><font face=""Comic sans MS"">" & MsgAttente &"</font></marquee></span></DIV></CENTER></BODY></HTML>"
  218. fhta.WriteLine "<SCRIPT LANGUAGE=""VBScript""> "
  219. fhta.WriteLine "Set ws = CreateObject(""wscript.Shell"" )"
  220. fhta.WriteLine "Temp = WS.ExpandEnvironmentStrings(""%Temp%"" )"
  221. fhta.WriteLine "Sub window_onload()"
  222. fhta.WriteLine "    CenterWindow 480,90"
  223. fhta.WriteLine "    Self.document.bgColor = ""1234568"" "
  224. fhta.WriteLine " End Sub"
  225. fhta.WriteLine " Sub CenterWindow(x,y)"
  226. fhta.WriteLine "    Dim iLeft,itop"
  227. fhta.WriteLine "    window.resizeTo x,y"
  228. fhta.WriteLine "    iLeft = window.screen.availWidth/2 - x/2"
  229. fhta.WriteLine "    itop = window.screen.availHeight/2 - y/2"
  230. fhta.WriteLine "    window.moveTo ileft,itop"
  231. fhta.WriteLine "End Sub"
  232. fhta.WriteLine "</script>"
  233. fhta.close
  234. End Sub
  235. '**********************************************************************************************
  236. Sub LancerProgressBar()
  237. Set oExec = Ws.Exec("mshta.exe " & Temp & "\Barre.hta" )
  238. End Sub
  239. '**********************************************************************************************
  240. Sub FermerProgressBar()
  241. oExec.Terminate
  242. End Sub
  243. '**********************************************************************************************
  244. Function DblQuote(Str)
  245. DblQuote = Chr(34) & Str & Chr(34)
  246. End Function
  247. '**********************************************************************************************


 
je ne vois pas ou peut ce trouver l'erreur  
 
Merci par avance
 
En3rgizz
 
 

Reply

Marsh Posté le 14-03-2014 à 15:27:40   

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed