FAQ DelphiConsultez toutes les FAQ

L'objet Application de l'unité Form contient un attribut ExeName : String; qui contient le nom de fichier de l'exécutable de l'application, y compris le chemin d'accès. Pour extraire uniquement le répertoire où se trouve notre programme, on utilisera la fonction ExtractFilePath(const FileName: String) : String; de l'unité SysUtils.

Repertoire := ExtractFilePath(Application.ExeName);

On utilise la fonction CreateDir(const Dir : String) : Boolean; de l'unité SysUtils. Il est toutefois préférable de tester préalablement si le répertoire n'existe pas déjà. Il est aussi bien vu de vérifier qu'il n'y ait pas eu d'erreurs lors de la création du répertoire.

Exemple de l'aide en ligne de Delphi :

1
2
3
4
5
begin 
  if not DirectoryExists('C:\temp') then 
  if not CreateDir('C:\temp') then 
    raise Exception.Create('Impossible de créer C:\temp'); 
end;

On utilise la fonction ForceDirectories (Dir : string) : Boolean de l'unité SysUtils.

ForceDirectories permet de créer un dossier et ses répertoires parents si nécessaire. Il n'est pas nécessaire de vérifier que le dossier n'existe pas avant d'appeler cette fonction, puisque cela se fait avant la création des répertoires.

Exemple de l'aide en ligne de Delphi :

1
2
3
4
5
6
7
var 
  Dir: string; 
begin 
  Dir := 'C:\APPS\SALES\LOCAL'; 
  if ForceDirectories(Dir) then 
    Label1.Caption := Dir + ' a été créé' 
end;

Deux possibilités sont à envisager :

• le répertoire est vide : l'utilisation de la fonction RemoveDir (const Dir : String) : Boolean suffit ;
• le répertoire n'est pas vide : une solution consiste à utiliser l'API de l'unité ShellAPI :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
uses 
  ShellApi; 
  
