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 suppressionMKTREE
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.
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.
Partager