FAQ PascalConsultez toutes les FAQ

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
  
Function CopyFile (const SourceFile, DestFile : String) : Boolean; 
Var 
  Source, Dest : File; 
  Buffer : Array [0..1023] of Byte; 
  Count : Word; 
  OldFileMode : Word; 
Begin 
  CopyFile := True; 
  { Désactivation des erreurs E/S } 
  {$I-} 
  
  { Assignation des fichiers } 
  Assign(Source,SourceFile); 
  Assign(Dest,DestFile); 
  
  { Ouverture en lecture seule de Source et création de Dest } 
  OldFileMode := FileMode; 
  FileMode := 0; 
  Reset(Source,1); 
  if IOResult = 0 
     then 
       begin 
         Rewrite(Dest,1); 
         if IOResult = 0 
            then 
              begin 
                { Boucle principale de copie, s'arrête quand la fin du fichier est atteinte } 
                repeat 
                  { Remplissage du buffer : 1 Ko prévus, Count octets réels } 
                  BlockRead(Source,Buffer,SizeOf(Buffer),Count); 
                  { Ecriture du contenu du buffer } 
                  BlockWrite(Dest,Buffer,Count); 
                until (Count = 0) or (Count <> SizeOf(Buffer)); 
                { Fermeture du fichier } 
                Close(Dest); 
                if IOResult <> 0 
                   then   { Erreur de fermeture du nouveau fichier } 
                     CopyFile := False; 
              end 
            else   { Erreur de création du nouveau fichier } 
              CopyFile := False; 
         { Fermeture du fichier } 
         Close(Source); 
       end 
     else   { Erreur d'ouverture du fichier original } 
       CopyFile := False; 
  { Réactivation des erreurs d'E/S et rétablissement du mode de lecture } 
  FileMode := OldFileMode; 
  {$I+} 
End;

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
  
Uses 
  Dos; 
  
  
Function CopyFile (const SourceFile, DestFile : String) : Boolean; 
... 
  
  
Function MoveFile (const FileName, Path : String) : Boolean; 
Var 
  S, Dir, FName, Ext : String; 
  f : File; 
begin 
  S := Path; 
  if S[Length(S)] <> '\' then S := S + '\'; 
  FSplit(FileName,Dir,FName,Ext); 
  S := S + FName + Ext; 
  if CopyFile(FileName, S) then 
  begin 
    Assign(f, FileName); 
    {$I-} 
    Erase(f); 
    {$I+} 
    MoveFile := (IOResult = 0); 
  end 
else 
  MoveFile := False; 
end;

1
2
3
4
5
6
7
8
9
  
Var 
  f : File; 
Begin 
  ... 
  Assign(f,'TEST.TXT'); 
  Erase(f); 
  ... 
End.

1
2
3
4
5
6
7
8
9
  
Var 
  f : File; 
Begin 
  ... 
  Assign(f,'OLD.TXT'); 
  Rename(f,'NEW.TXT'); 
  ... 
End.

1
2
3
4
5
6
7
8
9
  
Var 
  f : File; 
Begin 
  ... 
  Assign(f,'C:\TEST\OLD.TXT'); 
  Rename(f,'C:\TEST\NEW.TXT');  { On précise aussi le répertoire } 
  ... 
End.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
  
Function FileExists (const FileName : String) : Boolean; 
Var 
  f : File; 
  OldFileMode : Word; 
  Result : Boolean ; 
Begin 
  Result := (FileName <> 'NULL');   { Result = false si FileName = 'NULL' } 
  if Result 
     then   { on ne fait d'autres contrôles que si Result = True } 
       begin 
         OldFileMode := FileMode; { On modifie la méthode d'ouverture : lecture seule } 
         FileMode := 0; 
         {$I-} 
         Assign(f, FileName); 
         Reset(f,1); { Tentative d'ouverture } 
         Result := (IOResult = 0); 
         Close(f); 
         {$I+} 
         FileMode := OldFileMode; { On restaure le mode d'ouverture } 
       end; 
  FileExists := Result ; 
End;

1
2
3
4
5
6
7
8
9
10
11
12
13
  
Uses Dos; 
  
Function FileExists (const FileName : String); 
Var 
  S : SearchRec; 
Begin 
  FindFirst(FileName,AnyFile,S); 
  FileExists := (DosError = 0) and (S.Attr and (VolumeID or Directory) = 0); 
  
  { Si vous n'utilisez pas Turbo Pascal, ajoutez la ligne : } 
  { FindClose(S); } 
End;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
  
Program ChercheText; 
Uses 
  Dos; 
  
Var 
  S : SearchRec; 
  
Begin 
  { Recherche des fichiers texte du disque C, ayant l'attribut archive } 
  FindFirst('C:\*.TXT',Archive,S);     
  while DosError = 0 do                 { Tant qu'il n'y a pas d'erreurs... } 
  begin 
    WriteLn(S.Name);                    { Affichage du nom du fichier } 
    FindNext(S);                        { Recherche de la prochaine occurrence } 
  end; 
  FindClose(S);                         { Clôture la recherche (ligne à supprimer avec Turbo Pascal) } 
End.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
  
Program ListeDir; 
Uses 
  Dos; 
  
Var 
  S : SearchRec; 
  
Begin 
  FindFirst('C:\*.*',Directory,S); 
  while DosError = 0 do 
  begin 
    WriteLn(S.Name); 
    FindNext(S); 
  end; 
  FindClose(S); 
End.

1
2
3
4
5
6
7
8
9
10
11
12
  
Begin 
  ... 
  if FindFirst('*.TXT',faArchive,S) = 0 then 
  begin 
    repeat 
      ... 
    until FindNext(S) <> 0; 
    FindClose(S); 
  end; 
  ... 
End;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
  
Var 
  f : file; 
  OldFMode : Word; 
Begin 
  OldFMode := FileMode; 
  {$I-} 
  FileMode := 0; { Passage en lecture seule } 
  Assign(f, 'FICHIER.EXT'); 
  Reset(f,1); 
  ... 
  Close(f); 
  {$I+} 
  FileMode := OldFMode; 
End;

1
2
3
4
5
6
7
8
9
  
Uses 
  Dos; 
  
Begin 
  ... 
  MkDir('C:\TEST'); 
  ... 
End.

1
2
3
4
5
6
7
8
9
  
Uses 
  Dos; 
  
Begin 
  ... 
  RmDir('C:\TEST'); 
  ... 
End.

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
  
Uses 
  Dos; 
  
Procedure Deltree (Path : string); 
Var 
  S : SearchRec; 
  f : File; 
  L : Byte; 
Begin 
  { On fait en sorte que le chemin ne se termine pas par '\' } 
  L := Length(Path); 
  if Path[L] = '\' then Delete(Path,L,1); 
  
  { On recherche tous les fichiers possibles } 
  FindFirst(Path + '\*.*', ReadOnly or SysFile or Archive or Directory, S); 
  while DosError = 0 do 
  begin 
    { Si c'est un répertoire (sauf . et ..), on le supprime } 
    if S.Attr and Directory <> 0 then 
      begin 
        if (S.Name <> '.') and (S.Name <> '..') then 
        Deltree(Path + '\' + S.Name); 
      end 
    else 
      begin 
        { Sinon, il s'agit d'un fichier, que l'on va supprimer } 
        Assign(f,Path + '\' + S.Name); 
        { On le passe en Archive, sinon, on ne peut pas le supprimer } 
        SetFAttr(f,Archive); 
        { On le supprime } 
        Erase(f); 
      end; 
  
    { On passe au fichier suivant } 
    FindNext(S); 
  end; 
  
  { Si vous n'utilisez pas Turbo Pascal, ajoutez la ligne : } 
  { FindClose(S); } 
  
  { On supprime le répertoire vide } 
  RmDir(Path); 
End; 
  
Begin 
  Deltree('C:\TEST'); 
End.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
  
Program VolumeDisque; 
Uses 
  Dos; 
  
Var 
  S : SearchRec; 
  
Begin 
  FindFirst('C:\',VolumeID,S); 
  if DosError = 0 then 
  begin 
    WriteLn('C: [', S.Name, ']'); 
    FindClose(S);  { Supprimez cette ligne si vous compilez en Turbo Pascal } 
  end; 
End.