function DelDir(Dir: String): Boolean; 
var fos: TSHFileOpStruct; 
begin 
  ZeroMemory(@fos, SizeOf(fos)); 
  with fos do begin 
    wFunc := FO_DELETE; 
    fFlags := FOF_SILENT or FOF_NOCONFIRMATION; 
    pFrom := PChar(Dir + #0); 
  end; 
  Result := (0=ShFileOperation(fos)); 
end;

La fonction RenameFile (constOldName, NewName : string) : Boolean de l'unité SysUtils permet de renommer les fichiers mais aussi les répertoires.

RenameFile('c:\tmp\', 'c:\tmp2\');

La fonction suivante utilise une expression régulière pour vérifier qu'une chaîne de caractères donnée est un nom de dossier valide sous Windows.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
uses 
{$if compilerversion >= 22.0} 
  RegularExpressionsCore; 
{$else} 
  PerlRegEx; (* http://www.regular-expressions.info/download/TPerlRegEx.zip *) 
{$ifend} 
  
function IsValidFolderName(const s: string): boolean; 
const 
  REGEX = '^[A-Za-z]:(\\|(\\(\.*[^\\/:*?"<>|.]+)+)+)$'; 
var 
  expr: TPerlRegEx; 
begin 
  expr := TPerlRegEx.Create; 
  expr.Subject := {$if compilerversion >= 22.0}s{$else}utf8string(s){$ifend}; 
  expr.RegEx := REGEX; 
  result := expr.Match; 
  expr.Free; 
end;

On utilise pour cela la fonction DirectoryExists(const Directory : String) : Boolean; de l'unité SysUtils.

1
2
3
4
5
6
begin 
  if DirectoryExists('C:\MyDirectory\') then 
    { le répertoire existe } 
  else 
    { le répertoire n'existe pas } 
end;

La fonction SelectDirectory affiche l'explorateur des répertoires de Windows. Il faut ajouter FileCtrl dans la clause Uses. Cette fonction a deux format d'appel différents :

SelectDirectory (constCaption : string; constRoot : WideString; outDirectory : string) : Boolean;

Cette version permet de choisir le répertoire de départ de la recherche et le titre de la fenêtre.

1
2
3
4
5
6
7
procedure TForm1.Button1Click(Sender: TObject);  
var  
  ChoixRepertoire : string;  
begin  
  If SelectDirectory('Choisissez le dossier d''installation','C:\TEMP\',ChoixRepertoire)  
    Then Label1.caption := ChoixRepertoire;  
end;

1
2
3
4
5
6
7
procedure TForm1.Button1Click(Sender: TObject);  
var  
  ChoixRepertoire : string;  
begin  
  If SelectDirectory(ChoixRepertoire,[sdAllowCreate,sdPerformCreate,sdPrompt],0)  
    Then Label1.caption := ChoixRepertoire;  
end;

• sdAllowCreate autorise la sélection d'un répertoire inexistant ;
• sdPerformCreate autorise la boîte de dialogue à créer le répertoire ;
• sdPrompt demande la confirmation en cas de création de répertoire.

Selon la version de Windows, le répertoire système n'est pas le même (System32 ou System). Pour retrouver ce répertoire, il suffit de le demander à Windows par le biais de la fonction GetSystemDirectory :

1
2
3
4
5
6
7
8
9
10
11
function SystemDirectory: String; 
const 
  dwLength: DWORD = 255; 
var 
  SystemDir: PChar; 
begin 
  GetMem(SystemDir, dwLength); 
  GetSystemDirectory(SystemDir, dwLength); 
  Result := String(SystemDir); 
  FreeMem(SystemDir, dwLength); 
end;

Selon la version, Windows est installé en standard soit dans le répertoire C:\WINDOWS, soit dans le répertoire C:\WINNT. Pour retrouver ce répertoire, il suffit de le demander à Windows par le biais de la fonction GetWindowsDirectory.

1
2
3
4
5
6
7
8
9
10
11
function WindowsDirectory: String; 
const 
  dwLength: DWORD = 255; 
var 
  WindowsDir: PChar; 
begin 
  GetMem(WindowsDir, dwLength); 
  GetWindowsDirectory(WindowsDir, dwLength); 
  Result := String(WindowsDir); 
  FreeMem(WindowsDir, dwLength); 
end;

Dans l'API Windows, il existe la fonction SHGetFolderLocation qui permet de récupérer le chemin des répertoires spéciaux de Windows : Bureau, Menu Démarrer...

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
uses Shlobj; 
  
function SpecialFolder(Folder: Integer): String;  
var  
  SFolder : pItemIDList;  
  SpecialPath : Array[0..MAX_PATH] Of Char;  
begin  
  SHGetFolderLocation(Form.Handle, Folder, 0, SHGFP_TYPE_CURRENT, SFolder);  
  SHGetPathFromIDList(SFolder, SpecialPath);  
  Result := StrPas(SpecialPath);  
end; 
  
{ Application : } 
procedure TForm.MyButtonClick(Sender: TObject); 
begin 
  MyLabel.Caption := SpecialFolder(CSIDL_PERSONAL); 
end;

• CSIDL_APPDATA : Répertoire contenant les données des applications ;
• CSIDL_COMMON_FAVORITES : Répertoire contenant les Favoris commun à tous les utilisateurs ;
• CSIDL_COMMON_STARTMENU : Répertoire du menu Démarrer commun à tous les utilisateurs ;
• CSIDL_COMMON_PROGRAMS : Répertoire Programmes du menu Démarrer commun à tous les utilisateurs ;
• CSIDL_COMMON_STARTUP : Répertoire du groupe Démarrage du menu Démarrer commun à tous les utilisateurs ;
• CSIDL_COMMON_DESKTOPDIRECTORY : Répertoire correspondant au bureau commun à tous les utilisateurs ;
• CSIDL_COOKIES : Répertoire ou sont stockés les cookies d'Internet Explorer ;
• CSIDL_DESKTOP : Répertoire correspondant à votre Bureau ;
• CSIDL_DESKTOPDIRECTORY : Répertoire correspondant à votre Bureau ;
• CSIDL_FAVORITES : Répertoire Favoris ;
• CSIDL_FONTS : Répertoire dans lequel sont stockées toutes les polices de caractères ;
• CSIDL_HISTORY : Répertoire contenant l'historique d'Internet Explorer ;
• CSIDL_INTERNET_CACHE : Répertoire ou sont stockés les fichiers temporaires d'Internet Explorer ;
• CSIDL_NETHOOD : Répertoire Voisinage Réseau ;
• CSIDL_PERSONAL : Répertoire Mes Documents ;
• CSIDL_PRINTHOOD : Répertoire de voisinage d'impression ;
• CSIDL_PROGRAMS : Répertoire Programmes du menu Démarrer ;
• CSIDL_RECENT : Répertoire dans lequel se trouvent les raccourcis vers les Fichiers récemment ouverts ;
• CSIDL_SENDTO : Répertoire dans lequel se trouvent les raccourcis Envoyer vers ;
• CSIDL_STARTMENU : Répertoire Menu Démarrer ;
• CSIDL_STARTUP : Répertoire du groupe Démarrage du Menu Démarrer ;
• CSIDL_TEMPLATES : Répertoire contenant les modèles de documents de Windows.

La fonction suivante vous permet de copier un répertoire :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
  
function CopyFolder(FromFld, ToFld: string): boolean;  
var fos: TSHFileopStruct;  
begin  
// il faut supprimer les antislashs de fin sinon vous aurez droit à un message d'erreur  
  FromFld := ExcludeTrailingPathDelimiter(Trim(FromFld));  
  ToFld := ExcludeTrailingPathDelimiter(Trim(ToFld));  
  
  FillChar(fos, SizeOf(fos),0);  
  with fos do  
  begin  
    wFunc := FO_COPY;  
    pFrom := PChar(FromFld+#0);  
    pTo   := PChar(ToFld+#0);  
    fFlags := FOF_SILENT or FOF_NOCONFIRMATION or FOF_NOCONFIRMMKDIR;  
  end;  
  Result := ShFileOperation(fos)=0;  
end;

1
2
3
4
  
if CopyFolder('d:\Repertoire01', 'c:\Repertoire02')then  
    ShowMessage('Copie effectuée avec succès') else  
    ShowMessage('Copie non effectuée');