Perdu dans se code source :-( [Résolu]

- - Dernière réponse : cs_cantador
Messages postés
4716
Date d'inscription
dimanche 26 février 2006
Statut
Modérateur
Dernière intervention
27 mars 2018
- 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.


Merci de votre réponse.
Afficher la suite 

2 réponses

Meilleure réponse
Messages postés
4716
Date d'inscription
dimanche 26 février 2006
Statut
Modérateur
Dernière intervention
27 mars 2018
9
3
Merci
Bonjour,

C'est de scanner le registre a la rechercher de clé

l'équivalent de la recherche de Regedit..

mais en vin.

faut pas trop boire pour ça..

il faut créer un objet de la classe TRegistry:
var 
  Registre: TRegistry; 
begin 
  Registre := TRegistry.Create;


après,il suffit de se servir des méthodes attachées à celui-ci
pour coder ce que tu veux faire :

rechercher une clé
rechercher une valeur de clé
supprimer une clé etc.

à la tienne !

cantador

Dire « Merci » 3

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources 190 internautes nous ont dit merci ce mois-ci

Commenter la réponse de cs_cantador
0
Merci
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.
Commenter la réponse de SystemWin