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

SystemWin - 10 juin 2013 à 15:29 - Dernière réponse : cs_cantador 4996 Messages postés dimanche 26 février 2006Date d'inscriptionModérateurStatut 27 mars 2018 Dernière intervention
- 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 

Votre réponse

2 réponses

Meilleure réponse
cs_cantador 4996 Messages postés dimanche 26 février 2006Date d'inscriptionModérateurStatut 27 mars 2018 Dernière intervention - 11 juin 2013 à 16:34
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

Merci cs_cantador 3

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 89 internautes ce mois-ci

Commenter la réponse de cs_cantador
SystemWin - 11 juin 2013 à 15:34
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

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.