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


 
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