Discussion :

[Gregory666]

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.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
if Root <> '' then
    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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
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.

[Gregory666]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
//------------------------------------------------------------------------------
// 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;

[GoustiFruit]

Quelle est la question ?

[Gregory666]

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 ["]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
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.

[GoustiFruit]

Peut-être quelque chose dans le genre:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
uses
  (* ... *)
  SysUtils;
 
(* ... *)
 
var
  (* ... *)
  iStartPos, iEndPos: Integer;
begin
  (* ... *)
  iStartPos := Pos('C:\', Root);  
  if (iStartPos = 1) or (iStartPos = 2) then begin
    StringReplace(Root, '\\', '\', [rfReplaceAll, rfIgnoreCase]);
    iEndPos := LastDelimiter('"/-,;', Root);
    if iEndPos = 0 then
      iEndPos := Length(Root) + 1;
    Root := Copy(Root, iStartPos, iEndPos - 1);
 
    Ext := ExtractFileExt(Root);
    (* ... *)
  end;
(* ... *)
end;