fichresult="c:\bookmarkjc.htm"



'adrfav="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\Favorites"
'nomrep=sh.RegRead(adrfav)

Set sh = WScript.CreateObject("WScript.Shell") 
Set fs = CreateObject("Scripting.FileSystemObject") 
nomrep= sh.SpecialFolders("Favorites") 



'*********************************explorateur******************************

Set rep=fs.getFolder(nomrep)
nomfavoris=rep.name


dim reps(200,10)
for x=0 to 200
for y=0 to 10
reps(x,y)="0"
next
next
reps(0,0)=rep.path
explore 0,0




sub explore(lin,col)
'met à jour tableau reps(niveau,numéro)
set rep=fs.getFolder(reps(lin,col))
reppath=rep.path
for each ssrep in rep.subfolders
if lin<190 and col<9 then
decale(lin)
reps(lin+1,col+1)=ssrep.path
lin=lin+1
explore lin,col+1
end if
next
'fichiers
decale(lin)
reps(lin+1,col+1)="FICH" & reppath
lin=lin+1
end sub


sub decale(ln)
'fait de la place sous la ligne ln
for nln=200 to ln+2 step -1
for ncl=0 to 10
reps(nln,ncl)=reps(nln-1,ncl)
next
next
'vider ligne ln+1
for ncl=0 to 10
reps(ln+1,ncl)="0"
next
end sub


'*********************************fin explorateur******************************







'créer le fichier texte et l'ouvrir en appending
Set nouv_fich = fs.OpenTextFile(fichresult, 2, true)
nouv_fich.close
Set nouv_fich = fs.OpenTextFile(fichresult, 8, false) 
'entete
nouv_fich.writeLine "<!DOCTYPE NETSCAPE-Bookmark-file-1>"
nouv_fich.writeLine "<!-- This is an automatically generated file."
nouv_fich.writeLine "It will be read and overwritten."
nouv_fich.writeLine "Do Not Edit! -->"
nouv_fich.writeLine "<TITLE>Bookmarks</TITLE>"
nouv_fich.writeLine "<H1>Bookmarks</H1>"
nouv_fich.writeLine "<DL><p>"

colold=0
'balayer ligne par ligne
for lin=0 to 200
for col=0 to 10
tut=reps(lin,col)

if tut<>"0" then
if left(tut & "   ",4)<>"FICH" then  'repertoires

set rep=fs.getFolder(tut)


if rep.name<>nomfavoris then
nouv_fich.writeLine "<DT><H3 FOLDED ADD_DATE=""" & 3600*24*(DateValue(rep.DateCreated)-25569) & """>" & rep.name & "</H3>"
nouv_fich.writeLine "<DL><p>"
end if

else 'fich
set rep=fs.getFolder(right(tut,len(tut)-4))
	'fichiers
	for each fich in rep.files 
	on error resume next
	if right(fich.name,4)=".url" then
	nouv_fich.writeline "        <DT><A HREF=""" & url(fich.path) & """ ADD_DATE=""" & 3600*24*(DateValue(fich.DateCreated)-25569) & """ LAST_VISIT=""" & 3600*24*(DateValue(fich.DateLastAccessed)-25569) & """ LAST_MODIFIED=""" & 3600*24*(DateValue(fich.DateLastModified)-25569) & """>" & left(fich.name,len(fich.name)-4) & "</A>"
	end if
	on error goto 0
	next 
	'fin du rép
	nouv_fich.writeLine "</DL><p>"

end if
end if

next
next



'nouv_fich.writeLine "</DL><p>"
nouv_fich.close

'afficher le résultat
sh.run "explorer " & fichresult
set sh=nothing





function url(adr)
url=""
'lire le raccourci
Set fch = fs.OpenTextFile(adr, 1, true)
Do While not fch.atEndOfStream 
txt=fch.readLine 
'msgbox txt 
if left(txt,4)="URL=" then url=right(txt,len(txt)-4)
Loop 
fch.close
end function





wscript.quit