Discussion :

[fartoto_dz2004]

salut pour tous je cherche une fonction qui cherche une valeur hexa (par ex:longword $FFE6ABC9) dans un fichier binaire, jai trouver des fontions pour chercher des strings mes ce n'est pas fiable.
j'attends votre aide et merci bcp @+

[Mac LAK]

Ben cela dépend de l'endianness des données dans le fichier, pour commencer...

Ensuite, il te faut en fait chercher ta valeur via une machine à états, voilà un exemple :

Code Delphi :

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
// Retourne la position d'un entier 32 bits dans un fichier binaire.
// -1 si la valeur n'est pas trouvée.
// On peut spécifier la position de départ dans le fichier.
Function FindBinaryInFile ( Const Filename : String ; Const Pattern32 : Cardinal ; Const StartPosition : Int64 = 0 ) : Int64 ;
Var
   F        : TFileStream ;
   I, T     : Int64 ;
   K        : Integer ;
   V        : Byte ;
   Step     : Integer ;
   Pattern  : Array[0..3] Of Byte ;
   LPattern : Cardinal ;
Begin
     // Ouverture du fichier.
     F:=TFileStream.Create(FileName,fmOpenRead);
     Result:=-1 ;
     I:=StartPosition ;
     F.Seek(I,soBeginning);
     T:=F.Size ;
     Step:=0 ;
     // Extraction du chiffre et du motif.
     LPattern:=Pattern32 ;
     For K:=0 To 3 Do
         Begin
         Pattern[K]:=LPattern And 255 ;
         LPattern:=LPattern Shr 8 ;
         End;
     // Début de recherche.
     While (I<T) Do
           Begin
           // On lit octet par octet.
           F.Read(V,SizeOf(V));
           // On vérifie si l'on est en train de reconnaître l'entier ou pas.
           Case Step Of
                // Cas de base : on a trouvé le premier octet, on mémorise la position.
                0 :  If V=Pattern[0] Then
                        Begin
                        Inc(Step);
                        Result:=I;
                        End;
                // Si l'on a commencé à "trouver", alors on vérifie que l'on
                // est bien toujours dans la bonne séquence.
                Else If V=Pattern[Step] Then
                        Inc(Step)
                     // Sinon, on annule le compteur de recherche.
                     Else Begin
                          Step:=0;
                          Result:=-1;
                          End;
           End;
           // Arrivé ici, si "Step" vaut 4, on a fini : on peut sortir.
           If Step>High(Pattern) Then
              Break ;
           // Sinon, incrémentation du compteur.
           Inc(I);
           End;
     // Si l'on est ici avec Result<>-1, on a trouvé une position.
     FreeAndNil(F);
End ;

Tu vas l'utiliser avec un code dans ce genre :

Code Delphi :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Procedure TForm2.Button2Click(Sender: TObject);
Var
   P : Int64 ;
begin
     ChooseFile.InitialDir:=ExtractFilePath(Application.ExeName);
     If (ChooseFile.Execute) Then
        Begin
        P:=FindBinaryInFile(ChooseFile.FileName,IntValue.Value);
        If P<>-1 Then ShowMessage(Format('Found value %s in file %s at position : 0x%s',[IntValue.Data.Text,ChooseFile.Filename,IntToHex(P,16)]))
                 Else ShowMessage(Format('Could not find value %s in file %s.',[IntValue.Data.Text,ChooseFile.Filename]));
 
        End;
end;

La fonction de recherche n'est absolument pas optimisée, par contre, pas plus que la machine à états. On peut facilement la modifier toutefois pour tenir compte de l'endianness, et/ou lui permettre de chercher des motifs binaires de n'importe quelle taille.

[Smith_4400]

Salut,
"file of byte" est dépasser...
Passe au Stream c'est mieux
@+


----------------
Smith

[ShaiLeTroll]

tu peux très facilement adapté de
SearchString en SearchByte

Bon, au final je l'ai fait, c'était tellement facile, j'utilise les fonctions FileOpen\FileRead qui encapsule les fonctions Windows\Linux, ce sont elles qu'utilise le TFileStream ...

Fichier de 7,40 Mo

Recherche d'un Item à la Position 8797
FindBinaryInFile : 21 ms
SearchBinaryInFile : 71 ms

Recherche d'un Item à la Position 7764251
FindBinaryInFile : 19 570 ms
SearchBinaryInFile : 71 ms

Recherche de 881 Items de la Position 17604 à la Position 7764244
FindBinaryInFile : 43 ms (un seul item découvert, il faut relancer en boucle pour les trouver tous à partir de la position du dernier, ce qui prend 21 000 ms)
SearchBinaryInFile : 77 ms (mais a stocké TOUS les offsets des 881 items dans un Tableau)

