Un utilitaire qui permet d'énumérer les fichiers d'un répertoire avec des caractères jokers.
Puis de choisir le format du fichier ainsi généré selon deux critère texte ou html.
Un utilitaire qui permet d'explorer un réperoire puis de le transférer dans un fichier texte ou html
mode opératoire :
Utilisation lancer le programme et cliquer sur le dossier puis
sur le bouton rechercher les fichiers de ce répertoire avec le masque de saisie
à sélectionner puis définir des caractères joker comme *.mp3
l'utilitaire que je vous transmet permet aussi d'ouvrir le fichier TEXTE avec un éditeur
comme txtpad ou notepad normalement l'accentuation est respectée.
Ajout par par denis bertin stéphane pour une affiicher une zone de mémorisation
d'un répertoire avec la date ainsi que taille des fichiers le 14 juin 2013
Permet aussi désormais, d'exporter le fichier en HTML et de l'ordonner
Source / Exemple :
unit Enum;
//Une Création originale de denis bertin améliorée par denis bertin son concepteur.
//Qui selon la perception de denis bertin est aussi une visiblité internautesque
//avec la bonne formulation Html.
//Améliorer par denis bertin le 11.6.2013 pour afficher les disuque présent sur
//le système.
//Ecrit par denis bertin stéphane pour ajouter une zone de mémorisation d'un
//répertoire avec la taille des fichiers le 14 juin 2013.
// Modifié par Cirec pour permettre la compilation avec D2009 et ++
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, ShellCtrls, StdCtrls, Grids, Outline, DirOutln,
ExtCtrls, Menus, Buttons;
const
k_title_application = 'Enum Files';
(*
Suite à la demande de romain qui m'a demandé comment créer un bouton et ce code
qui me permet d'extraire les fichier d'un répertoire.
Voici un exemple de positionnement d'un bouton, d'une tree-liste et d'un
contrôle d'édition le masque de recherche.
Ce programme permet de sélectionner un répertoire et d'exporter dans un fichier
les nom des fichier correspondant au masque.
Une seule méthode est définit quand vous cliquez sur le bouton de lancement qui
demande au préalable de saisir un nom de fichier.
Ce nom de fichier est utilisé pour écrire (writeln) les noms correspondants à
la recherche effectuée. (c) Beelog écrit par denis bertin. le 2.1.2012
type
TForm_dir_file_enum = class(TForm)
Button1: TButton;
DirectoryOutline1: TDirectoryOutline;
SaveDialog1: TSaveDialog;
Label1: TLabel;
Edit1: TEdit;
RadioButton_exporter_as_text: TRadioButton;
RadioButton_exporter_as_html: TRadioButton;
CheckBox_ordonner: TCheckBox;
Timer1: TTimer;
Button2: TButton;
PopupMenuItems: TPopupMenu;
Clic: TMenuItem;
SpeedButton2: TSpeedButton;
RadioButton_create_a_string_list: TRadioButton;
CheckBox_File_size: TCheckBox;
CheckBox_Time_stamp: TCheckBox;
procedure Button1Click(Sender: TObject);
procedure Enumerer_les_fichier_du_repertoire;
procedure Timer1Timer(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure ClicClick(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
private
{ Déclarations privées }
public
{ Déclarations publiques }
end;
var
Form_dir_file_enum: TForm_dir_file_enum;
implementation
{$R *.dfm}
uses Unit_aide, string_show_dialog;
type
pc1024 = array[0..1024] of char;
function open_fichier_avec_extension(awindow: hwnd; ext, fichier: pchar):
boolean;
var
a_jpeg_key, a_prog_key, a_shell_key: HKEY;
pc_jpeg, pc_prog, pc_remplacer: pc1024;
pc_show_filename_file_associated: pc1024;
longeur, maxlen_remplacer: integer;
p, q: pchar;
begin
result := false;
if RegOpenKey(HKEY_CLASSES_ROOT, ext, a_jpeg_key) = ERROR_SUCCESS then
begin {ouverture de la clé jpeg}
longeur := pred(Sizeof(pc_jpeg));
if RegQueryValue(a_jpeg_key, nil, pc_jpeg, longeur) = ERROR_SUCCESS then
begin
if RegOpenKey(HKEY_CLASSES_ROOT, pc_jpeg, a_prog_key) = ERROR_SUCCESS then
begin
if (RegOpenKey(a_prog_key, 'shell\edit\command', a_shell_key) =
ERROR_SUCCESS)
or (RegOpenKey(a_prog_key, 'shell\open\command', a_shell_key) =
ERROR_SUCCESS) then
begin
longeur := pred(Sizeof(pc_prog));
if RegQueryValue(a_shell_key, nil, pc_prog, longeur) = ERROR_SUCCESS
then
begin
p := sysutils.strpos(pc_prog, '.exe');
if p = nil then p := sysutils.strpos(pc_prog, '.EXE');
if p <> nil then
begin
p := strpos(pc_prog, '%1');
if p <> nil then
begin
maxlen_remplacer := pred(sizeof(pc_remplacer));
strcopy(pc_show_filename_file_associated,
'Voulez-vous ouvrir ce fichier avec le logiciel associé : "%s" ?');
SysUtils.StrLFmt(pc_remplacer, maxlen_remplacer,
pchar(@pc_show_filename_file_associated), [pc_jpeg]);
if application.MessageBox(pc_remplacer, k_title_application,
MB_YESNO) = IDYES then
begin
if awindow <> 0 then
updatewindow(awindow);
q := p;
dec(q);
if q^ = '"' then
begin
p^ := #0;
strcat(strcat(pc_prog, fichier), '"');
end
else
begin
p^ := #0;
strcat(strcat(strcat(pc_prog, ' "'), fichier), '"');
end;
// {$ifdef debug}if application.MessageBox(pc_prog,
//z_open_file.string_previsualisation,MB_YESNO)=IDYES then {$endif debug}
{Note This function "WinExec" is provided only for compatibility with 16-bit Windows.
Applications should use the CreateProcess function.}
{ ******* }result := winexec(PAnsiChar(AnsiString(pc_prog)), sw_show) >=
32;
end;
end
else
begin
maxlen_remplacer := pred(sizeof(pc_remplacer));
strcopy(pc_show_filename_file_associated,
'Voulez-vous ouvrir ce fichier avec le logiciel associé : "%s" ?');
SysUtils.StrLFmt(pc_remplacer, maxlen_remplacer,
pchar(@pc_show_filename_file_associated), [pc_jpeg]);
if application.MessageBox(pc_remplacer, k_title_application,
MB_YESNO) = IDYES then
begin
if awindow <> 0 then
updatewindow(awindow);
//Exception pour paint shop pro suppr chaine /dde
p := strpos(pc_prog, '/dde');
if p <> nil then
p^ := #0;
strcat(strcat(strcat(pc_prog, ' "'), fichier), '"');
// {$ifdef debug} if application.MessageBox(pc_prog,
//z_open_file.string_previsualisation,MB_YESNO)=IDYES then {$endif debug}
{Note This function "WinExec" is provided only for compatibility with 16-bit Windows.
Applications should use the CreateProcess function.}
{ ******* }result := winexec(PAnsiChar(AnsiString(pc_prog)), sw_show)
>=
32;
end;
end;
end;
end;
RegCloseKey(a_shell_key);
end;
RegCloseKey(a_prog_key);
end;
end;
RegCloseKey(a_jpeg_key);
end; {ouverture de la clé jpeg}
end; {open_fichier_avec_extension}
procedure TForm_dir_file_enum.Button1Click(Sender: TObject);
begin
Self.Enumerer_les_fichier_du_repertoire;
end;
procedure TForm_dir_file_enum.Enumerer_les_fichier_du_repertoire;
var
i, somme: integer;
var
apc: pc1024;
var
Search: TSearchRec;
var
File_out_dir: TextFile;
var
une_liste: classes.TStringList;
var
une_entree: string;
begin
// {$ifdef debug}
// box(0,pchar(DirectoryOutline1.Directory));
// {$endif debug}
if self.RadioButton_exporter_as_text.Checked then
begin
SaveDialog1.DefaultExt := '.txt';
SaveDialog1.Filter := '*.txt';
if SaveDialog1.Execute then
begin
AssignFile(File_out_dir, SaveDialog1.FileName);
ReWrite(File_out_dir);
strcopy(apc, pchar(DirectoryOutline1.Directory));
strcat(apc, pchar('\' + Edit1.Text));
if findfirst(apc, faAnyFile, Search) = 0 then
begin
repeat
//Pour éviter que ces fichiers de remonté de répertoire soit listé (. et ..)
if Search.Name[1] <> '.' then
writeln(File_out_dir, Search.Name);
until FindNext(Search) <> 0;
FindClose(Search);
end;
CloseFile(File_out_dir);
Open_fichier_avec_extension(self.handle, '.txt',
pchar(SaveDialog1.FileName));
end
end
else
if self.RadioButton_exporter_as_html.Checked then
begin
SaveDialog1.Filter := '*.htm';
SaveDialog1.DefaultExt := '.html';
if SaveDialog1.Execute then
begin
AssignFile(File_out_dir, SaveDialog1.FileName);
ReWrite(File_out_dir);
writeln(File_out_dir, '//Le répertoire qui est énuméré : ' +
DirectoryOutline1.Directory + '<br>');
writeln(File_out_dir, '//Avec le masque des caractères joker suivant : '
+ Edit1.Text + '<br>');
strcopy(apc, pchar(DirectoryOutline1.Directory));
strcat(apc, pchar('\' + Edit1.Text));
if findfirst(apc, faAnyFile, Search) = 0 then
begin
if self.CheckBox_ordonner.Checked then
writeln(File_out_dir, '<ol>');
repeat
//Pour éviter que ces fichiers de remonté de répertoire soit listé (. et ..)
if Search.Name[1] <> '.' then
begin
if self.CheckBox_ordonner.Checked then
begin
writeln(File_out_dir, chr(9) + '<li>' + Search.Name + '<br>');
{denis B}
end
else
begin
writeln(File_out_dir, Search.Name + '<br>');
end;
end;
until FindNext(Search) <> 0;
FindClose(Search);
if self.CheckBox_ordonner.Checked then
writeln(File_out_dir, '</ol>'); {écrit par denis Bertin}
end;
CloseFile(File_out_dir);
Open_fichier_avec_extension(self.handle, '.htm',
pchar(SaveDialog1.FileName));
end;
end
else
if self.RadioButton_create_a_string_list.Checked then
begin
une_liste := classes.TStringList.Create;
strcat(strcopy(apc, pchar(DirectoryOutline1.Directory)), pchar('\' +
Edit1.Text));
string_show_dialog.Form_du_listing.Memo1.clear;
if findfirst(apc, faAnyFile, Search) = 0 then
begin
{initialisation de la variables somme}
somme := 0;
repeat
if Search.Name[1] <> '.' then
begin
une_entree := Search.Name;
une_liste.add(une_entree);
if CheckBox_Time_stamp.Checked and CheckBox_File_size.Checked then
begin
inc(somme, Search.Size);
string_show_dialog.Form_du_listing.Memo1.Lines.Add(
une_entree + ' Avec une date ' + DateTimeToStr(Search.Time) +
' taille=' + inttostr(Search.Size) + ' Octet(s)');
end
else
if CheckBox_Time_stamp.Checked then
begin
string_show_dialog.Form_du_listing.Memo1.Lines.Add(
une_entree + ' Avec une date ' +
DateTimeToStr(Search.Time));
end
else
if CheckBox_File_size.Checked then
begin
inc(somme, Search.Size);
string_show_dialog.Form_du_listing.Memo1.Lines.Add(
une_entree + ' Taille=' + inttostr(Search.Size) +
' Octet(s)')
end
else
string_show_dialog.Form_du_listing.Memo1.Lines.Add(une_entree);
end;
until FindNext(Search) <> 0;
if CheckBox_File_size.Checked then
string_show_dialog.Form_du_listing.Memo1.Lines.Add(
'Nombre de fichier du répertoire ' +
DirectoryOutline1.Directory + ' est égal à ' +
inttostr(une_liste.count) +
' Avec une taille total = ' + inttostr(somme) + ' Octet(s)')
else
string_show_dialog.Form_du_listing.Memo1.Lines.Add(
'Nombre de fichier du répertoire ' +
DirectoryOutline1.Directory + ' est égal à ' +
inttostr(une_liste.count));
FindClose(Search);
string_show_dialog.Form_du_listing.ShowModal;
end;
end;
end;
procedure TForm_dir_file_enum.Timer1Timer(Sender: TObject);
begin
CheckBox_ordonner.Visible := self.RadioButton_exporter_as_html.Checked;
CheckBox_File_size.Visible := self.RadioButton_create_a_string_list.Checked;
CheckBox_Time_stamp.Visible := self.RadioButton_create_a_string_list.Checked;
end;
procedure TForm_dir_file_enum.FormActivate(Sender: TObject);
begin
self.RadioButton_exporter_as_text.Checked := true;
end;
procedure TForm_dir_file_enum.Button2Click(Sender: TObject);
var
Drive: Char;
pc_idrive: array[0..255] of char;
apoint: tpoint;
NewItem: TMenuItem;
begin
PopupMenuItems.Items.clear;
getcursorpos(apoint);
{parcourir les différentes lettres pour trouver les disques}
for Drive := 'a' to 'z' do
begin
strcopy(pc_idrive, PChar(Drive + ':\'));
case GetDriveType(pc_idrive) of
0: ;
DRIVE_REMOVABLE, DRIVE_FIXED, DRIVE_REMOTE:
begin {OK}
NewItem := TMenuItem.Create(PopupMenuItems); // crée le nouvel élément
PopupMenuItems.Items.Add(NewItem); // lui ajoute le Popupmenu
NewItem.Caption := pc_idrive;
NewItem.Tag := ord(drive) - ord('a');
NewItem.OnClick := ClicClick;
end; {OK}
end; {case}
end; {for}
with apoint do
PopupMenuItems.Popup(X, Y);
end;
procedure TForm_dir_file_enum.ClicClick(Sender: TObject);
begin
///Attribuer la bonne lettre du lecteur
with Sender as TMenuItem do
DirectoryOutline1.Drive := chr(ord(Tag) + ord('a'));
end;
procedure TForm_dir_file_enum.SpeedButton2Click(Sender: TObject);
begin
Unit_aide.Form1.ShowModal;
end;
end.
Conclusion :
Compile de D7 à D2009 voir +
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.