1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186
|
<%
'...................................................................................
'BUT : Lister le contenu du chemin passer en paramêtre
'...................................................................................
Sub ListFolderContents(p_path,p_sort,p_hiddenfolder,p_l_cut,p_r_cut)
dim fs, folder, file_item, url, i, i_fsmax, i_foldermax, folder_path
' Tableau contenant la description des fichier (max 500 fichiers)
dim tab_fs(500,3)
dim tab_folder(500,1)
'Bloc_instructions_1 verification que le dossier existe
'---------------------------------------------------------
set fs = CreateObject("Scripting.FileSystemObject")
if fs.FolderExists(p_path) then
' Le chemin est un dossier valide
set folder = fs.GetFolder(p_path)
else
' Le chemin n'est pas un dossier valide on sort de la procedure
' SORTIE DE LA PROCEDURE:
exit sub
end if
'Bloc_instructions_2 execution de la procédure
'---------------------------------------------
'Affichage du répertoire ciblé et de ses informations.
'On n'affiche pas le nom du répertoire passé en paramètre
if ((folder.Name)=p_hiddenfolder) or ((folder.Name)="_vti_cnf") then
response.Write("")
else
chaine_folder = right(folder.name,len(folder.name))
Response.Write("<li><b><font color='#0066FF' size =2,5>" & chaine_folder & "</font></b>")
end if
'Initialisation index
i_fsmax = cint(folder.Files.Count)
i = i_fsmax
'Enregistrement de la liste des fichiers dans le tableau.
for each file_item in folder.Files
'Lien hypertexte
url = MapURL(file_item.Path)
'Avec option de tronquage
chaine = left(file_item.name,len(file_item.name)-cint(p_r_cut))
chaine = right (chaine, len(chaine)-cint(p_l_cut))
ext = lcase(mid(file_item.name, instrrev(file_item.name, ".") + 1))
if file_item.attributes <> "2" then
'Enregistrement dans un tableau
tab_fs(i,1) = chaine
tab_fs(i,2) = ext
tab_fs(i,3) = url
i = i-1
end if
next
'Affichage de la liste
for j = 1 to i_fsmax step j+1
if p_sort = "asc" then
'Sortie en ordre ascendant
i = i_fsmax + 1 - j
else
'Sortie en ordre descendant
i = j
end if
chaine = tab_fs(i,1)
ext = tab_fs(i,2)
url = tab_fs(i,3)
'Création du lien qui s'ouvrira dans une nouvelle fenêtre grâce à "_blank"
Response.Write("<ul><font color='FA7C3E'>" & vbCrLf)
if ext = "doc" or ext="rtf" or ext="txt" then
Response.Write("<li><img src=""/images/word.jpg"" border=""0""><a href=""" & url & """target='_blank'""><font color='#0E356A' size =2> " & chaine & "</font></a></li>" & vbCrLf)
elseif ext = "dot" then
Response.Write("<li><img src=""/images/word_template.jpg"" border=""0""><a href=""" & url & """target='_blank'""><font color='#0E356A' size =2> " & chaine & "</font></a></li>" & vbCrLf)
elseif ext = "xls" then
Response.Write("<li><img src=""/images/excel.jpg"" border=""0""><a href=""" & url & """target='_blank'""><font color='#0E356A' size =2> " & chaine & "</font></a></li>" & vbCrLf)
elseif ext = "xlt" then
Response.Write("<li><img src=""/images/excel_template.jpg"" border=""0""><a href=""" & url & """target='_blank'""><font color='#0E356A' size =2> " & chaine & "</font></a></li>" & vbCrLf)
elseif ext = "ppt" then
Response.Write("<li><img src=""/images/powerpoint.jpg"" border=""0""><a href=""" & url & """target='_blank'""><font color='#0E356A' size =2> " & chaine & "</font></a></li>" & vbCrLf)
elseif ext = "pps" then
Response.Write("<li><img src=""/images/powerpoint_diaporama.jpg"" border=""0""><a href=""" & url & """target='_blank'""><font color='#0E356A' size =2> " & chaine & "</font></a></li>" & vbCrLf)
elseif ext = "url" or ext = "lnk"
Response.Write("<li><img src=""/images/ie.jpg"" border=""0""><a href=""" & url & """target='_blank'""><font color='#0E356A' size =2> " & chaine & "</font></a></li>" & vbCrLf)
elseif ext= "htm" or ext= "html" then
Response.Write("<li><img src=""/images/ie.jpg"" border=""0""><a href=""" & url & """target='_blank'""><font color='#0E356A' size =2> " & chaine & "</font></a></li>" & vbCrLf)
elseif ext = "pdf" then
Response.Write("<li><img src=""/images/pdf.jpg"" border=""0""><a href=""" & url & """target='_blank'""><font color='#0E356A' size =2> " & chaine & "</font></a></li>" & vbCrLf)
elseif ext = "oft" then
Response.Write("<li><img src=""/images/outlook_template.jpg"" border=""0""><a href=""" & url & """target='_blank'""><font color='#0E356A' size =2> " & chaine & "</font></a></li>" & vbCrLf)
elseif ext = "msg" then
Response.Write("<li><img src=""/images/outlook.jpg"" border=""0""><a href=""" & url & """target='_blank'""><font color='#0E356A' size =2> " & chaine & "</font></a></li>" & vbCrLf)
elseif ext = "wmv" then
Response.Write("<li><img src=""/images/video.jpg"" border=""0""><a href=""" & url & """target='_blank'""><font color='#0E356A' size =2> " & chaine & "</font></a></li>" & vbCrLf)
else
Response.Write("<li><a href=""" & url & """target='_blank'""><font color='#0E356A' size =2> " & chaine & "</font></a></li>" & vbCrLf)
end if
Response.Write("</ul></font>" & vbCrLf)
next
i_maxfolder = folder.SubFolders.Count
i = i_maxfolder
'Affichage de la liste des sous répertoires
for each file_item in folder.SubFolders
'Si un sous répertoire s'appelle _vti_cnf (créé par FrontPage et ne présentant aucun intéret),
'on n'affiche rien
if (file_item.Name <> "_vti_cnf") then
'Enregistrement dans un tableau:
tab_folder(i,1) = file_item.Path
i=i-1
end if
next
'Sortie en ordre alphabétique en fonction du paramètre p_sort
for j = 1 to i_maxfolder
if p_sort = "asc" then
'Sortie en ordre ascendant
i = i_maxfolder + 1 - j
else
'Sortie en ordre descendant
i = j
end if
Response.Write("<ul><font color='#2A6FCC'>" & vbCrLf)
Call ListFolderContents(tab_folder(i,1),p_sort,p_hiddenfolder,p_l_cut,p_r_cut)
Response.Write("</ul></font><BR>" & vbCrLf)
next
end Sub
' Fin de procedure -------------------------------------
'BUT : Convertion de l'adresse physque d'un fichier en URL avec lien hypertexte vers le fichier
function MapURL(p_pathurl)
dim rootPath, url
rootPath = Server.MapPath("/")
url = Right(p_pathurl, Len(p_pathurl) - Len(rootPath))
MapURL = Replace(url, "", "/")
end function
%> |
Partager