La Différence de performance, s'explique uniquement par l'utilisation d'une Lecture Octet par Octet, contre une Lecture par Buffer, 1024 est un bon compromis, ensuite l'augmentation du buffer n'est plus sensible après 4096 ...

EDIT : Code Incorrect Supprimé, voir plus bas ...

[Smith_4400]

j'aimerais bien avoir comment appliqué la fonction SearchBinaryInFile
comme "Mac LAK" adonné un exemple
merci

[Mac LAK]

La Différence de performance, s'explique uniquement par l'utilisation d'une Lecture Octet par Octet, contre une Lecture par Buffer, 1024 est un bon compromis, ensuite l'augmentation du buffer n'est plus sensible après 4096 ...

La taille d'un cluster, en fait, c'est l'idéal, donc 4096 en règle générale. Si l'on veut être compatible avec tout ce qui peut être possible, on passe à 64 ko, et on est 100% tranquille.

Tu noteras quand même que j'avais bien précisé que ma fonction n'était absolument pas optimisée, et qu'elle pouvait être sévèrement améliorée...

Après, il y a en plus des variantes vicieuses, comme trouver de nouvelles occurrences pendant que l'on est déjà en cours de reconnaissance d'une occurrence (ex : chercher "00 00 00 00" dans un fichier qui ne contient QUE des "00"), mais je pense que l'on sort du cadre "normal".

Ce qu'il faut surtout en retenir, c'est la machine à états de reconnaissance, qui dans ce cas "compte" le nombre d'octets déjà reconnus, et le fait que tu n'auras aucune assistance de la part de la VCL à ce sujet : tu devras te palucher le code de reconnaissance "à la main".

j'aimerais bien avoir comment appliqué la fonction SearchBinaryInFile

Shai a documenté sa fonction, le gros pavé de commentaires tout en haut...


Au passage, j'ai omis une ligne dans ma fonction, après l'initialisation de "I" : j'ai oublié le "Seek", j'ai corrigé.

[fartoto_dz2004]

merci beaucoup de la rapidité c'est gentil de votre part merci beaucoup

[ShaiLeTroll]

Après, il y a en plus des variantes vicieuses, comme trouver de nouvelles occurrences pendant que l'on est déjà en cours de reconnaissance d'une occurrence (ex : chercher "00 00 00 00" dans un fichier qui ne contient QUE des "00"), mais je pense que l'on sort du cadre "normal".

J'ai prévu pour cela l'option AcceptOverlap, avec l'exemple "coco" dans "cococoo"

@Smith_4400, cela s'utilise comme SearchStringInBigFile, bon, je suis sympa, voici un exemple, cherches un peu plus ! avec le cartouche Delphi2Doc, tu devrais savoir comment l'utiliser, ...

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
procedure TFrmTestFichier.BtnSearchBinaryInFileClick(Sender: TObject);
var
   SearchBuf: TByteDynArray;
   OffSets: TIntegerDynArray;
   iOff, Count: Integer;
begin
   SetLength(SearchBuf, 4);
   SearchBuf[0] := 1;
   SearchBuf[1] := 2;
   SearchBuf[2] := 3;
   SearchBuf[3] := 4;
 
   Count := SearchBinaryInFile(EdPathSearch.Text, SearchBuf, OffSets, True);
   ShowMessage(IntToStr(CountLn));
 
   Memo1.Lines.BeginUpdate();
   try
      Memo1.Lines.Add('---');
      for iOff := Low(OffSets) to High(OffSets) do
         Memo1.Lines.Add(IntToStr(OffSets[iOff]));
   finally
      Memo1.Lines.EndUpdate();
   end;
end;

[Mac LAK]

J'ai prévu pour cela l'option AcceptOverlap, avec l'exemple "coco" dans "cococoo"

Faut voir au niveau perfs, souvent ça pêche à ce niveau... Typiquement, prends un fichier de N octets, contenant une seule valeur d'octet (0x00, par exemple). Cherche dedans une chaîne de N/2 octets en question : tu dois trouver normalement ((N/2)+1) positions... Si "N" est suffisamment grand, ça peut poser des soucis assez conséquents au niveau pile/récursion.

[ShaiLeTroll]

Fichier de 9,53 Mio (10 Mo) ne contenant que des espaces
recherche de 4 espaces

SearchBinaryInFile NoOver : 119 ms (250 000 Items)
SearchBinaryInFile Accept Overlap : 351 ms (9 970 702 Items)

