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
|
type tAOI = array of integer;
function NbOccEdamFTS(const NomFiSource : string; var MotsCibles : array of string) : tAOI;
// Pour comptage d''occurrences dans fichier de plus de 2Go
// @param NomFiSource = nom complet du fichier-source
// @param MotsCibles = tableau des chaines de mots-cibles à chercher dans le fichier
// @Return = Tableau renvoyant le nombre d'occurences de chaque mot-cible trouvé
// dans le fichier.
// Attention cette function renvoie les occurences de répétition ET les occurrences
// de chevauchement c''est à dire si on cherche "coco" et que le fichier
// contient "cocococo" la function compte le "coco" du début + celui de la fin
// + celui du milieu dont chaque moitié est déjà comptabilisée dans
// les 2 occurrences principales.
// Attention compte également les occurr de chevauchement
var buff : array[0..65535] of Char; FTS : Integer; //S : TFileStream;
TailleFTS, LuFi, FPos : Int64;
luBuff, iBuff: Longint;
LenMot, i, corrPos : Integer;
Texte : string;
function Cherche(motCible : string) : Integer;
var j, m, n :integer;
begin n:=0; LenMot := Length(motCible);
for j:=1 to length(Texte) do
begin
if Texte[j]=motCible[1] then
begin
m:=CompareString(LOCALE_USER_DEFAULT, NORM_IGNORECASE,
@motCible[1], LenMot, @Texte[j], LenMot);
if (m=2) then inc(n);
end;
end;
Result := n;
end;
begin FTS := FileOpen(NomFiSource, fmOpenRead);
if FTS < 0 then EXIT;
try
TailleFTS := FileSeek(FTS, 0, FILE_END);
FPos:=FileSeek(FTS, 0, FILE_BEGIN);
LuFi := 0;
SetLength(Result,High(MotsCibles)+1);
for i:=Low(Result) to High(Result) do Result[i]:=0;
while LuFi < TailleFTS do
begin luBuff := FileRead(FTS, buff[0], SizeOf(buff));
corrPos:=0;
iBuff:=luBuff;
repeat dec(iBuff);
until (iBuff=0) or (Buff[iBuff]=#10) or (Buff[iBuff]=#13);
for i:=iBuff to luBuff-1 do
begin Buff[i]:=#0; inc(corrPos); end;
Texte:=string(buff);
// Comptage :
if Texte<>'' then
for i:=Low(MotsCibles) to High(MotsCibles)
do Result[i]:=Result[i] + Cherche(MotsCibles[i]);
FPos:=FileSeek(FTS, - corrPos, FILE_CURRENT);
if TailleFTS - FPos <= 2 then corrPos:=0;
Inc(LuFi, luBuff - corrPos);
end;
finally
FileClose(FTS);
end;
end;
// Utilisation :
procedure TfrmOcc.btnNbOccEdamFTSClick(Sender: TObject);
var Mots : array of string; i : integer; NMotsCibles : byte;
Occ : tAOI;
begin Chrono.Top;
NMotsCibles:=30;
SetLength(Mots,NMotsCibles);
Mots[0]:='page';
Mots[1]:='coco';
for i:=2 to NMotsCibles - 1 do Mots[i]:=intToStr(i)+' : ';
Occ:=NbOccEdamFTS(RepAppli+'Test0.mem', Mots);
redTrace.lines.Add('NbOccEdamFTS : Lu et compté en : '+Chrono.mis);
for i:=Low(Mots) to High(Mots)
do redTrace.lines.Add(Mots[i]+' trouvé '+intToStr(Occ[i])+' fois');
end; |
Répondre avec citation
)
alors je vais le faire pour le plaisir et aussi comme un petit défit et casse tête 
; pour mes besoin par hazard 
Envoyé par ShaiLeTroll
Partager