Adapter ce code source sans thread

Bonjour a tous,

voila je suis en train de comprendre ce code source qui na pas de commentaire :? je suis perdu

Ce code source consiste à scanner le registre ; je n'arrive pas à comprendre la méthode car manque de commentaire :?

Code:

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
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
interface
 
uses
Windows, SysUtils, Classes, Registry, dialogs, ShlObj;
 
 
type
  TCleanThread = class(TThread)
 
  private
    Procedure GetSub(Node,NodeKey: String; Root: Cardinal);
    Procedure RegRecurseScan(ANode: String; Key, OldKey: string; Level: Integer);
 
{-----------------------------------------------------------------------}
 
  protected
    procedure Execute; override;
 
{-----------------------------------------------------------------------}
 
  public
    Root: Cardinal;
    Key: String;
    scanning: boolean;
    InvExt: Boolean;
    InvFlp: Boolean;
  end;
 
{-----------------------------------------------------------------------}
 
var
FReg,reg: TRegistry;
 
 
implementation
 
uses MainFrm;
 
{-----------------------------------------------------------------------}
 
function FixupPath(Key: string): string;
begin
  if Key = '' then
    Result := '\'
  else
  if AnsiLastChar(Key) <> '\' then
    Result := Key + '\'
  else
    Result := Key;
  if Length(Result) > 1 then
    if (Result[1] = '\') and (Result[2] = '\') then
      Result := Copy(Result, 2, Length(Result));
end;
 
{-----------------------------------------------------------------------}
 
function GetPreviousKey(Key: string): string;
var
  I: Integer;
begin
  Result := Key;
  if (Result = '') or (Result = '\') then Exit;
  for I := Length(Result) - 1 downto 1 do
    if Result[I] = '\' then
    begin
      Result := Copy(Result,1,I - 1);
      Exit;
    end;
end;
 
{-----------------------------------------------------------------------}
 
Function DelExt(Fname: String): String;
var
 TmpStr, Ext: String;
 Ps: integer;
begin
 Ext := ExtractFileExt(Fname);
 ps := pos(ext,Fname);
 tmpstr := Fname;
 if ps <> 0 then
 begin
  Delete(TmpStr,ps,length(TmpStr)-ps+1);
 end;
Result := TmpStr;
end;
 
{-----------------------------------------------------------------------}
 
Function isPath(Param: string; var FormatPath: String): boolean;
var
 Fname,Str,Dir,Ext,Name, TempStr: String;
 Ps,Len,i: integer;
 Bol, ValidName: Boolean;
begin
 ValidName := true;
 Bol := False;
 Result := False;
 Fname := Param;
 Dir := '';
 Name := '';
 Ext := '';
 Dir := ExtractFileDrive(Fname);
 Name := ExtractFileName(Fname);
 Ext := ExtractFileExt(Fname);
try
 ps := Pos(' ',Ext);
 if ps <> 0 then
  begin
   Delete(Ext,ps,length(ext)-ps+1)
  end;
except
end;
 
 try
 ps := Pos('!',Ext);
 if ps <> 0 then
  begin
   Delete(Ext,ps,length(Ext)-ps+1)
  end;
except
end;
 
 try
 ps := Pos(',',Ext);
 if ps <> 0 then
 begin
  Delete(Ext,ps,length(Ext)-ps+1)
 end;
except
end;
 
 try
 ps := Pos('^',Name);
 if ps <> 0 then
  begin
   Delete(Name,ps,length(Name)-ps+1)
  end;
except
end;
 
 try
 ps := Pos('%',Name);
 if ps <> 0 then
  begin
   Delete(Name,ps,length(Name)-ps+1)
 end;
except
end;
 
 try
 tempstr := Param;
 if pos(':\',tempstr) <> 0 then
  Delete(tempstr,pos(':\',tempstr),2);
 if pos(':\',tempstr) <> 0 then
  ValidName := False;
except
end;
 
if pos('|',Fname) <> 0 then ValidName := False;
if pos('=',Fname) <> 0 then ValidName := False;
if pos('*',Fname) <> 0 then ValidName := False;
if pos('/',Name) <> 0 then ValidName := False;
if pos('\',Name) <> 0 then ValidName := False;
if pos('/',Name) <> 0 then ValidName := False;
if pos('"',Name) <> 0 then ValidName := False;
 
Ps := length(Fname);
 try
  if Fname[ps] = '.' then
   Bol := true;
except
end;
 
if Length(Fname) > 3 then
if Fname[2] = ':' then if Fname[3] = '\' then if ValidName = True then
if (Dir <> '') and (Name <> '') and (Ext <> '') then begin
  Result := true;
  if Bol = False then
  FormatPath := ExtractFilePath(Fname)+DelExt(ExtractFileName(Name))+Ext
  else
  FormatPath := ExtractFilePath(Fname)+ExtractFileName(Name);
end;
end;
 
{-----------------------------------------------------------------------}
 
Procedure TCleanThread.GetSub(Node,NodeKey: String; Root: Cardinal);
var
 s,v,tmp: string;
 KeyInfo : TRegKeyInfo;
 ValueNames,Strtemp : TStringList;
 i,sn : Integer;
 DataType : TRegDataType;
 reg : TRegistry;
begin
if scanning = False then Exit;
 s:= Node;
 reg := TRegistry.Create;
 reg.RootKey :=Root;
 if not reg.OpenKeyReadOnly(s) then Exit;
 reg.GetKeyInfo(KeyInfo);
 if (KeyInfo.NumValues<=0) and (Root <> HKEY_CLASSES_ROOT) then Exit;
 ValueNames := TStringList.Create;
 reg.GetValueNames(ValueNames);
   if reg.RootKey = HKEY_CLASSES_ROOT then begin
   Strtemp := TStringList.Create;
   reg.GetKeyNames(Strtemp);
   if NodeKey[1] = '.' then begin
   if ValueNames.Count-1 = -1 then
   if Strtemp.Count-1 = -1 then
   if '\'+NodeKey = Node then
   with MainForm.ListView1.Items.Add do begin
    Caption := '---';
    SubItems.Add(NodeKey);
    SubItems.Add('HKCR');
    SubItems.Add(Node);
    SubItems.Add('');
   end;
   end;
   Strtemp.Free;
   exit;
   end;
 
 for i := 0 to ValueNames.Count-1 do
 begin
   if reg.GetDataType(ValueNames[i]) = rdString then
    begin
     s := reg.ReadString(ValueNames[i]);
     tmp := S;
    end;
   if (S <> '') and (S[1] <> 'A') and (S[1] <> 'a') then
   if FileExists(S) = false then
   if IsPath(S,S) = true then
    begin
     V := ExtractFileExt(S);
    end;
   if V <> '' then begin
   if DirectoryExists(S) = False then
   if FileExists(S) = false then
   with MainForm.ListView1.Items.Add do
    begin
    if (reg.RootKey =HKEY_CURRENT_USER ) or (reg.RootKey = HKEY_LOCAL_MACHINE ) then
      begin
       Caption := '---';
       SubItems.Add(tmp);
       if Root =HKEY_CURRENT_USER then
        SubItems.Add('HKCU') else
       if Root =HKEY_LOCAL_MACHINE then
        SubItems.Add('HKLM');
        SubItems.Add(Node);
        SubItems.Add(ValueNames[i]);
      end;
   end;
 end;
 end;
 ValueNames.Free;
 reg.Free;
end;
 
{-----------------------------------------------------------------------}
 
Procedure TCleanThread.RegRecurseScan(ANode: String; Key, OldKey: string; Level: Integer);
var
  AStrings: TStringList;
  I: Integer;
  AKey: string;
begin
if scanning = False then Exit;
  AKey := FixupPath(OldKey);
  if FReg.OpenKeyReadOnly(Key) and FReg.HasSubKeys then
  begin
    if Level = 1 then
    begin
      AStrings := TStringList.Create;
      try
        FReg.GetKeyNames(AStrings);
        for I := 0 to AStrings.Count - 1 do
        begin
        if scanning = False then Exit;
          if AStrings[I] = '' then
            AStrings[I] := Format('%.04d', [I]);
          GetSub(ANode+'\'+AStrings[I],AStrings[I],FReg.RootKey);
          if Freg.RootKey <> HKEY_CLASSES_ROOT then
          RegRecurseScan(ANode+'\'+AStrings[I], AStrings[I], AKey + Key, Level);
        end;
      finally
        AStrings.Free;
      end;
    end;
  end;
  FReg.OpenKeyReadOnly(AKey);
end;
 
{-----------------------------------------------------------------------}
 
Procedure TCleanThread.Execute;
begin
 Scanning := True;
 if InvExt = True then begin
  FReg := TRegistry.Create;
  FReg.RootKey := HKEY_CLASSES_ROOT;
  RegRecurseScan('','','',1);
  FReg.Free;
end;
 if InvFlp = True then begin
  FReg := TRegistry.Create;
  FReg.RootKey := HKEY_LOCAL_MACHINE;
  RegRecurseScan('\SOFTWARE','\SOFTWARE','',1);
  FReg.Free;
end;
 if InvFlp = True then begin
  FReg := TRegistry.Create;
  FReg.RootKey := HKEY_CURRENT_USER;
  RegRecurseScan('\SOFTWARE','\SOFTWARE','',1);
  FReg.Free;
end;
Scanning := False;
MainForm.Button1.Enabled := True;
showmessage(Inttostr(MainForm.ListView1.Items.Count));
end;
 
end.

Y a-t-il une façon de faire plus simple ?

Merci de votre réponse :ccool:

mis à part qu'il accède à la VCL depuis un thread (ce qu'il ne faut pas faire), ce code parcourt le Registre dans une procédure récursive pour alimenter une ListView.

Que cherches-tu à faire ?

Rep

Tout d'abord, merci de ton aide :ccool:

A reconstituer ce code source sans le thread.

Citation:

Envoyé par Gregory666

Tout d'abord, merci de ton aide :ccool:

A reconstituer ce code source sans le thread.

Il te suffit de déplacer tout le code du thread que tu as sous les yeux dans autant de procédures à créer dans ton mainform (celui que tu prends en "uses" et où se trouve ton bouton "button1").

Puis au lieu d'appeler l'execute de ton objet de type TCleanThread, ben tu appeles la procédure correspondant au code de l'execute du TCleanThread (la nouvelle donc, celle du mainform que tu auras créée).

Tu peux garder de côté le code de TCleanThread des fois que tu te gauffres afin de pouvoir repartir clean. Il te suffiras de mettre en commentaire l'appel à l'objet TCleanThread utilisé jusqu'ici.

Salut

tu supprimes le lien d'héritage entre TThread et TCleanThread :

- en supprimant TThread dans la déclaration

Code:

TCleanThread = class //(TThread)

- en transformant Execute en méthode "non virtuelle"

Code:

procedure Execute; // override;

C'est un peu cavalier, mais bon. Pour exécuter le code, tu crées un objet TCleanThread et tu appelles Execute dessus. Comme ça, tu limites ton effort mais testes bien le programme quand même.

@+

Citation:

Envoyé par e-ric

Salut

tu supprimes le lien d'héritage entre TThread et TCleanThread :

- en supprimant TThread dans la déclaration

Code:

TCleanThread = class //(TThread)

@+

Ne vaut il pas mieux qu'il fasse :

Code:

TCleanThread = class (TObject)

plutôt ?

comme ça pas besoin de déclarer de constructeur ?

Si la classe ancêtre n'est pas spécifiée, TObject est implicitement l'ancêtre, tu peux le préciser ou non. Je ne vois pas où est le problème avec le constructeur.

Cdlt

Citation:

Envoyé par e-ric

Si la classe ancêtre n'est pas spécifiée, TObject est implicitement l'ancêtre, tu peux le préciser ou non. Je ne vois pas où est le problème avec le constructeur.

Cdlt

OK, autant pour moi (ou au temps pour moi pour froisser personne). :ccool:

Bonjour a tous,

C'est un vrai bordel se code source entre les variables qui ne serre a rien exemple pour la function (isPath = var FormatPath) on passe une variable
en paramètre mais elle m'est déclaré dans aucune procedure ou function :Koi: aussi pour la procedure (GetSub = var DataType) cette variable n'est jamais
utilisé.

Je pense qu'il y a beaucoup de ligne a supprimer ou a modifier dans se code source.

Mon but et ma méthode

C'est de scanner le registre a la rechercher de clé du type (rdString) = a 'C:\???\' + une (*.Extension) en suite de vérifier chaque chemin (Not FileExists)
on affiche le chemin de la clé + le chemin du fichier ( Résultat la clé peu étre supprimer 'Clé registre invalide : Fichier introuvable' ).

Sa fait 2 jours que j'essaye de comprendre la méthode de se code mais en vin.

Merci de votre aide.

ok, ben maintenant qu'on connait la question on peut donner une réponse :)

le principe est le même que parcourir des répertoires, tu ouvres un TRegistry sur le chemin de départ, tu regardes s'il y a des valeurs (FReg.GetValueNames) qui correspondent à des fichiers , puis tu regardes s'il y a des sous-clés (FReg.GetKeyNames) sur lesquelles tu relances la procédure récursivement.

ton code va donc scanner (HKEY_LOCALMACHINE, '\Software'), puis (HKEY_LOCALMACHINE, '\Software\Microsoft'), puis (HKEY_LOCALMACHINE, '\Software\Microsoft\Windows') etc...tout cela avec un appel de Scan(Root, Path) qui s'appelle lui-même sous la forme Scan(Root, Path + '\' + KeyNames[i]);