normal, tu avance de 4 et récule de 3 à chaque chaine trouvé au lieu d'avancer tout le temps ...

Recherche de 510 espaces dans ce fichier

SearchBinaryInFile NoOver : 119 ms (19 531 Items contre 19607 par UltraEdit)
SearchBinaryInFile Accept Overlap : 16556 ms (5 029 106 Items)
Cela s'éffondre !

Mais pire, sur de trop long chaine, semble que j'ai un bug ... bien voilà, faut je cherche pourquoi ...
Je n'ai utilisé qu'une seule fois la fonction SearchString pour un petit outil qui une fois développé n'a été utilisé qu'une seule fois aussi ... je ne l'ai donc jamais testé à fond ... cela n'avait pris que 3 jours de dev contre 15 si on avait du le faire à la main ...

EDIT : Voici une Correction, normalement c'est mieux, faudrait aussi que je teste sur plus de 2Go ... pour le mode AcceptOverlap, cela donne le bon nombre, les bons offsets, j'espère qu'il n'y a pas en réalité une erreur qui donne l'illusion de la réussite !

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
106
107
108
109
110
111
112
113
114
115
116
{* -----------------------------------------------------------------------------
la Fonction SearchBinaryInFile Permet de Chercher un Tableau de Byte dans Fichier de plus de 2Go, la fonction renvoi le nombre d'occurence, et peu renvoyer un tableau contenant le premier octet de chaque occurence dans le fichier
@param FileName Chaine contenant le nom du Fichier
@param SearchBinary Tableau de Byte à chercher dans le fichier
@param OffSets Tableau d'Entier qui contiendra les positions de occurences trouvés
@param KeepOffSet Boolean True rempli OffSets, False, ne rempli pas OffSets
@param Threshold Si le nombre de Tableau de Byte trouvé atteind ce nombre, la Recherche s'arrête
@param AcceptOverlap Boolean True si le mot à chercher est une répétition cela compte les occurences qui se chevauche, False chaque octet d'une occurence ne peut être comptabilisé qu'une seule fois (exemple on chercher coco, le fichier contient cocococo, True = 3, False = 2)
@return Nombre d'occurence Trouvé
------------------------------------------------------------------------------ }
function SearchBinaryInFile(const FileName: string; const SearchBinary: TByteDynArray; out OffSets: TInt64DynArray; KeepOffSet: Boolean = False; Threshold: Integer = MaxInt; AcceptOverlap: Boolean = False): Integer;
const
   BUF_SIZE: Integer = 1024;
   ZERO: Int64 = 0;
var
   FileToSearch: Integer;
   FileLength, iReaded: Int64;
   SearchBuf: array of Byte;
   iSearchBufPos, iSearch, iMark, iCountFound, iRememberFound, iRememberOverlap: Integer;
   SearchLen: Integer;
   AmtTransferred: Integer;
   LastFound: Boolean;
   UpSearchString: string;
begin
   SearchLen := Length(SearchBinary);
 
   Result := 0;
   if SearchLen <= 0 then
     Exit;
 
   SetLength(SearchBuf, BUF_SIZE);
   iReaded := 0;
 
   FileToSearch := FileOpen(FileName, fmOpenRead);
   if FileToSearch < 0 then
     Exit;
   try
      FileLength := FileSeek(FileToSearch, ZERO, FILE_END);
      FileSeek(FileToSearch, ZERO, FILE_BEGIN);
 
      iCountFound := 0;
 
      while iReaded < FileLength do
      begin
         AmtTransferred := FileRead(FileToSearch, SearchBuf[0], BUF_SIZE); // [0] parce que c'est un tableau dynamique
         iRememberFound := iCountFound;
         iRememberOverlap := iRememberFound;
         iSearchBufPos := 0;
         iSearch := 0;
         LastFound := False;
 
         while iSearchBufPos < AmtTransferred do
         begin
            // Comparaison Octet par Octet du Tableau d'Octet recherché
            for iMark := iCountFound to SearchLen - 1 do // -1 car type Dyn Array
            begin
               iSearch := iSearchBufPos + iMark - iRememberFound;
               if iSearch >= AmtTransferred then
                  Break;
 
               if SearchBuf[iSearch] = SearchBinary[iMark] then
               begin
                  Inc(iCountFound);
 
                  LastFound := iCountFound >= SearchLen;
                  if LastFound then
                  begin
                     Inc(Result);
 
                     if KeepOffSet then
                     begin
                        SetLength(OffSets, Length(OffSets) + 1);
                        if AcceptOverlap then
                          OffSets[High(OffSets)] := iReaded + iSearchBufPos - iRememberOverlap
                        else
                          OffSets[High(OffSets)] := iReaded + iSearchBufPos - iRememberFound;
                     end;
 
                     if iCountFound = Threshold then
                       Exit;
 
                     if AcceptOverlap then
                     begin
                       if iRememberOverlap = 0 then
                         Inc(iSearchBufPos, 1)
                       else
                         Dec(iRememberOverlap);
                     end
                     else
                       Inc(iSearchBufPos, SearchLen - iRememberFound);
 
                     iCountFound := 0;
                     iRememberFound := 0;
                     Break;
                  end;
               end else begin
                  iCountFound := 0;
                  iRememberFound := 0;
                  Break;
               end;
            end;
 
            if iSearch >= AmtTransferred then
              Break;
 
            if LastFound then
              LastFound := False
            else
              Inc(iSearchBufPos, 1);
         end;
         Inc(iReaded, AmtTransferred);
      end;
   finally
      FileClose(FileToSearch);
   end;
