Le registre aura ma peauRésolu

Question

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.

solilog · Accepted Answer

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

SystemWin · Answer

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;

korgis · Answer

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)...

korgis · Answer

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é...

SystemWin · Answer

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.

korgis · Answer

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...

Le registre aura ma peau

6 réponses

Votre réponse

Discussions similaires