REMDIR & MKTREE [Sources]

**Eric2a** · 25/12/2010, 21h21

Deux petits cousins de XDEL : REMDIR et MKTREE.

REMDIR
Supprime un répertoire et tous les sous-répertoires qu'il contient

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
REMDIR [/Options] [Lecteur:]Chemin
 
	[Lecteur:]Chemin   Répertoire(s) à supprimer
 
	Options :
 
		/P     Désactive la demande de confirmation avant suppression

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Uses Dos,Crt;
 
Var
 Dir:Array[1..16]Of DirStr;
 Z:Byte;
 Rep:ComStr;
 NDir:Word;
 ConfirmFlag:Boolean;
 
Procedure GetCmd;
Var
 S:ComStr;
 I:Byte;
 
Procedure Erreur(Txt:String);
Begin
 WriteLn(Txt);
 Halt(1);
End;
 
Procedure GetSwithes;
Const
 Swith:Array[1..2]Of Char=('?','P');
 
Var Z,P:Byte;
 
Begin
 Delete(S,1,1);
 For Z:=1To Length(S)Do S[Z]:=UpCase(S[Z]);
 For Z:=1To 2Do If S=Swith[Z]Then P:=Z;
 Case P Of
  1:
  Begin
   WriteLn('Supprime un répertoire et tous les sous-répertoires qu''il contient'#13#10);
   WriteLn('REMDIR [/Options] [Lecteur:]Chemin'#13#10);
   WriteLn('       [Lecteur:]Chemin   Répertoire(s) à supprimer');
   WriteLn('Options :'#13#10);
   WriteLn(' /P     Désactive la demande de confirmation avant suppression');
   Halt(1);
  End;
  2:ConfirmFlag:=TRUE;
  Else Erreur('Commutateur non valide - /'+S);
  End;
End;
 
Procedure GetDirectory;
Var
 F:File;
 Attr:Word;
 D:DirStr;
 N:NameStr;
 E:ExtStr;
 
Begin
 S:=FExpand(S);
 If S[Length(S)]<>'\'Then
     Begin
      Assign(F,S);
      GetFAttr(F,Attr);
      If(DosError=0)And(Attr And Directory<>0)Then S:=S+'\';
     End;
 FSplit(S,D,N,E);
 Inc(NDir);
 Dir[NDir]:=D;
 Dec(Dir[NDir][0]);
End;
 
Begin
 If ParamCount=0Then Erreur('Paramètre requis manquant');
 For I:=1To ParamCount Do
     Begin
      S:=ParamStr(I);
      If S[1]='/'Then GetSwithes Else GetDirectory;
     End;
 If NDir=0Then Erreur('Veuillez spécifier le sous-répertoire à supprimer');
End;
 
{$I-}
Procedure RemDir(Const Path:DirStr);
Var
 DTA:SearchRec;
 Dir:DirStr;
 
Procedure RDChild(Const P:DirStr);
Var
 DTA:SearchRec;
 F:File;
 
Begin
 FindFirst(P+'\*.*',Archive+SysFile+Hidden+ReadOnly,DTA);
 While DosError=0Do
       Begin
        FileMode:=0;
        Assign(F,P+'\'+DTA.Name);
        Reset(F);
        DosError:=IOResult; If DosError<>0Then Exit;
        Close(F);
        DosError:=IOResult; If DosError<>0Then Exit;
        If DTA.Attr And ReadOnly>0Then SetFAttr(F,DTA.Attr Xor ReadOnly);
        If DosError=0Then
           Begin
            Erase(F);
            DosError:=IOResult
           End;
        If DosError<>0Then Exit;
        FindNext(DTA);
       End;
 
 If DosError=18Then
    Begin
     RmDir(P);
     DosError:=IOResult;
    End;
End;
 
Begin
 FindFirst(Path+'\*.*',Directory+Hidden,DTA);
 If DosError=3Then Exit;
 While DosError=0Do
       Begin
        If ((DTA.Attr And Directory)>0)And(DTA.Name[1]<>'.')Then
           RemDir(Path+'\'+DTA.Name);
        FindNext(DTA);
       End;
 RDChild(Path);
End;
 
Begin
 WriteLn('REMDIR v1.0, Février 1994, Eric GARIDACCI'#13#10);
 GetCmd;
 For Z:=1To NDir Do
     Begin
      Write('Suppression de ',Dir[Z],' ? (O/N) ');
      ReadLn(Rep);
      WriteLn;
      If (Length(Rep)=1)And(UpCase(Rep[1])='O')Then
         Begin
          RemDir(Dir[Z]);
          Write(Dir[Z]);
          If DosError<>0Then Write('  Erreur ',DosError);
          WriteLn;
         End;
     End;
End.

MKTREE
Création de répertoires

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Uses Dos;
 
Var Rep:String;
 
{***********************************************************************}
{	Renvoie TRUE si Name est un nom de répertoire valide		}
{***********************************************************************}
 
Function DirectoryValid(Const Name:String):Boolean;Assembler;
Var
 TempName:Array[0..255]Of Char;
 
Asm
	PUSH	DS
	LDS	SI,Name
	LEA	DI,TempName
	MOV	DX,DI
	PUSH	SS
	POP	ES
	CLD
	XOR	AH,AH
	LODSB
	XCHG	AX,CX
	REP	MOVSB
	XOR	AL,AL
	STOSB
	PUSH	SS
	POP	DS
	MOV	AX,4300H
	INT	21H
	MOV	DL,0
	JB	@@1
	XOR	AX,AX
	TEST	CL,Directory
	JZ	@@1
	INC	DL
@@1:	POP	DS
	MOV	DosError,AX
	XCHG	AL,DL
End;
 
{***********************************************************************}
{	Création d'un répertoire					}
{***********************************************************************}
 
Procedure MakeDirectory(Const Name:String);Assembler;
Var
 TempName:Array[0..255]Of Char;
 
Asm
	PUSH	DS
	LDS	SI,Name
	LEA	DI,TempName
	MOV	DX,DI
	PUSH	SS
	POP	ES
	CLD
	XOR	AH,AH
	LODSB
	XCHG	AX,CX
	REP	MOVSB
	XOR	AL,AL
	STOSB
	PUSH	SS
	POP	DS
	MOV	AH,39H
	INT	21H
	JB	@Ret
	XOR	AX,AX
@Ret:	POP	DS
	MOV	DosError,AX
End;
 
{***********************************************************************}
{	Création d'un/de plusieurs répertoire(s) désigné par Name	}
{***********************************************************************}
 
 
Procedure WritePath(Const Path:String);Far;
Begin
 WriteLn(#13,'Création de ',Path)
End;
 
Const MkDirProc:Procedure(Const Path:String)=WritePath;
 
Procedure MakeTree(Var Name:String);Assembler;
Asm
	LES	DI,Name
	CMP	BYTE PTR ES:[DI],1 { Au moins un caractère }
	JB	@@3
	PUSH	ES
	PUSH	DI
	CALL	DirectoryValid
	OR	AL,AL
	JNZ	@@2
	CMP	DosError,3
	MOV	DosError,0
	JNZ	@@2
 
	LES	DI,Name
	MOV	AX,ES:[DI]
	PUSH	AX			{ Sauve la taille de Name }
	XOR	AH,AH
	ADD	DI,AX
	XCHG	AX,CX
	JCXZ	@@1
	STD
	MOV	AL,'\'
	REPNE	SCASB
	CLD
@@1:	LES	DI,Name
	MOV	BYTE PTR ES:[DI],CL
	PUSH	ES
	PUSH	DI
	CALL	MakeTree
	LES	DI,Name
	POP	WORD PTR ES:[DI]	{ Restore la taille de Name }
 
@@2:	CMP	DosError,0
	JNZ	@@3
	LES	DI,Name
	PUSH	ES
	PUSH	DI
	PUSH	ES
	PUSH	DI
	CALL	MkDirProc
	CALL	MakeDirectory
@@3:
End;
 
{***********************************************************************}
{	Programme principal						}
{***********************************************************************}
 
Begin
 WriteLn('MKTREE 1.0, Août 1997, Eric GARIDACCI'#13#10);
 If ParamCount<>1Then
    Begin
     WriteLn('MKTREE répértoire');
     Halt
    End;
 
 Rep:=ParamStr(1);
 
 MakeTree(Rep);
 WriteLn;
 If DosError<>0Then WriteLn('Erreur ',DosError)
End.