end;

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
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
{* -----------------------------------------------------------------------------
la Fonction SearchStringInFile Permet de Chercher une Chaine dans Fichier de plus de 2Go, la fonction renvoi le nombre d'occurence, et peu renvoyer un tableau contenant le premier octet de chaque occurence dans le fichier
@param FileName Chaine contenant le nom du Fichier
@param SearchString Chaine à chercher dans le fichier
@param OffSets Tableau d'Entier qui contiendra les positions de occurences trouvés
@param KeepOffSet Boolean True rempli OffSets, False, ne rempli pas OffSets
@param Threshold Si le nombre de chaine trouvé atteind ce nombre, la Recherche s'arrête
@param CaseSensitive Boolean True A est différent de a, False, ignore la casse (plus lent)
@param AcceptOverlap Boolean True si le mot à chercher est une répétition cela compte les occurences qui se chevauche, False chaque lettre d'une occurence ne peut être comptabilisé qu'une seule fois (exemple on chercher coco, le fichier contient cocococo, True = 3, False = 2)
@return Nombre d'occurence Trouvé
------------------------------------------------------------------------------ }
function SearchStringInFile(const FileName, SearchString: string; out OffSets: TInt64DynArray; KeepOffSet: Boolean = False; Threshold: Integer = MaxInt; CaseSensitive: Boolean = True; AcceptOverlap: Boolean = False): Integer;
const
   BUF_SIZE: Integer = 1024;
   ZERO: Int64 = 0;
var
   FileToSearch: Integer;
   FileLength, iReaded: Int64;
   SearchBuf: array of Char;
   iSearchBufPos, iSearch, iMark, iCountFound, iRememberFound, iRememberOverlap: Integer;
   SearchLen: Integer;
   AmtTransferred: Integer;
   LastFound: Boolean;
   UpSearchString: string;
begin
   SearchLen := Length(SearchString);
 
   Result := 0;
   if SearchLen <= 0 then
     Exit;
 
   if not CaseSensitive then
     UpSearchString := UpperCase(SearchString);
 
   SetLength(SearchBuf, BUF_SIZE);
   iReaded := 0;
 
   FileToSearch := FileOpen(FileName, fmOpenRead);
   if FileToSearch < 0 then
     Exit;
   try
      FileLength := FileSeek(FileToSearch, ZERO, FILE_END);
      FileSeek(FileToSearch, ZERO, FILE_BEGIN);
 
      iCountFound := 0;
 
      while iReaded < FileLength do
      begin
         AmtTransferred := FileRead(FileToSearch, SearchBuf[0], BUF_SIZE); // [0] parce que c'est un tableau dynamique
         iRememberFound := iCountFound;
         iRememberOverlap := iRememberFound;
         iSearchBufPos := 0;
         iSearch := 0;
         LastFound := False;
 
         while iSearchBufPos < AmtTransferred do
         begin
            // Comparaison Octet par Octet de la chaine recherchée
            for iMark := iCountFound + 1 to SearchLen do // +1 car type string
            begin
               iSearch := iSearchBufPos + iMark - iRememberFound - 1;
               if iSearch >= AmtTransferred then
                  Break;
 
               if (CaseSensitive and (SearchBuf[iSearch] = SearchString[iMark]))
               or (not CaseSensitive and (UpCase(SearchBuf[iSearch]) = UpSearchString[iMark])) then
               begin
                  Inc(iCountFound);
 
                  LastFound := iCountFound >= SearchLen;
                  if LastFound then
                  begin
                     Inc(Result);
 
                     if KeepOffSet then
                     begin
                        SetLength(OffSets, Length(OffSets) + 1);
                        if AcceptOverlap then
                          OffSets[High(OffSets)] := iReaded + iSearchBufPos - iRememberOverlap
                        else
                          OffSets[High(OffSets)] := iReaded + iSearchBufPos - iRememberFound;
                     end;
 
                     if iCountFound = Threshold then
                       Exit;
 
                     if AcceptOverlap then
                     begin
                       if iRememberOverlap = 0 then
                         Inc(iSearchBufPos, 1)
                       else
                         Dec(iRememberOverlap);
                     end
                     else
                       Inc(iSearchBufPos, SearchLen - iRememberFound);
 
                     iCountFound := 0;
                     iRememberFound := 0;
                     Break;
                  end;
               end else begin
                  iCountFound := 0;
                  iRememberFound := 0;
                  Break;
               end;
            end;
 
            if iSearch >= AmtTransferred then
              Break;
 
            if LastFound then
              LastFound := False
            else
              Inc(iSearchBufPos, 1);
         end;
         Inc(iReaded, AmtTransferred);
      end;
   finally
      FileClose(FileToSearch);
   end;
