Le registre aura ma peau [Résolu]

Signaler
-
Messages postés
273
Date d'inscription
samedi 13 juin 2009
Statut
Membre
Dernière intervention
18 avril 2015
-
Bonjour a tous les développeurs,

Je suis confronté à un casse-tête chinois.
J'ai une function qui scan le registre a la recherche de clé type string.
J'ai une condition de rechercher.
--> Root := La valeur type string.
if (Pos('C:\', Root) = 1) or (Pos('"C:\', Root) = 1) or (Pos('@C:\', Root) = 1)  then


J'ai besoin d'extraire la chaîne de caractére sans les délémiteurs puis de teste son existence.

--> [xxxxx] := Chaîne de caractére type commande.
Exemple extraction d'une chaîne avec délimiteur : ["] : "C:\X---\X---\X---\X-.Extension" + xxxxx

Var
        I : Integer;
        root,CopyRoot,ext : String;
       begin
        if pos('"C:\',root) = 1 then
         delete(root,1,1);
         for I := 0 to Length(Root) do
         if pos('"',root[I]) > 0 then
          CopyRoot := Copy(Root,0, I -1);
          Ext := ExtractFileExt(CopyRoot);
          if Ext '' then // Si ext '' alor c'est un répertoire
           begin
             if not DirectoryExists(Copyroot) then
             // Si le répertoire n'existe pas on l'affiche
           end
          else // Sauf si ext <> '' c'est un fichier
           if not FileExists (Copyroot) then
           // Si le fichier n'existe pas on l'affiche
       end;


// Extension inconnue sans délimiteur --> // Probléme N°1
C:\X---\X---.10\X---\X-.Extension + xxxxx sans délimiteur entre l'extension et la Chaîne de caractére type commande.

// Extension inconnue avec délimiteur : [,]
@C:\X---\X---\X---\X-.Extension, + xxxxx

// Extension inconnue avec délimiteur : ["]
"C:\X---\X---\X---\X-.Extension" + xxxxx

// Extension inconnue avec délimiteur : [,]
C:\X---\X---\X---\X-.Extension, + xxxxx

// Extension inconnue avec délimiteur : [;]
C:\X---\X---\X---\X-.Extension; + xxxxx

// Extension inconnue avec délimiteur : [/]
C:\X---\X---\X---\X-.Extension/ + xxxxx

// Extension inconnue avec délimiteur : [-]
C:\X---\X---\X---\X-.Extension + -xxxxx

// Extension inconnue avec délimiteur : [,] mais avec 2 [backslash[\] --> // Probléme N°2
@C:\X---\X---\X---\\X-.Extension, + xxxxx


Merci de votre réponse.

6 réponses

Messages postés
273
Date d'inscription
samedi 13 juin 2009
Statut
Membre
Dernière intervention
18 avril 2015
9
Bonsoir,
ceci devrait t'aider:
function MyExtract( source:string;
                    var fName : string;
                    var cmd   : string ) : boolean;
var p1, p2 :integer;
begin
   source:=  trim(source);
   p1:= pos('"', source);          // recherche 1er car "
   delete( source, 1, p1 );        // on le vire, si 0, rien à virer
   if p1>0 then                    // si 1er était "
      p2 := pos('"', source)       //    on rech le 2ème si pas trouvé
   else
      p2 := pos(' ', source);      // sinon, rech 1er espace après fName
   fName := copy(source, 1, p2-1);
   delete( source, 1, p2);
   cmd := trim(source);
   result := fileexists( fName );
end;

Ah, petit détail. Un string commence à 1 pas à 0 contrairement aux pchar. Fais des copy(S, 1, ...°, pas copy(s, 0, ...).

Bonne soirée.
solilog
Code source :
//------------------------------------------------------------------------------
// Construction de l'objet TRegistry
procedure TFRegistry.FormCreate(Sender: TObject);
begin {On Crée un objet TRegistry}
  Regedit := TRegistry.Create;
end;
//------------------------------------------------------------------------------
// Scan Registre [O.S]
procedure TFRegistry.ScanRegistre(Key: String);
var {TStringList est la classe, List l'objet}
  List: TStringList;
  VarI: Integer;
begin {Arret du scan}
  if StopScan = True then Exit;
  if Regedit.OpenKeyReadOnly(Key) then
  try {On appelle le constructeur pour allouer la mémoire}
    List := TStringList.Create;
    try {On déterminer les noms de toutes les sous-clés de la clé en cours}
      Regedit.GetValueNames(List);
      for VarI := 0 to List.Count - 1 do
      begin {Appel de procedure : ValideData}
        ValideData(Key, List.Strings[VarI], '');
        {Si la clé List.Strings[I] est du type chaîne}
        if Regedit.GetDataType(List.Strings[VarI]) in [rdString] then
        {Appel de procedure : ValideData}
          ValideData(Key, List.Strings[VarI], Regedit.ReadString(List.Strings[VarI]));
      end;
      {On efface la liste}
      List.Clear;
      {On déterminer les noms de toutes les sous-clés de la clé en cours}
      Regedit.GetKeyNames(List);
      for VarI := 0 to List.Count - 1 do
        if List.Strings[VarI] <> '' then
          ScanRegistre(Key + '\' + List.Strings[VarI]);
    finally
      {On libérer la mémoire de l'objet}
      List.Free;
    end;
  finally
    {On ferme la clé}
    Regedit.CloseKey;
  end;
end;
//------------------------------------------------------------------------------
// Bt : Scan
procedure TFRegistry.BtScanClick(Sender: TObject);
begin
  TotalP := 0;
  FLast := 0;
  try
    begin {Information}
      Statut.Panels.Items[2].Text := 'Scan en cour ...';
      {Arret du scan = False}
      StopScan := False;
      {On efface la liste}
      Listview.Clear;
      {On définit la clé [Données liées à la configuration de la machine.]}
      Regedit.RootKey := HKEY_LOCAL_MACHINE;
      {Appel de procedure : ScanRegistre}
      ScanRegistre('');
    end;
  finally {Information}
    Statut.Panels.Items[2].Text := 'Fin du scan';
  end;
end;
//------------------------------------------------------------------------------
// Validation de la recherche
procedure TFRegistry.ValideData(const Key, Value, Root: String);
const
  ChTotal = 'Nombre total : ';
  ChTotalTrv = 'Total de fichier trouvé : ';
var
  TmpStr: String;
begin
  Inc(TotalP);
  if TotalP - FLast > 500 then
  begin
    FLast := TotalP;
    Statut.Panels.Items[0].Text := ChTotal + IntToStr(TotalP);
    Statut.Panels.Items[1].Text := ChTotalTrv + IntToStr(Listview.Items.Count);
    TmpStr := Key;
    if Value <> '' then
     TmpStr := TmpStr + ' {' + Value + '}';
     ChKey.Caption := 'HKEY_LOCAL_MACHINE' + TmpStr;
     Application.ProcessMessages;
  end;
  if Root <> 'C:\' then // On élimine 'C:\'
    if (Pos('C:\', Root) = 1) or (Pos('"C:\', Root) = 1) or (Pos('@C:\', Root) = 1)  then

|--->> Extraction << ---| 

end;
//------------------------------------------------------------------------------
// Arret du scan
procedure TFRegistry.BtStopClick(Sender: TObject);
begin
  StopScan := True;
end;
//------------------------------------------------------------------------------
// Destruction de l'objet TRegistry
procedure TFRegistry.FormDestroy(Sender: TObject);
begin {On détruit l'objet TRegistry}
  Regedit.Free;
end;
Messages postés
420
Date d'inscription
samedi 17 mai 2003
Statut
Membre
Dernière intervention
6 mai 2019
15
Salut,
j'ai pas bien compris le problème...
Mais viteuf, là, quand tu codes :
if (Pos('C:\', Root) = 1) or (Pos('"C:\', Root) = 1) or (Pos('@C:\', Root) = 1)  then

les 2ème et 3ème conditions sont inutiles :
car si elles sont vraies, la première l'est aussi (obligatoirement)...
Messages postés
420
Date d'inscription
samedi 17 mai 2003
Statut
Membre
Dernière intervention
6 mai 2019
15
J'avais écrit :
les 2ème et 3ème conditions sont inutiles :
car si elles sont vraies, la première l'est aussi (obligatoirement)...

Et je viens de m'apercevoir que j'ai dit une couennerie !!!
Au lieu de
(Pos('C:\', Root) = 1)

j'avais "interprété"
(Pos('C:\', Root) <> 0)

Je retire donc ce que j'affirmais dans le post précédent.
Désolé...
Bonjour
mon probléme c'est que je recherche extraitre chaque valeur
"C:\X---\X---\X---\X-.Extension" + xxxxx en C:\X---\X---\X---\X-.Extension

Je ne veu pas répété 7 a 8 fois cette partir en function des délimiteurs [ pos('"C:\',root) = 1] [ pos('@C:\',root) = 1] ...

Exemple pour l'extraction du chaîne avec délémiteur ["]

Var
        I : Integer;
        root,CopyRoot,ext : String;
       begin
        if pos('"C:\',root) = 1 then
         delete(root,1,1);
         for I := 0 to Length(Root) do
         if pos('"',root[I]) > 0 then
          CopyRoot := Copy(Root,0, I -1);
          Ext := ExtractFileExt(CopyRoot);
          if Ext '' then // Si ext '' alor c'est un répertoire
           begin
             if not DirectoryExists(Copyroot) then
             // Si le répertoire n'existe pas on l'affiche
           end
          else // Sauf si ext <> '' c'est un fichier
           if not FileExists (Copyroot) then
           // Si le fichier n'existe pas on l'affiche
       end;


Merci de votre réponse.
Messages postés
420
Date d'inscription
samedi 17 mai 2003
Statut
Membre
Dernière intervention
6 mai 2019
15
Oui, je vois ce que tu veux faire.
Tu peux peut-être utiliser les expressions régulières.
Sinon, voici un bout de code qui extrait le FileName, selon ton cahier des charges :
function GetFileName(s: string): string;
const
  Unauthorized = ['/', ';', ',', '"', '-'];
var
  PosColon, PosSpace: Integer;
begin
  PosColon := Pos(':', s);
  PosSpace := Pos(' ', s);
  Result := Copy(s, PosColon - 1, PosSpace - PosColon + 1);
  Result := StringReplace(Result, '\\', '\', [rfReplaceAll]);
  if Result[Length(Result)] in Unauthorized then
    Delete(Result, Length(Result), 1);
end;

C'est du vite fait, il faut peut-être compléter les chars "unauthorized" et tester un peu plus à fond, mais à priori ça fonctionne.
Si ça peut dépanner...