SystemWin
-
10 juin 2013 à 15:29
cs_cantador
Messages postés4720Date d'inscriptiondimanche 26 février 2006StatutModérateurDernière intervention31 juillet 2021
-
11 juin 2013 à 16:34
Bonjour a tous,
voila je suis en train de comprendre se code source qui na pas de commentaire je suis perdu
Se code source consiste a scanner le registre je n'arrive pas a compendre la méthode car manque de commentaire
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.
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.