end;

[Mac LAK]

Mais pire, sur de trop long chaine, semble que j'ai un bug ... bien voilà, faut je cherche pourquoi ...

Marrant, mon petit test, non ?
Mais bon : j'ai un peu triché, j'ai déjà eu le cas en C et j'avais constaté ce problème en poussant les tests à la limite justement...

EDIT : Voici une Correction, normalement c'est mieux, faudrait aussi que je teste sur plus de 2Go ... pour le mode AcceptOverlap, cela donne le bon nombre, les bons offsets, j'espère qu'il n'y a pas en réalité une erreur qui donne l'illusion de la réussite !

Tu peux aussi, au lieu d'utiliser des aller-retour dans le fichier, utiliser un vecteur contenant les découvertes "partielles" en cours. Fais aussi les tests en mode binaire, j'ai eu des surprises à ce sujet.
En mode récursif, attention au stack overflow, bien sûr. En mode non-récursif, ce sera un poil plus lent peut-être (toujours plus rapide que les aller-retours normalement), mais tu n'auras pas d'autre limite que la RAM pour ton test au moins.

[fartoto_dz2004]

Salut
Pour la nouvelle fonction j'ai un problème avec "TByteDynArray" il me donne erreur???!!!
N.B : j'utilise le delphi 6

[Cl@udius]

Salut

TByteDynArray est un type défini dans l'unité Types.
Si ce type n'est pas défini sous D6, sache qu'il s'agit de:

Code :

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

TByteDynArray = array of Byte;

@+ Claudius

[ShaiLeTroll]

C'est bon, c'est développé en D6 donc ça existe bien dans Types, mais la touche F1, l'aurait dit !
Pourquoi personne n'a le réflexe d'utiliser l'aide intégrée, surtout qu'en D4 à D7, c'est une vrai merveille, c'est plus discutable avec les versions récentes, et même si plus complète en D2009, le Microsoft Document Explorer est juste une vraie bouze, il consomme plus de mémoire que Delphi lui même !

[fartoto_dz2004]

merci à vous chers modérateurs et membres de m'aider
avec votre soutien j'ai pu développé ma propre fonction de recherche veuillez me donné des remarques si vous voulez

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
 
function BSwap(const a : longword) : longword;
asm
  BSWAP EAX;
end;
function findOffset(FileName :String;Value:longword):longword;
var
m : TMemoryStream;
n: longword;
rv : longword;
begin
result := 0;
m := TMemoryStream.Create;
m.LoadFromFile(filename);
value := bswap(value);
for n := 0 to m.Size-1 do
begin
m.Seek(n,0);
m.Read(rv,sizeof(value));
if CompareValue(rv,value,4) = 0 then
begin
result := n;
break;
end;
end;
m.Free;
end;

ça marche trés bien je l'ai essayé plusieurs fois
merci encore

[mick605]

Super si ca marche !

Si je peux te donner un conseil, c'est d'indenter ton code Et d'utiliser des noms de variables plus explicites !

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
 
function BSwap(const a : longword) : longword;
asm
  BSWAP EAX;
end;
 
 
function findOffset(FileName :String;Value:longword):longword;
var
  m     : TMemoryStream;
  n, rv : longword;
begin
  result := 0;
  m := TMemoryStream.Create;
  m.LoadFromFile(filename);
  value := bswap(value);
 
  for n := 0 to m.Size-1 do
  begin
    m.Seek(n,0);
    m.Read(rv,sizeof(value));
 
    if CompareValue(rv,value,4) = 0 then
    begin
      result := n;
      break;
    end;
 
  end;
 
  m.Free;
end;