powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Поиск последовательности в бинарном массиве
270 сообщений из 270, показаны все 11 страниц
Поиск последовательности в бинарном массиве
    #39586584
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Други, есть ли в современных Delphi (XE и выше) функции поиска последовательности в массиве?
Если есть - ткните, плизз, носом и научите пользоваться...

Имеем:
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
// Несущественные детали в коде - упущены!!
var
BBin: TBytes;
const
// массив Поиска (могут быть и другие значения и длина)
Poisk: array[0..4] of Byte = ($31, $32, $33, $34, $35);    
// FullBinFileName - полный путь к файлу
FBin:=TFileStream.Create(FullBinFileName, fmOpenRead);
SizeBinFile := FBin.Size;
SetLength(BBin, SizeBinFile); // Определяем длину массивa TBytes
FBin.ReadBuffer(BBin, SizeBinFile); // Читаем BIN-Файл в массив

Т.е. имеем на входе два массива:

- первый - это большой массив (например это файл, загруженный в TBytes);
- второй - небольшой массив, который нужно искать в первом.

Задача:
Найти индекс в первом массиве, начиная с которого идет искомый.

P.S. похожая задача уже рассматривалась мной в теме Поиск и Замена последовательности байт в бинарном файле с использованием TMemoryStream , но по некоторым причинам хочу попробовать простым перебором и сравнением с использованием массивов TBytes или может есть уже готовые функции?
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39586587
чччД
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Bellic,

есть такие средства. Называются "перебор в цикле" и "сравнение".
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39586589
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
чччД, ну это понятно!
Я же спросил - может быть есть другие варианты, кроме банальных
автор"перебор в цикле" и "сравнение"???
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39586590
чччД
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Bellic,

Звиняйте хлопцi, бананiв нема!
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39586622
Фотография DarkMaster
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Bellic,

Можно прочитать кусок из файла в AnsiString и пользоваться Pos()
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39586623
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
DarkMasterBellic,
Можно прочитать кусок из файла в AnsiString и пользоваться Pos()
Файл - не текстовый, а бинарный! - В нем может быть непредсказуемое сочетание байт!
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39586626
Фотография DarkMaster
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Bellic,

И что мешает проверить?
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39586634
rgreat
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
DarkMasterМожно прочитать кусок из файла в AnsiString и пользоваться Pos()
Тогда уже в RawByteString.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39586635
rgreat
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
BellicФайл - не текстовый, а бинарный! - В нем может быть непредсказуемое сочетание байт!А в строке такого быть не может?
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39586639
кеп-ко
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
есть уже готовые функции ? - Да, есть, куча!

- Ха, не угадали!, так-какможет быть непредсказуемое сочетание байт!
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39586643
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
кеп-коесть уже готовые функции ? - Да, есть, куча!
Например?
Только без Стрингов в различном их виде и в пределах Темы топика!?..))
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39586650
чччД
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Bellic,

вместо того, чтобы клянчить на паперти, уже бы написал, что нужно.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39586652
Мимопроходящий
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
имхо, тут программист нужен (С)
Posted via ActualForum NNTP Server 1.5
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39586657
rgreat
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Первый результат в гугле...

Код: pascal
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.
function BytePos(const Pattern: TBytes; const Buffer: PByte; const BufLen: cardinal): PByte;
var
  PatternLength: cardinal;
  i: cardinal;
  j: cardinal;
  OK: boolean;
begin
  result := nil;
  PatternLength := length(Pattern);
  if PatternLength > BufLen then Exit;
  if PatternLength = 0 then Exit(Buffer);
  for i := 0 to BufLen - PatternLength do
    if PByte(Buffer + i)^ = Pattern[0] then
    begin
      OK := true;
      for j := 1 to PatternLength - 1 do
        if PByte(Buffer + i + j)^ <> Pattern[j] then
        begin
          OK := false;
          break
        end;
      if OK then
        Exit(Buffer + i);
    end;
end;
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39586658
rgreat
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Но вангую что Pos +RawByteString будет работать быстрей.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39586660
кеп-ко
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39586661
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
чччДBellic,
вместо того, чтобы клянчить на паперти, уже бы написал, что нужно.
Попрошу не фыркать и иметь малейшее уважение!!!
Я и не сижу на месте - отлаживаю простой перебор со сравнением, а он у меня гораздо сложнее чем Задача !
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39586665
Фотография DarkMaster
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Bellic,

Все равно это сведется к асмовым командам семейства SCASxxx :) Тебе уже дали поиск и по байтам и по символам - пробуй, что тебе больше подойдет.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39586670
чччД
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
BellicчччДBellic,
вместо того, чтобы клянчить на паперти, уже бы написал, что нужно.
Попрошу не фыркать и иметь малейшее уважение!!!
Я и не сижу на месте - отлаживаю простой перебор со сравнением, а он у меня гораздо сложнее чем Задача !

Что же у тебя за Задача такая, которая гораздо проще, чем простой перебор со сравнением???
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39586674
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
rgreat
Первый результат в гугле...
Код: pascal
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.
function BytePos(const Pattern: TBytes; const Buffer: PByte; const BufLen: cardinal): PByte;
var
  PatternLength: cardinal;
  i: cardinal;
  j: cardinal;
  OK: boolean;
begin
  result := nil;
  PatternLength := length(Pattern);
  if PatternLength > BufLen then Exit;
  if PatternLength = 0 then Exit(Buffer);
  for i := 0 to BufLen - PatternLength do
    if PByte(Buffer + i)^ = Pattern[0] then
    begin
      OK := true;
      for j := 1 to PatternLength - 1 do
        if PByte(Buffer + i + j)^ <> Pattern[j] then
        begin
          OK := false;
          break
        end;
      if OK then
        Exit(Buffer + i);
    end;
end;

rgreat , спасибо за идею!)))

кеп-коBellic,
Код: plaintext
CompareMem
Это я уже делал - читайте ссылку в первом сообщении!
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39586676
Мимопроходящий
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Андрюха, найми студента.
так будет гораздо быстрее.
далсЯ тебе это программизмЪ, на старости лет...
Posted via ActualForum NNTP Server 1.5
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39586677
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
rgreatНо вангую что Pos +RawByteString будет работать быстрей.
Попробую и это реализовать, просто еще не со всеми возможностями знаком..(
Читал разом файл в массив TByte и спокойно работал с ним, а в RawByteString - реально засунуть бинарник длиной к примеру 25 Мбайт а потом искать в нем вхождение с помощью Pos?

(Т.е. стандартных функций поиска в массиве - нету?)
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39586680
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
МимопроходящийАндрюха, найми студента.
так будет гораздо быстрее.
далсЯ тебе это программизмЪ, на старости лет...
Опаньки!!!???
А Вы - кто, раз имя мое знаете?..)))

Отвечаю! - Мой интерес-не интересен никому! Все с кем я общался, хотят все на халяву или же занимаются другими направлениями!
Поэтому пришлось изучать и осваивать самому, а позже вспомнить уроки программирования и одолеть начальные азы Дэлфи, дабы автоматизировать и ускорить получение результатов своего Хобби!..)))

А еще - "программизмЪ" не дает закоксоваться мозгам и впасть в старческий маразм!..)))) Рекомендую!..)))
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39586683
Мимопроходящий
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
18.01.2018 19:17, Bellic пишет:
> А еще - "программизмЪ" не дает закоксоваться мозгам и впасть в старческий маразм!..)))) Рекомендую!..)))

да ну его нафиг.
я бросил.
и тебе рекомендую.
Posted via ActualForum NNTP Server 1.5
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39586687
чччД
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Bellic...закоксоваться мозгам и впасть в старческий маразм!...

Как будто это что-то плохое.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39586689
rgreat
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
BellicЧитал разом файл в массив TByte и спокойно работал с ним, а в RawByteString - реально засунуть бинарник длиной к примеру 25 Мбайт а потом искать в нем вхождение с помощью Pos?2 Гб влезает.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39586701
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
rgreatНо вангую что Pos +RawByteString будет работать быстрей.

О да.. Быстрее

Код: pascal
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.
function Pos(const SubStr, Str: _RawByteStr; Offset: Integer): Integer;
{$IFDEF PUREPASCAL}
var
  I, LIterCnt, L, J: Integer;
  PSubStr, PS: _PAnsiChr;
begin
  L := Length(SubStr);
  { Calculate the number of possible iterations. Not valid if Offset < 1. }
  LIterCnt := Length(Str) - Offset - L + 1;

  { Only continue if the number of iterations is positive or zero (there is space to check) }
  if (Offset > 0) and (LIterCnt >= 0) and (L > 0) then
  begin
    PSubStr := _PAnsiChr(SubStr);
    PS := _PAnsiChr(Str);
    Inc(PS, Offset - 1);

    for I := 0 to LIterCnt do
    begin
      J := 0;
      while (J >= 0) and (J < L) do
      begin
        if PS[I + J] = PSubStr[J] then
          Inc(J)
        else
          J := -1;
      end;
      if J >= L then
        Exit(I + Offset);
    end;
  end;

  Result := 0;
end;

...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39586704
rgreat
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Няшик,

Давно ли ты сорцы с директивой PUREPASCAL пересобирал?

у нормальных людей как-то так
Код: pascal
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.
{$ELSE !PUREPASCAL}
{$IFDEF CPUX86}
(* ***** BEGIN LICENSE BLOCK *****
 *
 * The function PosEx is licensed under the CodeGear license terms.
 *
 * The initial developer of the original code is Fastcode
 *
 * Portions created by the initial developer are Copyright (C) 2002-2004
 * the initial developer. All Rights Reserved.
 *
 * Contributor(s): Aleksandr Sharahov
 *
 * ***** END LICENSE BLOCK ***** *)
asm
       test  eax, eax
       jz    @Nil
       test  edx, edx
       jz    @Nil
       dec   ecx
       jl    @Nil

       push  esi
       push  ebx

       mov   esi, [edx-4]  //Length(Str)
       mov   ebx, [eax-4]  //Length(Substr)
       sub   esi, ecx      //effective length of Str
       add   edx, ecx      //addr of the first AnsiChar at starting position
       cmp   esi, ebx
       jl    @Past         //jump if EffectiveLength(Str)<Length(Substr)
       test  ebx, ebx
       jle   @Past         //jump if Length(Substr)<=0

       add   esp, -12
       add   ebx, -1       //Length(Substr)-1
       add   esi, edx      //addr of the terminator
       add   edx, ebx      //addr of the last AnsiChar at starting position
       mov   [esp+8], esi  //save addr of the terminator
       add   eax, ebx      //addr of the last AnsiChar of Substr
       sub   ecx, edx      //-@Str[Length(Substr)]
       neg   ebx           //-(Length(Substr)-1)
       mov   [esp+4], ecx  //save -@Str[Length(Substr)]
       mov   [esp], ebx    //save -(Length(Substr)-1)
       movzx ecx, byte ptr [eax] //the last AnsiChar of Substr

@Loop:
       cmp   cl, [edx]
       jz    @Test0
@AfterTest0:
       cmp   cl, [edx+1]
       jz    @TestT
@AfterTestT:
       add   edx, 4
       cmp   edx, [esp+8]
       jb   @Continue
@EndLoop:
       add   edx, -2
       cmp   edx, [esp+8]
       jb    @Loop
@Exit:
       add   esp, 12
@Past:
       pop   ebx
       pop   esi
@Nil:
       xor   eax, eax
       ret
@Continue:
       cmp   cl, [edx-2]
       jz    @Test2
       cmp   cl, [edx-1]
       jnz   @Loop
@Test1:
       add   edx,  1
@Test2:
       add   edx, -2
@Test0:
       add   edx, -1
@TestT:
       mov   esi, [esp]
       test  esi, esi
       jz    @Found
@AnsiString:
       movzx ebx, word ptr [esi+eax]
       cmp   bx, word ptr [esi+edx+1]
       jnz   @AfterTestT
       cmp   esi, -2
       jge   @Found
       movzx ebx, word ptr [esi+eax+2]
       cmp   bx, word ptr [esi+edx+3]
       jnz   @AfterTestT
       add   esi, 4
       jl    @AnsiString
@Found:
       mov   eax, [esp+4]
       add   edx, 2

       cmp   edx, [esp+8]
       ja    @Exit

       add   esp, 12
       add   eax, edx
       pop   ebx
       pop   esi
end;
{$ENDIF CPUX86}
{$ENDIF !PUREPASCAL}

...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39586707
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
НяшикrgreatНо вангую что Pos +RawByteString будет работать быстрей.
О да.. Быстрее
У меня код Поиска и Замены на TByte получился с таким же количеством строк..)))
Код: pascal
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.
AddressBin := 0;
while AddressBin <= (SizeBinFile - LenBPoisk) do
  begin // Сравниваем побайтно ФразуПоиска и БИН-файл
       for j := 0 to LenBPoisk - 1 do
             begin
                  if BBin[AddressBin + j] <> BPoisk[j] then
                        begin // Байты - НЕ равны
                             Ravno := False; // Флаг Равенства байтов
                             Break;  // Выход из цикла если байты не равны-нет смысла дальше сравнивать
                         end
                  else  // Байты - Равны
                         Ravno := True; // Флаг Pавенства байтов
             end;

             if Ravno then  // Нашли строку в БИН-файле-Меняем Поисковую строку на ФразуЗамены
                 begin
                     for k := 0 to LenBPoisk - 1 do // Производим Замену
                          begin
                              BBin[AddressBin + k] := BZamena[k];
                          end;
                     Inc(NumTrans);  // Считаем количество произведенных замен
                     // Коррекция на длину фразы, чтоб искать дальше
                     AddressBin := AddressBin + LenBPoisk;
                 end
              else  //===== Фразы HE pавны ====
                     Inc(AddressBin); // продолжаем дальше искать по файлу
  end;


Но даже тут возможно еще что то оптимизировать!?
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39586709
rgreat
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Выше - код на ассемблере.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39586710
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
rgreatДавно ли ты сорцы с директивой PUREPASCAL пересобирал? rgreat , а вот это уже серьезный шаг!!! Класс!
Суть я понял, но вижу первый раз!
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39586713
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
rgreatВыше - код на ассемблере.
И много таких замен существует для функций и прочего? (Может и мне пора пересборкой занятся?.. )
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39586714
rgreat
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Bellic,

Оно под виндой и так на ассемблере. Ничего делать не надо.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39586724
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
rgreat,

64 битном приложение твой asm - не будет работать. И вся оптимизация к коту под-хвост.

Да-да. Если он надумаем, или уже использует 64 битный компилятор.

То всё, его код будет медленным.

На 32 битном приложение asm быстрее в 10 раз .
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39586729
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
rgreatНо вангую что Pos +RawByteString будет работать быстрей.Кстати - с помошью Pos() смещение до первого вхождения я то найду, а с последующими как быть?
Искомая последовательность ведь может повториться еще и не раз!
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39586730
rgreat
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Няшик,

https://quality.embarcadero.com/browse/RSP-13687

Проголосуй.

Ну а пока - скопипасти если тебе быстрый x64 POS надо.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39586731
rgreat
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Bellic,

У функции POS есть 3-й, необязательный параметр.
Учи матчасть.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39586732
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Сам себе и отвечаю..)))
Видимо так?:
авторPosEx(SubStr, Str: String; Offset: Integer) - функция аналогична функции Pos(), но позволяет задать отступ от начала строки для поиска. Если значение Offset задано (оно не является обязательным), то поиск начинается с символа Offset в строке. Если Offset больше длины строки Str, то функция возратит 0. Также 0 возвращается, если подстрока не найдена в строке.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39586733
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
rgreatУ функции POS есть 3-й, необязательный параметр.
Учи матчасть.Учу и учюсь, rgreat , мог бы тогда и ссылку кинуть, пока только с двумя параметрами попадаются!..(
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39586734
rgreat
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Начиная с Delphi XE3 у Pos - 3 параметра.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39586757
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Bellic,

Оптимизировать многое что можно
Ты уверен, что оно тебе нужно? )))
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39586759
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Самая главная оптимизация - поиск первого байта. Есть алгоритм, позволяющий считывать сразу несколько байт, и искать первое вхождение за раз. В регистре x86 можно сравнивать сразу 4 байта. В x64 - 8. В SSE - 16. За одну итерацию.

Далее. Сравнение цепочки байт. Можно сравнивать не по одному, а до 16 байт за итерацию.

Ещё один подход применяют... при нахождении первого байта, сравнить ещё 2: тот что посередине, и тот что в конце. Это позволит избежать большинства ложных сравнивающих циклов.

Наконец, если заморочиться, можно делать SSE операции чтения, выровненные на 16 байт.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39586763
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
SOFT FOR YOUОптимизировать многое что можно
Ты уверен, что оно тебе нужно? )))Вопрос конечно не только практический, но даже Философский!..)))
Практически - вариант поиска и замены мне удобней всего в плане подготовки данных и дальнейших действий!
Но на реальных данных - не шибко быстрый...
...
Ну а философски - типа "Нафига оно тебе надо... позже или раньше - все Там будем?"
Так что ли?..)
Отвечу - вот Там то как раз и не нужно ничего будет!
А тут - уж пожалуйста, двигайся, ибо движение - это Жизнь! Люби и будь любимым! Бегай, прыгай, ходи в бассейн или загорай на солнышке! Потому, что ты человек! И т.д. и т.п.
Ход мыслей моих понятен?
...
А может у Вас есть реальное предложение?..)

А вот у меня - пожалуй есть Задачка для толкового Кодера-СИшника-Дельфина, только денег заплатить не шибко много могу!..))
(Естественно - подробности не тут! - И так ОффТопим много!)
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39586767
rgreat
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Bellic,

Напиши в приват подробности.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39586770
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
rgreatНапиши в приват подробности.Пардон, но я Приватов тут не нахожу, разве что мыло в профиле
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39586771
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Bellic,

Ну дерзай. Все возможные пути оптимизации я тебе назвал
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39586772
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
SOFT FOR YOUНу дерзай. Все возможные пути оптимизации я тебе назвал
Спасибо!..))
RawByteString добью сначало - где то ошибку допустил и зациклился!

С КРЕЩЕНИЕМ, парни!!!
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39586841
white_nigger
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
А что, алгоритмы группы BM для быстрого поиска уже отменили?
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39586847
kealon(Ruslan)
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
white_niggerА что, алгоритмы группы BM для быстрого поиска уже отменили?да вообще какой-то трындец
Алгоритм Кнута — Морриса — Пратта это же rocket science
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39586860
white_nigger
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
kealon(Ruslan) Алгоритм Кнута — Морриса — Пратта это же rocket scienceИ не говори. Не любят классиков, всё велосипед изобретают оптимизаторы, ля :)
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39586877
kealon(Ruslan)
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
добавим ещё Алгоритм Бойера — Мура как самый простой для понимания
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39586887
white_nigger
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
kealon(Ruslan)добавим ещё Алгоритм Бойера — Мура как самый простой для пониманиядык я с этого начал white_niggerА что, алгоритмы группы BM для быстрого поиска уже отменили?
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39586931
kealon(Ruslan)
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
white_nigger,

да ссылочка на всякий случай
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587037
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
white_niggerА что, алгоритмы группы BM для быстрого поиска уже отменили?
А фиг его знает - я его не реализую пожалуй!..))
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587048
kep-ko
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Bellic, у тебя ужо всё есть и работает? токо скорость не устраивает? али как.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587058
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
kep-koBellic, у тебя ужо всё есть и работает? токо скорость не устраивает? али как.я уже писал.. на TByte на реальных данных файла в 9Мбайт прога работает чуть меньше 2-х минут, в принципе - я не спешу ни куда, зато алгоритм прозрачен полностью!
Сейчас реализовал на RawByteString + Pos(), но в начале цикла накуралесил чуток - зацикливается прога, никак не удается сосредоточиться, чтоб исправить алго... а сюда стыдно недоделку выложить!..((
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587063
YuRock
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Bellic9Мбайт прога работает чуть меньше 2-х минут
На 9мб должно работать за 0-16 миллисекунд примерно. Т.ч. есть поле для экспериментов :)

P.S. На AnsiString (RawByteString) не может оказаться быстрее, чем при работе с байтами. В лучшем случае, если всё правильно сделать (и компилятор всё правильно сделает своей магией работы с автоматическими типами) - так же по скорости.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587074
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
YuRock,
авторНа 9мб должно работать за 0-16 миллисекунд примерно. Т.ч. есть поле для экспериментов :)
9 Метров - это Бин-файл, а еще есть второй файл с фразами Поиска и Замены, от куда они читаются и потом ищутся и меняются в первом файле...)
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587078
Мимопроходящий
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
19.01.2018 13:52, Bellic пишет:
> а еще есть второй файл с фразами Поиска и Замены, от куда они читаются и потом ищутся и меняются в первом файле...)

если фраза для поиска не одна, имеет смысл наплодить потоков по количеству фраз.
Posted via ActualForum NNTP Server 1.5
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587083
YuRock
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Мимопроходящийесли фраза для поиска не одна, имеет смысл наплодить потоков по количеству фраз.
Если 2-я замена зависит от 1-й, то надо последовательно делать всё равно.

Bellicеще есть второй файл с фразами Поиска и Замены, от куда они читаются
Тогда
ОжидаемоеВремя = КолвоЗамен*( 0 тире 16мс )
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587086
Мимопроходящий
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
19.01.2018 14:01, YuRock пишет:
> Если 2-я замена зависит от 1-й, то надо последовательно делать всё равно.

притянуто за уши
Posted via ActualForum NNTP Server 1.5
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587098
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
YuRock,
автор Если 2-я замена зависит от 1-й, то надо последовательно делать всё равно.
Замены не зависят друг от друга, но надо делать последовательно, ибо позже введу туда вывод ИНфы для юзера и Подтверждение или Пропуск замены.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587103
Мимопроходящий
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
19.01.2018 14:19, Bellic пишет:
> Замены не зависят друг от друга, но надо делать последовательно, ибо позже введу туда вывод ИНфы для юзера и Подтверждение или Пропуск замены.

замены естественно делай последовательно.
после того, как ВСЁ найдёшь.
а вот сам поиск выполняй в разных потоках.
Posted via ActualForum NNTP Server 1.5
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587135
kep-ko
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Bellicстыдно недоделку выложить!..(([/i]де не дрейфь, мы хоть алгоритм осознаем, японский подучим )), ну и кодоидей подбросим.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587144
alekcvp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
kealon(Ruslan)добавим ещё Алгоритм Бойера — Мура как самый простой для понимания
Самый простой?.. Да КМП, что выше писали, проще на порядок :)
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587274
white_nigger
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
BellicА фиг его знает - я его не реализую пожалуй!..))Найди готовый. Или в гугле забанили? :)
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587276
kealon(Ruslan)
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
BellicYuRock,
авторНа 9мб должно работать за 0-16 миллисекунд примерно. Т.ч. есть поле для экспериментов :)
9 Метров - это Бин-файл, а еще есть второй файл с фразами Поиска и Замены, от куда они читаются и потом ищутся и меняются в первом файле...)
Рефал что ли изобретаешь?
для поиска всего и сразу используются вариации автоматных алгоритмов, Axo-Карасик например.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587287
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
kealon(Ruslan),

Кстати, согласен
Если искомых строк несколько, то предложенный мной вариант не катит
В таких ситуациях нужно делать хеш от первого символа
В идеале array[Char]
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587324
alekcvp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
SOFT FOR YOUЕсли искомых строк несколько, то предложенный мной вариант не катит
В таких ситуациях нужно делать хеш от первого символа

А если делать от первых трёх, то будет ещё быстрее :)
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587327
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
alekcvp,

3 байт или 3 юникодных символов?
В любом случае размер быстрого массива становится большим :) А хеш в привычном смысле будет долгим для каждого символа.

Ну и потом, кто сказал, что искомые строки обязаны состоять из 3+ символа?
Твой вариант такой ситуации не предполагает ))
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587372
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Интересно, а у автора - включена ли галочка оптимизации??

Вообще. Как мне кажется, проект надо его - полностью пересматривать с точку зрения логики.

Зачем он ищет в файлах ? И что это, за файлы ??? Что - то вроде архива ????

Если что - то вроде архива, то не легче было создать структурированную базу в начале файла, так называемый PE заголовок, который хранить адреса в фала (Смещения чтения) Нужных текстов, и их размер (С так далее) ....


Тогда бы работа с гигантскими файлами занимала считанные секунды, зная к каким данным - в какой области мы обращаемся.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587375
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Кстати, notepad ++ в файле размером 28,5 МБ (29 944 822 байт) ищет слово "ІеРюdx" за 2 секунды буквально. Которое находится в самом конце файла

Вот там алгоритм мощный..
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587384
чччД
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Няшик,

а ты SQL где-нибудь используешь?
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587385
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
чччДНяшик,

а ты SQL где-нибудь используешь?

Доводилась используй MySql из PHP пару десятков раз.


Я кстати, нашёл алгоритм поиска в файле в notepad ++
https://github.com/notepad-plus-plus/notepad-plus-plus/blob/51797bf59e689b11d80998758790f8a4cade68eb/scintilla/src/Document.cxx#L1648

Обычный while и for .... Интересно, а чего так быстро работает? Неужели компилятор c++ такой быстрый xD
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587389
чччД
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Няшик...Неужели компилятор c++ такой быстрый

Дельфи быстрее всех.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587426
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Няшик,

Запили обычный RawByteString из файла и Pos - он сработает быстрее, тем более под x86. А можно сделать ещё быстрее с SSE и применением пары алгоритмов.

Насколько я понял, у ТС задача поиска сразу нескольких слов в файле и при нахождении - замена. Все акцентируют своё внимание на поиске, хотя скорее всего проседает замена :)
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587427
Фотография makhaon
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
SOFT FOR YOU,

если нужно несколько фраз сильно быстрее искать 'деревом'. Все фразы представляются как дерево ветвления. Сравнивается первый байт каждой фразы с 'текущим', далее идёт ветвление, либо на выход, если ничего не нашлось, либо на конкретную фразу. Что-то наподобие как lzw работает по своим справочникам.
Ну и 'линейный' поиск стоит оптимизировать. Должно на 9 мб искаться моментально.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587436
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
makhaon,

Да, тут уже предлагали Ахо-Карасика
Только лучше не дерево, а хеш
И хеш по первому символу - array[Char]
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587463
Фотография Док
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
НяшикЗачем он ищет в файлах ? И что это, за файлы ??? Что - то вроде архива????
А ты тред с самого начала почитать не пробовал?
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587486
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
SOFT FOR YOU,

Опять про хэши..... Не могут быть хэши быстрее, так как - мы генерируем хэш для искаемого слова. И генерируем для сравнения.

По этому я в своём интерпретаторе использовал древовидный вид поиска лексем, как предложил выше makhaon



Док,

Сложно... Чтение не моё
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587497
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Няшик,

А кто виноват в том, что ты не умеешь хеши использовать?
Хеши в разы быстрее дерева. Тем более, если речь идёт о символах.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587498
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
SOFT FOR YOUНяшик,

А кто виноват в том, что ты не умеешь хеши использовать?
Хеши в разы быстрее дерева. Тем более, если речь идёт о символах.

Приведи пример - что ты имеешь введу под поиском - хэшом

Если ты собираешься сравнивать хэш, то ты должен для каждой N+1 генерировать новый хэш. Для искаемой строки.

Куда быстрее, чем просто сравнить ....
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587500
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Няшик,

Я уже раза 3 написал про массив от первого символа
И про алгоритм Ахо-Карасика

А твоё дерево лексем - это бред. С точки зрения оптимизации конечно.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587526
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
SOFT FOR YOU,

А где там про хэш хоть слово ?

https://ru.wikipedia.org/wiki/Алгоритм_Ахо_—_Корасик


SOFT FOR YOUА твоё дерево лексем - это бред. С точки зрения оптимизации конечно.

Посмотри что генерируют yacc в связке с bsion. Куча goto + switch
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587536
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Няшик,

У меня у самого есть суперкрутая утилита CachedSerializer, генерирующая case, и работающая со скоростью света.
Но этот подход хорош тогда, когда перечень строковых констант изначально предопределён и длина идентифицируемой строки в момент поиска известна.

В ситуации, когда в текстовом потоке мы выхватываем "лексемы", эта схема не работает, т.к. лексема и её длина зависит от последовательности символов. В этом случае актуален Ахо-Карасик, только подход при идентификации символов может быть разный. Можно делать полный перебор, поиск в сортированном массиве, дерево (и для заранее определённых констант можно написать case), но быстрее хешей всёравно ничего не будет.

В твоём компиляторе, к примеру, можно существенно ускорить идентификацию лексем до 3 символов за раз с помощью таблиц(хеш). И я хотел это продемонстрировать, только ты из своей же ветки почему-то заблаговременно слился. Такое впечатление, что ты не компилятор пишешь, а рекламируешь дельфовый case.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587561
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
SOFT FOR YOU,

Ну так приведи поиск по хэшам. Мб готовая реализации уже есть на том же гите ?
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587562
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
SOFT FOR YOUНяшик,
В твоём компиляторе, к примеру, можно существенно ускорить идентификацию лексем до 3 символов за раз с помощью таблиц(хеш). И я хотел это продемонстрировать, только ты из своей же ветки почему-то заблаговременно слился. Такое впечатление, что ты не компилятор пишешь, а рекламируешь дельфовый case.

У меня всё равно git. Один и тот же файл, два раза никак не перекомпилируется, если не был изменён. (И нет, он не будет весь компилировать. Только те участки, которые были изменены и добавлены)
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587566
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Няшик,

Ты просто не знаешь, как пользоваться хешами
И да, тебе с самого начала говорили, что не нужно заморачиваться на скорости трансляции скриптов, значительно важнее скорость исполнения
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587569
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
SOFT FOR YOU,

Да ты можешь наконец привести своё этакое чудо на хэшах? Или слился (Слился - слился, по настоящему)
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587571
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Няшик,

Да не вопрос
Приведи в качестве примера штук 20 своих лексем и напиши функцию, которая будет анализировать RawByteString и вызывать калбеки с описанием найденного.

А я сделаю то же самое через хеши с упрощённой реализацией
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587572
kealon(Ruslan)
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
SOFT FOR YOU, Няшик,


на чё спорите?
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587577
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
kealon(Ruslan),

На пинок :)
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587579
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
kealon(Ruslan),

Да не на что. Прощу привести пример, нет - же...


.... Вот те пример из 21 правда. Но ничё.

Код: pascal
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.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
160.
161.
162.
163.
164.
165.
166.
167.
168.
169.
170.
171.
172.
173.
174.
175.
176.
177.
178.
179.
180.
181.
182.
183.
184.
185.
186.
187.
188.
189.
190.
191.
192.
193.
194.
195.
196.
197.
198.
199.
200.
201.
202.
203.
204.
205.
206.
207.
208.
209.
210.
211.
212.
213.
214.
215.
216.
217.
218.
219.
220.
221.
222.
223.
224.
225.
226.
227.
228.
229.
230.
231.
232.
233.
234.
235.
236.
237.
238.
239.
240.
241.
242.
243.
244.
245.
246.
247.
248.
249.
250.
251.
252.
253.
254.
255.
256.
257.
258.
259.
260.
261.
262.
263.
264.
265.
266.
267.
268.
269.
270.
271.
272.
273.
274.
275.
276.
277.
278.
279.
280.
281.
282.
283.
284.
285.
286.
287.
288.
289.
290.
291.
292.
293.
294.
295.
296.
297.
298.
299.
300.
301.
302.
303.
304.
305.
306.
307.
308.
309.
310.
311.
312.
313.
314.
315.
316.
317.
318.
319.
320.
321.
322.
323.
324.
325.
326.
327.
328.
329.
330.
331.
332.
333.
334.
335.
336.
337.
338.
339.
340.
341.
342.
343.
344.
345.
346.
347.
348.
349.
350.
351.
352.
353.
354.
355.
356.
357.
358.
359.
360.
361.
362.
363.
364.
365.
366.
367.
368.
369.
370.
371.
372.
373.
374.
375.
376.
377.
378.
379.
380.
381.
382.
383.
384.
385.
386.
387.
388.
389.
390.
391.
392.
393.
394.
395.
396.
397.
398.
399.
400.
401.
402.
403.
404.
405.
406.
407.
408.
409.
410.
411.
412.
413.
414.
415.
416.
417.
418.
419.
420.
421.
422.
423.
424.
425.
426.
427.
428.
429.
430.
431.
432.
433.
434.
435.
436.
437.
438.
439.
440.
441.
442.
443.
444.
445.
446.
447.
448.
449.
450.
451.
452.
453.
454.
455.
456.
457.
458.
459.
460.
461.
462.
463.
464.
465.
466.
467.
468.
469.
470.
471.
472.
function GetNextToken(var StrCode: PWideChar; var Value: PWideChar;
  var StartToken: Cardinal; var LenToken: Byte): PHPTokenType;
label NewStart, TokenStr;
begin
NewStart:
  case WideToLower[PWord(StrCode)^] of
    61: // =
      case WideToLower[PWord(StrCode + 1)^] of
        61: // =
          case WideToLower[PWord(StrCode + 2)^] of
            61: // =
              begin
                CurrentToken := T_IS_IDENTICAL;
                inc(StrCode, 3);
              end;
          else
            begin
              CurrentToken := T_IS_EQUAL;
              inc(StrCode, 2);
            end;
          end;
        62: // >
          begin
            CurrentToken := T_DOUBLE_ARROW;
            inc(StrCode, 2);
          end;
      else
        begin
          CurrentToken := T_ASSIGN;
          inc(StrCode, 1);
        end;
      end;
    62: // >
      case WideToLower[PWord(StrCode + 1)^] of
        61: // =
          begin
            CurrentToken := T_IS_GREATER_OR_EQUAL;
            inc(StrCode, 2);
          end;
        62: // >
          case WideToLower[PWord(StrCode + 2)^] of
            61: // =
              begin
                CurrentToken := T_SR_EQUAL;
                inc(StrCode, 3);
              end;
          else
            begin
              CurrentToken := T_SR;
              inc(StrCode, 2);
            end;
          end;
      else
        begin
          CurrentToken := T_GREATER;
          inc(StrCode, 1);
        end;
      end;
    95: // _
      case WideToLower[PWord(StrCode + 1)^] of
        95: // _
          case WideToLower[PWord(StrCode + 2)^] of
            99: // c
              case WideToLower[PWord(StrCode + 3)^] of
                108: // l
                  case WideToLower[PWord(StrCode + 4)^] of
                    97: // a
                      case WideToLower[PWord(StrCode + 5)^] of
                        115: // s
                          case WideToLower[PWord(StrCode + 6)^] of
                            115: // s
                              case WideToLower[PWord(StrCode + 7)^] of
                                95: // _
                                  case WideToLower[PWord(StrCode + 8)^] of
                                    95: // _
                                      begin
                                        CurrentToken := T_CLASS_C;
                                        inc(StrCode, 9);
                                      end;
                                  else
                                    goto TokenStr;
                                  end;
                              else
                                goto TokenStr;
                              end;
                          else
                            goto TokenStr;
                          end;
                      else
                        goto TokenStr;
                      end;
                  else
                    goto TokenStr;
                  end;
              else
                goto TokenStr;
              end;
            100: // d
              case WideToLower[PWord(StrCode + 3)^] of
                105: // i
                  case WideToLower[PWord(StrCode + 4)^] of
                    114: // r
                      case WideToLower[PWord(StrCode + 5)^] of
                        95: // _
                          case WideToLower[PWord(StrCode + 6)^] of
                            95: // _
                              begin
                                CurrentToken := T_DIR;
                                inc(StrCode, 7);
                              end;
                          else
                            goto TokenStr;
                          end;
                      else
                        goto TokenStr;
                      end;
                  else
                    goto TokenStr;
                  end;
              else
                goto TokenStr;
              end;
          else
            goto TokenStr;
          end;
      else
        goto TokenStr;
      end;
    101: // e
      case WideToLower[PWord(StrCode + 1)^] of
        110: // n
          case WideToLower[PWord(StrCode + 2)^] of
            100: // d
              case WideToLower[PWord(StrCode + 3)^] of
                115: // s
                  case WideToLower[PWord(StrCode + 4)^] of
                    119: // w
                      case WideToLower[PWord(StrCode + 5)^] of
                        105: // i
                          case WideToLower[PWord(StrCode + 6)^] of
                            116: // t
                              case WideToLower[PWord(StrCode + 7)^] of
                                99: // c
                                  case WideToLower[PWord(StrCode + 8)^] of
                                    104: // h
                                      if IsCharNext(StrCode, 9) then
                                      begin
                                        CurrentToken := T_ENDSWITCH;
                                        inc(StrCode, 9);
                                      end
                                      else
                                        goto TokenStr;
                                  else
                                    goto TokenStr;
                                  end;
                              else
                                goto TokenStr;
                              end;
                          else
                            goto TokenStr;
                          end;
                      else
                        goto TokenStr;
                      end;
                  else
                    goto TokenStr;
                  end;
                119: // w
                  case WideToLower[PWord(StrCode + 4)^] of
                    104: // h
                      case WideToLower[PWord(StrCode + 5)^] of
                        105: // i
                          case WideToLower[PWord(StrCode + 6)^] of
                            108: // l
                              case WideToLower[PWord(StrCode + 7)^] of
                                101: // e
                                  if IsCharNext(StrCode, 8) then
                                  begin
                                    CurrentToken := T_ENDWHILE;
                                    inc(StrCode, 8);
                                  end
                                  else
                                    goto TokenStr;
                              else
                                goto TokenStr;
                              end;
                          else
                            goto TokenStr;
                          end;
                      else
                        goto TokenStr;
                      end;
                  else
                    goto TokenStr;
                  end;
              else
                goto TokenStr;
              end;
          else
            goto TokenStr;
          end;
      else
        goto TokenStr;
      end;
    103: // g
      case WideToLower[PWord(StrCode + 1)^] of
        111: // o
          case WideToLower[PWord(StrCode + 2)^] of
            116: // t
              case WideToLower[PWord(StrCode + 3)^] of
                111: // o
                  if IsCharNext(StrCode, 4) then
                  begin
                    CurrentToken := T_GOTO;
                    inc(StrCode, 4);
                  end
                  else
                    goto TokenStr;
              else
                goto TokenStr;
              end;
          else
            goto TokenStr;
          end;
      else
        goto TokenStr;
      end;
    105: // i
      case WideToLower[PWord(StrCode + 1)^] of
        102: // f
          if IsCharNext(StrCode, 2) then
          begin
            CurrentToken := T_IF;
            inc(StrCode, 2);
          end
          else
            goto TokenStr;
        115: // s
          case WideToLower[PWord(StrCode + 2)^] of
            115: // s
              case WideToLower[PWord(StrCode + 3)^] of
                101: // e
                  case WideToLower[PWord(StrCode + 4)^] of
                    116: // t
                      if IsCharNext(StrCode, 5) then
                      begin
                        CurrentToken := T_ISSET;
                        inc(StrCode, 5);
                      end
                      else
                        goto TokenStr;
                  else
                    goto TokenStr;
                  end;
              else
                goto TokenStr;
              end;
          else
            goto TokenStr;
          end;
      else
        goto TokenStr;
      end;
    108: // l
      case WideToLower[PWord(StrCode + 1)^] of
        105: // i
          case WideToLower[PWord(StrCode + 2)^] of
            115: // s
              case WideToLower[PWord(StrCode + 3)^] of
                116: // t
                  if IsCharNext(StrCode, 4) then
                  begin
                    CurrentToken := T_LIST;
                    inc(StrCode, 4);
                  end
                  else
                    goto TokenStr;
              else
                goto TokenStr;
              end;
          else
            goto TokenStr;
          end;
      else
        goto TokenStr;
      end;
    112: // p
      case WideToLower[PWord(StrCode + 1)^] of
        114: // r
          case WideToLower[PWord(StrCode + 2)^] of
            111: // o
              case WideToLower[PWord(StrCode + 3)^] of
                116: // t
                  case WideToLower[PWord(StrCode + 4)^] of
                    101: // e
                      case WideToLower[PWord(StrCode + 5)^] of
                        99: // c
                          case WideToLower[PWord(StrCode + 6)^] of
                            116: // t
                              case WideToLower[PWord(StrCode + 7)^] of
                                101: // e
                                  case WideToLower[PWord(StrCode + 8)^] of
                                    100: // d
                                      if IsCharNext(StrCode, 9) then
                                      begin
                                        CurrentToken := T_PROTECTED;
                                        inc(StrCode, 9);
                                      end
                                      else
                                        goto TokenStr;
                                  else
                                    goto TokenStr;
                                  end;
                              else
                                goto TokenStr;
                              end;
                          else
                            goto TokenStr;
                          end;
                      else
                        goto TokenStr;
                      end;
                  else
                    goto TokenStr;
                  end;
              else
                goto TokenStr;
              end;
          else
            goto TokenStr;
          end;
      else
        goto TokenStr;
      end;
    114: // r
      case WideToLower[PWord(StrCode + 1)^] of
        101: // e
          case WideToLower[PWord(StrCode + 2)^] of
            113: // q
              case WideToLower[PWord(StrCode + 3)^] of
                117: // u
                  case WideToLower[PWord(StrCode + 4)^] of
                    105: // i
                      case WideToLower[PWord(StrCode + 5)^] of
                        114: // r
                          case WideToLower[PWord(StrCode + 6)^] of
                            101: // e
                              case WideToLower[PWord(StrCode + 7)^] of
                                95: // _
                                  case WideToLower[PWord(StrCode + 8)^] of
                                    111: // o
                                      case WideToLower[PWord(StrCode + 9)^] of
                                        110: // n
                                        case WideToLower
                                        [PWord(StrCode + 10)^] of
                                        99: // c
                                        case WideToLower
                                        [PWord(StrCode + 11)^] of
                                        101: // e
                                        if IsCharNext(StrCode, 12) then
                                        begin
                                        CurrentToken := T_REQUIRE_ONCE;
                                        inc(StrCode, 12);
                                        end
                                        else
                                        goto TokenStr;
                                        else
                                        goto TokenStr;
                                        end;
                                        else
                                        goto TokenStr;
                                        end;
                                      else
                                        goto TokenStr;
                                      end;
                                  else
                                    goto TokenStr;
                                  end;
                              else
                                goto TokenStr;
                              end;
                          else
                            goto TokenStr;
                          end;
                      else
                        goto TokenStr;
                      end;
                  else
                    goto TokenStr;
                  end;
              else
                goto TokenStr;
              end;
            116: // t
              case WideToLower[PWord(StrCode + 3)^] of
                117: // u
                  case WideToLower[PWord(StrCode + 4)^] of
                    114: // r
                      case WideToLower[PWord(StrCode + 5)^] of
                        110: // n
                          if IsCharNext(StrCode, 6) then
                          begin
                            CurrentToken := T_RETURN;
                            inc(StrCode, 6);
                          end
                          else
                            goto TokenStr;
                      else
                        goto TokenStr;
                      end;
                  else
                    goto TokenStr;
                  end;
              else
                goto TokenStr;
              end;
          else
            goto TokenStr;
          end;
      else
        goto TokenStr;
      end;
    117: // u
      case WideToLower[PWord(StrCode + 1)^] of
        115: // s
          case WideToLower[PWord(StrCode + 2)^] of
            101: // e
              if IsCharNext(StrCode, 3) then
              begin
                CurrentToken := T_USE;
                inc(StrCode, 3);
              end
              else
                goto TokenStr;
          else
            goto TokenStr;
          end;
      else
        goto TokenStr;
      end;
    118: // v
      case WideToLower[PWord(StrCode + 1)^] of
        97: // a
          case WideToLower[PWord(StrCode + 2)^] of
            114: // r
              if IsCharNext(StrCode, 3) then
              begin
                CurrentToken := T_VAR;
                inc(StrCode, 3);
              end
              else
                goto TokenStr;
          else
            goto TokenStr;
          end;
      else
        goto TokenStr;
      end;
  else
  TokenStr:
    begin
      CurrentLenToken := 0;
      while not IsCharNext(StrCode, 0) do
      begin
        Value := Value + StrCode^;
        inc(StrCode);
        inc(CurrentLenToken);
      end;
      CurrentToken := T_STRING;
    end;
  end;
end;



Код: sql
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
:[use]: T_USE
:[var]: T_VAR
:[require_once]: T_REQUIRE_ONCE
:[return]: T_RETURN
:[protected]: T_PROTECTED
:[isset]: T_ISSET
:
    : T_LIST :[goto]: T_GOTO :[if]: T_IF :[endswitch]: T_ENDSWITCH :[endwhile]: T_ENDWHILE :[__CLASS__]: T_CLASS_C :[__DIR__]: T_DIR :[===]: T_IS_IDENTICAL :[==]: T_IS_EQUAL :[=>]: T_DOUBLE_ARROW :[=]: T_ASSIGN :[>>=]: T_SR_EQUAL :[>>]: T_SR :[>=]: T_IS_GREATER_OR_EQUAL :[>]: T_GREATER
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587580
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Выкладываю полный код моего генератора

Код: php
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.
$lexem = file_get_contents('lexem');
preg_match_all('/\:\[(.*)\]\:\s*([a-z0-9_]++)/i', $lexem, $v);
if(empty($v[1])) return;

$v = array_combine($v[1], $v[2]);
ksort($v, SORT_STRING);


$List = array("function GetNextToken(var StrCode: PWideChar; var Value: PWideChar;
  var StartToken: Cardinal; var LenToken: Byte): PHPTokenType;
label NewStart, TokenStr;
begin
NewStart:
    case WideToLower[PWord(StrCode)^] of
");

foreach($v as $ValueName => $TokenName) {
    $v = &$List;
    foreach(str_split($ValueName) as $Idx => $vKey) {
        $vKey = serialize(array($Idx, strtolower($vKey)));
        if(!isset($v[$vKey]))
            $v[$vKey] = array();
        elseif(!is_array($v[$vKey]))
            $v[$vKey] = array('Else' => $v[$vKey]);
        $v = &$v[$vKey];
    }

       $v = '   begin
                              CurrentToken :=  '.$TokenName.';
                              inc(StrCode, '. ($Idx + 1) . ');
                            end; ';
}

$Arr = range('a', 'z');

$PrintTokens = null;
$PrintTokens = &$PrintTokens;
$PrintTokens = function ($ListLines, $idx = 0) use (&$PrintTokens, &$Arr) {
    $Else = isset($ListLines['Else']) ? $ListLines['Else'] : 'goto TokenStr;';
    unset($ListLines['Else']);

   if(isset($ListLines[0])) {
        $tmp = $ListLines[0];
        unset($ListLines[0]);
    } else
        $tmp = " case WideToLower[PWord(StrCode + {$idx})^] of  ";

    foreach($ListLines as $i => $v) {
        $i = unserialize($i);
        $tmp .= ord($i[1]) . ': // ' . $i[1] . PHP_EOL . (is_array($v) ? $PrintTokens($v,$i[0]+1) :
                (in_array($i[1], $Arr) ? ' if IsCharNext(StrCode, '. ($i[0]+1)  .') then '
                . substr(trim($v), 0, -1) . ' else ' . $Else . ' ' : $v)
        );
    }

    return $tmp . ' else  '.$Else.' end; ';
};

$tmp = $PrintTokens($List);

if (($pos = strrpos($tmp, ' goto TokenStr;')) !== false) {
  $tmp = substr($tmp, 0, $pos);
  $tmp .= '         TokenStr:
          begin
            CurrentLenToken := 0;
            while not IsCharNext(StrCode, 0) do
            begin
              Value := Value + StrCode^;
              inc(StrCode);
              inc(CurrentLenToken);
            end;
            CurrentToken := T_STRING;
          end;
end;';
}

file_p_contents('tmp', $tmp . ' end;');

`Formatter -delphi tmp`;

...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587581
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Это старый генератор, и не жалко его сливать. В новом я всё под move переделал. К примеру

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
          TokenStr:
            begin
              i3 := 0;

              while not IsCharNext(StrCode, i3) do
                inc(i3);

              if i3 <> 0 then
              begin
                SetLength(Value, i3);
                MyMove(StrCode^, Value[1], i3 * SizeOf(EngineChar));
                inc(CurrentLenToken, i3);
                inc(StrCode, i3);
              end;
              CurrentToken := T_STRING;
            end;
          end;
        end;



Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
            36: // $
              begin

                if IsCharVARIABLE(StrCode, 1) then
                begin
                  CurrentToken := T_DOLLAR;
                  inc(StrCode);
                end
                else
                begin
                  CurrentToken := T_VARIABLE;

                  CurrentLenToken := 1;
                  while not IsCharVARIABLE2(StrCode, CurrentLenToken) do
                    inc(CurrentLenToken);

                  SetLength(Value, CurrentLenToken);

                  MyMove(StrCode^, Value[1],
                    CurrentLenToken * SizeOf(EngineChar));
                  inc(StrCode, CurrentLenToken);
                end;
              end;




Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
function IsCharNext(const StrCode: EngineType; i: EngineInt): EngineBool;
begin
  case EngineType(StrCode + i)^ of
    #0, '$', '!', '@', '#', '%', '^', '&', '*', '(', ')', '+', '[', ']', '{',
      '}', ':', '"', '|', '\', '''', ';', '<', '>', '?', '/', '.', #32, #10,
      #13, #9, ',', '-', '=', '`':
      Result := True;
  else
    Result := false;
  end;
end;


...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587582
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Няшик,

Приведи в качестве примера штук 20 своих лексем и напиши функцию, которая будет анализировать RawByteString и вызывать калбеки с описанием найденного.

Я что-то не вижу тестового проекта и оговоренной функции. Проверять корректность и замерять производительность мы на чем будем? На заднице? )
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587586
Гаджимурадов Рустам
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Замеряйте как угодно и на чём угодно, но в исходном
топике (Няшика или чей он там был), а не тут.
Posted via ActualForum NNTP Server 1.5
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587587
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Гаджимурадов Рустам,

В других случаях я бы с тобой согласился, ибо против офтопика. Но в данном случае ситуация Ахо-Корасика (т.е. ситуация ТС) в чистом виде.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587595
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
SOFT FOR YOU,

Вот проект. Тестируемый файл на 9,38 МБ (9 842 560 байт)

29120 строк с содержимым
isset return if goto === require_once and var protected use => __DIR__ >= endswitch >> __CLASS__ >> endwhile list === == = >>= > JUTRJHIROTJHOTBHNIkoorth iyko hjisset return if goto === require_once and var protected use => __DIR__ >= endswitch >> __CLASS__ >> endwhile list === == = >>= > JUTRJHIROTJHOTBHNIkoorth iyko hj


Время : 0,040280

Код проекта
Код: pascal
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.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
160.
161.
162.
163.
164.
165.
166.
167.
168.
169.
170.
171.
172.
173.
174.
175.
176.
177.
178.
179.
180.
181.
182.
183.
184.
185.
186.
187.
188.
189.
190.
191.
192.
193.
194.
195.
196.
197.
198.
199.
200.
201.
202.
203.
204.
205.
206.
207.
208.
209.
210.
211.
212.
213.
214.
215.
216.
217.
218.
219.
220.
221.
222.
223.
224.
225.
226.
227.
228.
229.
230.
231.
232.
233.
234.
235.
236.
237.
238.
239.
240.
241.
242.
243.
244.
245.
246.
247.
248.
249.
250.
251.
252.
253.
254.
255.
256.
257.
258.
259.
260.
261.
262.
263.
264.
265.
266.
267.
268.
269.
270.
271.
272.
273.
274.
275.
276.
277.
278.
279.
280.
281.
282.
283.
284.
285.
286.
287.
288.
289.
290.
291.
292.
293.
294.
295.
296.
297.
298.
299.
300.
301.
302.
303.
304.
305.
306.
307.
308.
309.
310.
311.
312.
313.
314.
315.
316.
317.
318.
319.
320.
321.
322.
323.
324.
325.
326.
327.
328.
329.
330.
331.
332.
333.
334.
335.
336.
337.
338.
339.
340.
341.
342.
343.
344.
345.
346.
347.
348.
349.
350.
351.
352.
353.
354.
355.
356.
357.
358.
359.
360.
361.
362.
363.
364.
365.
366.
367.
368.
369.
370.
371.
372.
373.
374.
375.
376.
377.
378.
379.
380.
381.
382.
383.
384.
385.
386.
387.
388.
389.
390.
391.
392.
393.
394.
395.
396.
397.
398.
399.
400.
401.
402.
403.
404.
405.
406.
407.
408.
409.
410.
411.
412.
413.
414.
415.
416.
417.
418.
419.
420.
421.
422.
423.
424.
425.
426.
427.
428.
429.
430.
431.
432.
433.
434.
435.
436.
437.
438.
439.
440.
441.
442.
443.
444.
445.
446.
447.
448.
449.
450.
451.
452.
453.
454.
455.
456.
457.
458.
459.
460.
461.
462.
463.
464.
465.
466.
467.
468.
469.
470.
471.
472.
473.
474.
475.
476.
477.
478.
479.
480.
481.
482.
483.
484.
485.
486.
487.
488.
489.
490.
491.
492.
493.
494.
495.
496.
497.
498.
499.
500.
501.
502.
503.
504.
505.
506.
507.
508.
509.
510.
511.
512.
513.
514.
515.
516.
517.
518.
519.
520.
521.
522.
523.
524.
525.
526.
527.
528.
529.
530.
531.
532.
533.
534.
535.
536.
537.
538.
539.
540.
541.
542.
543.
544.
545.
546.
547.
548.
549.
550.
551.
552.
553.
554.
555.
556.
557.
558.
559.
560.
561.
562.
563.
564.
565.
566.
567.
568.
569.
570.
571.
572.
573.
574.
575.
576.
577.
578.
579.
580.
581.
582.
583.
584.
585.
586.
587.
588.
589.
590.
591.
592.
593.
594.
595.
596.
597.
598.
599.
600.
601.
602.
603.
604.
605.
606.
607.
608.
609.
610.
611.
612.
613.
614.
615.
616.
617.
618.
619.
620.
621.
622.
623.
624.
625.
626.
627.
628.
629.
630.
631.
632.
633.
634.
635.
636.
637.
638.
639.
640.
641.
642.
643.
644.
645.
646.
647.
648.
649.
650.
651.
652.
653.
654.
655.
656.
657.
658.
659.
660.
661.
662.
663.
664.
665.
666.
program Project1;

{$APPTYPE CONSOLE}
{$R *.res}

uses
  Winapi.Windows,
  System.SysUtils,
  StringCASE;

var
  StartTime, StopTime: Int64;
  iCounterPerSec: Int64;

procedure BeginTime;
begin
  QueryPerformanceCounter(StartTime);
end;

procedure EndTime;
begin
  if QueryPerformanceCounter(StopTime) and QueryPerformanceFrequency
    (iCounterPerSec) then
    Writeln(Format('%.6f', [(StopTime - StartTime) / iCounterPerSec]));
end;

type
  PHPTokenType = (T_END, S_START, T_STRING, T_USE, T_VAR, T_REQUIRE_ONCE,
    T_RETURN, T_PROTECTED, T_ISSET, T_LIST, T_GOTO, T_IF, T_ENDSWITCH,
    T_ENDWHILE, T_CLASS_C, T_DIR, T_IS_IDENTICAL, T_IS_EQUAL, T_DOUBLE_ARROW,
    T_ASSIGN, T_SR_EQUAL, T_SR, T_IS_GREATER_OR_EQUAL, T_GREATER);

var
  TokenInfoString: array [PHPTokenType] of string = (
    'T_END',
    'S_START',
    'T_STRING',
    'T_USE',
    'T_VAR',
    'T_REQUIRE_ONCE',
    'T_RETURN',
    'T_PROTECTED',
    'T_ISSET',
    'T_LIST',
    'T_GOTO',
    'T_IF',
    'T_ENDSWITCH',
    'T_ENDWHILE',
    'T_CLASS_C',
    'T_DIR',
    'T_IS_IDENTICAL',
    'T_IS_EQUAL',
    'T_DOUBLE_ARROW',
    'T_ASSIGN',
    'T_SR_EQUAL',
    'T_SR',
    'T_IS_GREATER_OR_EQUAL',
    'T_GREATER'
  );

var
  filelen, tmpAllocSize: Int64;
  tmpStrCode: PWideChar;

  CurrentToken: PHPTokenType;
  StrCode: PWideChar;
  Value: String;
  CurrentLenToken, i, i2, i3, i4: Cardinal;

function IsCharNext2(i: Byte): Boolean;
begin
  case PWideChar(StrCode + i)^ of
    #0, #32, #10, #13, #9, '_', '=', '>':
      Result := true;
  else
    Result := false;
  end;
end;

function IsCharNext(i: Byte): Boolean; // inline;
begin
  case PWideChar(StrCode + i)^ of
    #0, '$', '!', '@', '#', '%', '^', '&', '*', '+', '[', ']', '{', '}', ':',
      '"', '|', '\', '''', ';', '<', '>', '?', '/', '.', #32, #10, #13, #9, ',',
      '-', '=', '`':
      Result := true;
  else
    Result := false;
  end;
end;

function GetNextToken(): Boolean;
label NewStart, TokenStr;
var
  x: Integer;
begin
  CurrentToken := T_END;
NewStart:
  case PWord(StrCode)^ or $0020 of
    ord(#32), ord(#9), ord(#13), ord(#10):
      begin
        x := 0;
        while true do
        begin
          case StrCode[x] of
            #10, #13, #32, #9:
              Inc(x);
          else
            begin
              Inc(StrCode, x);

              goto NewStart;
            end;
          end;
        end;
        Inc(x);
      end;

    61: // =
      case PWord(StrCode + 1)^ or $0020 of
        61: // =
          case PWord(StrCode + 2)^ or $0020 of
            61: // =
              begin
                CurrentToken := T_IS_IDENTICAL;
                Inc(StrCode, 3);
              end;
          else
            begin
              CurrentToken := T_IS_EQUAL;
              Inc(StrCode, 2);
            end;
          end;
        62: // >
          begin
            CurrentToken := T_DOUBLE_ARROW;
            Inc(StrCode, 2);
          end;
      else
        begin
          CurrentToken := T_ASSIGN;
          Inc(StrCode, 1);
        end;
      end;
    62: // >
      case PWord(StrCode + 1)^ or $0020 of
        61: // =
          begin
            CurrentToken := T_IS_GREATER_OR_EQUAL;
            Inc(StrCode, 2);
          end;
        62: // >
          case PWord(StrCode + 2)^ or $0020 of
            61: // =
              begin
                CurrentToken := T_SR_EQUAL;
                Inc(StrCode, 3);
              end;
          else
            begin
              CurrentToken := T_SR;
              Inc(StrCode, 2);
            end;
          end;
      else
        begin
          CurrentToken := T_GREATER;
          Inc(StrCode, 1);
        end;
      end;
    95: // _
      case PWord(StrCode + 1)^ or $0020 of
        95: // _
          case PWord(StrCode + 2)^ or $0020 of
            99: // c
              case PWord(StrCode + 3)^ or $0020 of
                108: // l
                  case PWord(StrCode + 4)^ or $0020 of
                    97: // a
                      case PWord(StrCode + 5)^ or $0020 of
                        115: // s
                          case PWord(StrCode + 6)^ or $0020 of
                            115: // s
                              case PWord(StrCode + 7)^ or $0020 of
                                95: // _
                                  case PWord(StrCode + 8)^ or $0020 of
                                    95: // _
                                      begin
                                        CurrentToken := T_CLASS_C;
                                        Inc(StrCode, 9);
                                      end;
                                  else
                                    goto TokenStr;
                                  end;
                              else
                                goto TokenStr;
                              end;
                          else
                            goto TokenStr;
                          end;
                      else
                        goto TokenStr;
                      end;
                  else
                    goto TokenStr;
                  end;
              else
                goto TokenStr;
              end;
            100: // d
              case PWord(StrCode + 3)^ or $0020 of
                105: // i
                  case PWord(StrCode + 4)^ or $0020 of
                    114: // r
                      case PWord(StrCode + 5)^ or $0020 of
                        95: // _
                          case PWord(StrCode + 6)^ or $0020 of
                            95: // _
                              begin
                                CurrentToken := T_DIR;
                                Inc(StrCode, 7);
                              end;
                          else
                            goto TokenStr;
                          end;
                      else
                        goto TokenStr;
                      end;
                  else
                    goto TokenStr;
                  end;
              else
                goto TokenStr;
              end;
          else
            goto TokenStr;
          end;
      else
        goto TokenStr;
      end;
    101: // e
      case PWord(StrCode + 1)^ or $0020 of
        110: // n
          case PWord(StrCode + 2)^ or $0020 of
            100: // d
              case PWord(StrCode + 3)^ or $0020 of
                115: // s
                  case PWord(StrCode + 4)^ or $0020 of
                    119: // w
                      case PWord(StrCode + 5)^ or $0020 of
                        105: // i
                          case PWord(StrCode + 6)^ or $0020 of
                            116: // t
                              case PWord(StrCode + 7)^ or $0020 of
                                99: // c
                                  case PWord(StrCode + 8)^ or $0020 of
                                    104: // h
                                      if IsCharNext(9) then
                                      begin
                                        CurrentToken := T_ENDSWITCH;
                                        Inc(StrCode, 9);
                                      end
                                      else
                                        goto TokenStr;
                                  else
                                    goto TokenStr;
                                  end;
                              else
                                goto TokenStr;
                              end;
                          else
                            goto TokenStr;
                          end;
                      else
                        goto TokenStr;
                      end;
                  else
                    goto TokenStr;
                  end;
                119: // w
                  case PWord(StrCode + 4)^ or $0020 of
                    104: // h
                      case PWord(StrCode + 5)^ or $0020 of
                        105: // i
                          case PWord(StrCode + 6)^ or $0020 of
                            108: // l
                              case PWord(StrCode + 7)^ or $0020 of
                                101: // e
                                  if IsCharNext(8) then
                                  begin
                                    CurrentToken := T_ENDWHILE;
                                    Inc(StrCode, 8);
                                  end
                                  else
                                    goto TokenStr;
                              else
                                goto TokenStr;
                              end;
                          else
                            goto TokenStr;
                          end;
                      else
                        goto TokenStr;
                      end;
                  else
                    goto TokenStr;
                  end;
              else
                goto TokenStr;
              end;
          else
            goto TokenStr;
          end;
      else
        goto TokenStr;
      end;
    103: // g
      case PWord(StrCode + 1)^ or $0020 of
        111: // o
          case PWord(StrCode + 2)^ or $0020 of
            116: // t
              case PWord(StrCode + 3)^ or $0020 of
                111: // o
                  if IsCharNext(4) then
                  begin
                    CurrentToken := T_GOTO;
                    Inc(StrCode, 4);
                  end
                  else
                    goto TokenStr;
              else
                goto TokenStr;
              end;
          else
            goto TokenStr;
          end;
      else
        goto TokenStr;
      end;
    105: // i
      case PWord(StrCode + 1)^ or $0020 of
        102: // f
          if IsCharNext(2) then
          begin
            CurrentToken := T_IF;
            Inc(StrCode, 2);
          end
          else
            goto TokenStr;
        115: // s
          case PWord(StrCode + 2)^ or $0020 of
            115: // s
              case PWord(StrCode + 3)^ or $0020 of
                101: // e
                  case PWord(StrCode + 4)^ or $0020 of
                    116: // t
                      if IsCharNext(5) then
                      begin
                        CurrentToken := T_ISSET;
                        Inc(StrCode, 5);
                      end
                      else
                        goto TokenStr;
                  else
                    goto TokenStr;
                  end;
              else
                goto TokenStr;
              end;
          else
            goto TokenStr;
          end;
      else
        goto TokenStr;
      end;
    108: // l
      case PWord(StrCode + 1)^ or $0020 of
        105: // i
          case PWord(StrCode + 2)^ or $0020 of
            115: // s
              case PWord(StrCode + 3)^ or $0020 of
                116: // t
                  if IsCharNext(4) then
                  begin
                    CurrentToken := T_LIST;
                    Inc(StrCode, 4);
                  end
                  else
                    goto TokenStr;
              else
                goto TokenStr;
              end;
          else
            goto TokenStr;
          end;
      else
        goto TokenStr;
      end;
    112: // p
      case PWord(StrCode + 1)^ or $0020 of
        114: // r
          case PWord(StrCode + 2)^ or $0020 of
            111: // o
              case PWord(StrCode + 3)^ or $0020 of
                116: // t
                  case PWord(StrCode + 4)^ or $0020 of
                    101: // e
                      case PWord(StrCode + 5)^ or $0020 of
                        99: // c
                          case PWord(StrCode + 6)^ or $0020 of
                            116: // t
                              case PWord(StrCode + 7)^ or $0020 of
                                101: // e
                                  case PWord(StrCode + 8)^ or $0020 of
                                    100: // d
                                      if IsCharNext(9) then
                                      begin
                                        CurrentToken := T_PROTECTED;
                                        Inc(StrCode, 9);
                                      end
                                      else
                                        goto TokenStr;
                                  else
                                    goto TokenStr;
                                  end;
                              else
                                goto TokenStr;
                              end;
                          else
                            goto TokenStr;
                          end;
                      else
                        goto TokenStr;
                      end;
                  else
                    goto TokenStr;
                  end;
              else
                goto TokenStr;
              end;
          else
            goto TokenStr;
          end;
      else
        goto TokenStr;
      end;
    114: // r
      case PWord(StrCode + 1)^ or $0020 of
        101: // e
          case PWord(StrCode + 2)^ or $0020 of
            113: // q
              case PWord(StrCode + 3)^ or $0020 of
                117: // u
                  case PWord(StrCode + 4)^ or $0020 of
                    105: // i
                      case PWord(StrCode + 5)^ or $0020 of
                        114: // r
                          case PWord(StrCode + 6)^ or $0020 of
                            101: // e
                              case PWord(StrCode + 7)^ or $0020 of
                                95: // _
                                  case PWord(StrCode + 8)^ or $0020 of
                                    111: // o
                                      case PWord(StrCode + 9)^ or $0020 of
                                        110: // n
                                        case PWord(StrCode + 10)^ or $0020 of
                                        99: // c
                                        case PWord(StrCode + 11)^ or $0020 of
                                        101: // e
                                        if IsCharNext(12) then
                                        begin
                                        CurrentToken := T_REQUIRE_ONCE;
                                        Inc(StrCode, 12);
                                        end
                                        else
                                        goto TokenStr;
                                        else
                                        goto TokenStr;
                                        end;
                                        else
                                        goto TokenStr;
                                        end;
                                      else
                                        goto TokenStr;
                                      end;
                                  else
                                    goto TokenStr;
                                  end;
                              else
                                goto TokenStr;
                              end;
                          else
                            goto TokenStr;
                          end;
                      else
                        goto TokenStr;
                      end;
                  else
                    goto TokenStr;
                  end;
              else
                goto TokenStr;
              end;
            116: // t
              case PWord(StrCode + 3)^ or $0020 of
                117: // u
                  case PWord(StrCode + 4)^ or $0020 of
                    114: // r
                      case PWord(StrCode + 5)^ or $0020 of
                        110: // n
                          if IsCharNext(6) then
                          begin
                            CurrentToken := T_RETURN;
                            Inc(StrCode, 6);
                          end
                          else
                            goto TokenStr;
                      else
                        goto TokenStr;
                      end;
                  else
                    goto TokenStr;
                  end;
              else
                goto TokenStr;
              end;
          else
            goto TokenStr;
          end;
      else
        goto TokenStr;
      end;
    117: // u
      case PWord(StrCode + 1)^ or $0020 of
        115: // s
          case PWord(StrCode + 2)^ or $0020 of
            101: // e
              if IsCharNext(3) then
              begin
                CurrentToken := T_USE;
                Inc(StrCode, 3);
              end
              else
                goto TokenStr;
          else
            goto TokenStr;
          end;
      else
        goto TokenStr;
      end;
    118: // v
      case PWord(StrCode + 1)^ or $0020 of
        97: // a
          case PWord(StrCode + 2)^ or $0020 of
            114: // r
              if IsCharNext(3) then
              begin
                CurrentToken := T_VAR;
                Inc(StrCode, 3);
              end
              else
                goto TokenStr;
          else
            goto TokenStr;
          end;
      else
        goto TokenStr;
      end;
  else
  TokenStr:
    begin
      i3 := 0;

      while not IsCharNext(i3) do
        Inc(i3);

      if i3 <> 0 then
      begin
        SetLength(Value, i3);
        Move(StrCode^, Value[1], i3 * SizeOf(WideChar));
        Inc(CurrentLenToken, i3);
        Inc(StrCode, i3);
        CurrentToken := T_STRING;
      end;

    end;
  end;

  Result := CurrentToken <> T_END;
end;

function GetTokenName(FTokenId: PHPTokenType): string; inline;
begin
  Result := TokenInfoString[FTokenId];
end;

function FileSeek64(Handle: THandle; const Offset: Int64;
  Origin: Integer): Int64;
begin
  Result := Offset;
  Int64Rec(Result).Lo := SetFilePointer(Handle, Int64Rec(Result).Lo,
    @Int64Rec(Result).Hi, Origin);
  if (Int64Rec(Result).Lo = $FFFFFFFF) and (GetLastError <> 0) then
    Int64Rec(Result).Hi := $FFFFFFFF;
end;

function LoadPHPFile(PHPFile: PWideChar): Boolean;

var
  TFile: THandle;
  baf: TBytes;

begin
  TFile := FileOpen(PHPFile, $0000 or $0020);
  Result := TFile <> INVALID_HANDLE_VALUE;
  if Result then
  begin
    filelen := FileSeek64(TFile, 0, 2);

    FileSeek64(TFile, 0, 0);
    SetLength(baf, filelen);
    FileRead(TFile, baf, 0, filelen);
    FileClose(TFile);

    tmpAllocSize := (filelen + 1) * SizeOf(WideChar);

    tmpStrCode := AllocMem(tmpAllocSize);

    MultiByteToWideChar(CP_UTF8, 8, @baf[0], filelen, @tmpStrCode[0], filelen);

    StrCode := tmpStrCode;

    Finalize(baf);

  end;
end;

procedure ClosePHPFile;
begin
  FreeMem(tmpStrCode, tmpAllocSize);
  tmpAllocSize := 0;
  tmpStrCode := nil;
  StrCode := nil;
  filelen := 0;
  CurrentToken := S_START;
  CurrentLenToken := 0;
  Value := '';
end;

begin
  BeginTime;

  LoadPHPFile('1.file');

  while GetNextToken do
  begin
   // Writeln(GetTokenName(CurrentToken) + '. Value(' + IntToStr(CurrentLenToken)
   //   + '):' + Value);
  end;

  ClosePHPFile;
  EndTime;

  Readln;

end.

...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587598
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Можно удалить StringCASE ... Это случайно попало - отходы промышленности
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587602
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Извиняюсь, нашёл баг

Время реальное - 0,148925
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587604
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Няшик,

Ранее ты опубликовал 21 лексему. Я уже пилю пример для них.
Запили аналогично

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
type
  TLexeme = (T_UNKNOWN, T_ASSIGN, T_GREATER, T_IS_EQUAL, T_DOUBLE_ARROW, T_SR,
    T_IS_GREATER_OR_EQUAL, T_IF, T_IS_IDENTICAL, T_SR_EQUAL, T_USE, T_VAR, T_LIST,
    T_GOTO, T_ISSET, T_RETURN, T_DIR, T_ENDWHILE, T_PROTECTED, T_ENDSWITCH, T_CLASS_C,
    T_REQUIRE_ONCE);

procedure LexemeFound(const Lexeme: TLexeme);
begin
  Writeln(GetEnumName(TypeInfo(TLexeme), Ord(Lexeme)));
end;

procedure ParseLexemes(const Text: AnsiString);
begin
  // Здесь
end;
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587620
kealon(Ruslan)
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
SOFT FOR YOU, Няшик

вообще то задача найти в тексте позиции содержащие слова из группы заданых строк, а не разложить его на лексемы


например, провести следующие подстановки

'abc' -> '1'
'abe' -> '2'
....

для порядка будем считать, что формально происходит последовательная подмена
Код: pascal
1.
2.
for i in Range(Count) do 
   v := StringReplace(v, Patern[i], Value[i], [rfReplaceAll])
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587621
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
kealon(Ruslan),

Так никто же не спорит
Просто Няшик предлагает деревья, а я предлагаю хеши

И мы рассматриваем частный случай его парсера, где набор искомых строк изначально известен, а значит, его можно захардкодить. Стандартный case по большому счёту и есть частный вид поиска по бинарному дереву
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587623
kealon(Ruslan)
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
SOFT FOR YOU,
kealon(Ruslan)вообще то задача найти в тексте позиции содержащие слова из группы заданых строк, а не разложить его на лексемы"разложение на лексемы" куда более примитивная задача
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587624
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Привет всем!
Я смотрю выходные даром не проходят - тема Топика переместилась в спор Ассов!?..))

Ну и у меня есть результат - допилил реальную свою процедуру на основе RawByteString и Pos() ...
Для начала скажу, что та же процедура, но с куском кода на разных "платформах", на одних и тех же входных файлах, дала следующие результаты:
- Memory -- 15-17 sec
- TByte -- 92-93 sec
- Raw+Pos -- 3-4 sec
Размер входных файлов:
- Бинарник в котором нужно искать и заменять - 10 Мбайт
- Файл с данными для Поиска и Замены содержащий 357 пар (время на распарсивание его тоже тратится) - 48 Кбайт
Количество произведенных замен - 526

Сам код получился достаточно коротким, но пришлось пошагово выловить несколько ошибок:
=Поиск и Замены на RawByteString + Pos()
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
AddressBin := 1;
while AddressBin <= (SizeBinFile - LenBPoisk + 1) do
   begin // Ищем подстроку
     AdrFind := Pos(RawPoisk, RawBin, AddressBin);
     if AdrFind > 0 then
	begin // Нашли фразу
	   // Копируем RawZamena в RawBin начиная с позиции AdrFind
	   Move(RawZamena[1], RawBin[AdrFind], LenBPoisk);
	   Inc(NumTrans); // Количество произведенных замен
	   // Коррекция на длину фразы, чтоб искать дальше
	   AddressBin := AdrFind + LenBPoisk;
	end
     else if AdrFind=0 then Break;
end;


Ну и пару вопросов по RawByteString :
- если в переменной этого типа уже есть данные, то следующее присваивание новых - выдает не правильный результат, в отличии от Sting?!
Может быть тут есть оператор позицирования?
Или же нужно тоже указывать начальную позицию?
т.е. вместо
Код: pascal
1.
RawPoisk := RawByteString(BPoisk);

писать
Код: pascal
1.
RawPoisk[1] := RawByteString(BPoisk);

???)
(мне пришлось делать RawPoisk=''; и RawZamena=''; )

- при записи в файл указал начало:
Код: pascal
1.
FBin.WriteBuffer(RawBin[1], SizeBinFile);
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587625
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Конечно же ускорить всю процедуру можно, но для этого потребуется всю ее перелопатить!
Я же сравнивал быстродействие, меняя чисто отдельный блок кода , отвечающий за Поиск и Замену!
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587626
kealon(Ruslan)
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Bellic,

ну чтож, значит с задачей угадали, однозначно Рефал переизобретён
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587627
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Bellic,

Выложишь тестовый проект ??? С файлами, с примером что должно получится. И так далее
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587629
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
В общем у меня готова реализация, которую можно назвать демонстрационной
Идея родилась как раз, когда Няшик мучил нас своими простынями нагенерированного кода для парсера
Причём огромная часть токенов имело вид <= >= == $ " >>> + - >>= и прочая штукенция

Сначала я сделал табличное преобразование первого символа. От case уйти не удалось, но зато появилась возможность сделать его последовательным, т.е. на x86 бинарное дерево поменять на jmp [eax * 4 + offset], т.е. сделал некое подобие хеша.

Соответственно и для задачи ТС предлагалось сделать array[Char] для первого символа, чтобы оперативно определять, символ S[i] является первым символом одной из искомых строк или нет. Вообще array[Char] - это частный быстрый вид хеша, его минус расход памяти, поэтому применим не всегда, но для первого символа - самое то.

Так вот, возвращаясь к задаче Няшика, я постоянно настаивал на том, что для скорости компиляции лучше использовать байтовую кодировку (UTF-8, например). Потом возникла мысль, что можно "хешировать" сразу 2 символа, но тогда понадобится 64Кб таблица. А потом возникла мысль, что можно "хешировать" сразу 3 символа, причём это может занять значительно меньше памяти, а все операторные лексемы (типа <= >= ===) будут охвачены, уйдут простыни кода и многочисленные ошибки предсказаний ветвлений. Вот пример.

Код: pascal
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.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
type
  TLexeme = (T_UNKNOWN, T_ASSIGN, T_GREATER, T_IS_EQUAL, T_DOUBLE_ARROW, T_SR,
    T_IS_GREATER_OR_EQUAL, T_IF, T_IS_IDENTICAL, T_SR_EQUAL, T_USE, T_VAR, T_LIST,
    T_GOTO, T_ISSET, T_RETURN, T_DIR, T_ENDWHILE, T_PROTECTED, T_ENDSWITCH, T_CLASS_C,
    T_REQUIRE_ONCE);

const
  LEXEME_LENGTH: array[Ord(Low(TLexeme))..Ord(High(TLexeme))] of Byte = (
    1, // :[?]: T_UNKNOWN
    1, // [=]: T_ASSIGN
    1, // [>]: T_GREATER
    2, // [==]: T_IS_EQUAL
    2, // [=>]: T_DOUBLE_ARROW
    2, // [>>]: T_SR
    2, // [>=]: T_IS_GREATER_OR_EQUAL
    2, // [if]: T_IF
    3, // [===]: T_IS_IDENTICAL
    3, // [>>=]: T_SR_EQUAL
    3, // [use]: T_USE
    3, // [var]: T_VAR
    4, // 
    : T_LIST 4, // [goto]: T_GOTO 5, // [isset]: T_ISSET 6, // [return]: T_RETURN 7, // [__DIR__]: T_DIR 8, // [endwhile]: T_ENDWHILE 9, // [protected]: T_PROTECTED 9, // [endswitch]: T_ENDSWITCH 9, // [__CLASS__]: T_CLASS_C 12 // [require_once]: T_REQUIRE_ONCE ); const TEST_CODE = '= > == => >> >= iF === >>= UsE vAr list goto' + 'isset return __DIR__ endwhile protected endswitch __CLASS__ require_once'; procedure LexemeFound(const Lexeme: TLexeme); begin Writeln(GetEnumName(TypeInfo(TLexeme), Ord(Lexeme))); end; procedure ParseLexemes(const Text: AnsiString); label unknown; type HugeByteArray = array[0..High(Integer) - 1] of Byte; var S: ^HugeByteArray; Value: NativeUInt; begin S := Pointer(Text); if (S = nil) then Exit; repeat // spaces, #0 Value := FIRST_CHARS[S[0]]; if (Value <= 1) then repeat Inc(PByte(S)); if (Value = 0{#0}) then Exit; Value := FIRST_CHARS[S[0]]; until (Value > 1); // offset (3 tables) Inc(Value, SECOND_CHARS[S[1]]); Inc(Value, THIRD_CHARS[S[2]]); // Lexeme Value := LEXEME_TABLE[Value]; if (Value >= NativeUInt(T_LIST){4 symbols}) then case Value of // 4, //
      : T_LIST Ord(T_LIST): begin if (S[3] or $20 <> Ord('t')) then goto unknown; end; // 4, // [goto]: T_GOTO Ord(T_GOTO): begin if (S[3] or $20 <> Ord('o')) then goto unknown; end; // 5, // [isset]: T_ISSET Ord(T_ISSET): begin if (S[3] or $20 <> Ord('e')) or (S[4] or $20 <> Ord('t')) then goto unknown; end; // 6, // [return]: T_RETURN Ord(T_RETURN): begin if (S[3] or $20 <> Ord('u')) or (S[4] or $20 <> Ord('r')) or (S[5] or $20 <> Ord('n')) then goto unknown; end; // 7, // [__DIR__]: T_DIR Ord(T_DIR): begin if (S[3] or $20 <> Ord('i')) or (S[4] or $20 <> Ord('r')) or (S[5] <> Ord('_')) or (S[6] <> Ord('_')) then goto unknown; end; // 8, // [endwhile]: T_ENDWHILE | 9, // [endswitch]: T_ENDSWITCH Ord(T_ENDWHILE): begin case (S[3] or $20) of Ord('w'): begin if (S[4] or $20 <> Ord('h')) or (S[5] or $20 <> Ord('i')) or (S[6] or $20 <> Ord('l')) or (S[7] or $20 <> Ord('e')) then goto unknown; end; Ord('s'): begin Value := Ord(T_ENDSWITCH); if (S[4] or $20 <> Ord('w')) or (S[5] or $20 <> Ord('i')) or (S[6] or $20 <> Ord('t')) or (S[7] or $20 <> Ord('c')) or (S[8] or $20 <> Ord('h')) then goto unknown; end; else goto unknown; end; end; // 9, // [protected]: T_PROTECTED Ord(T_PROTECTED): begin if (S[3] or $20 <> Ord('t')) or (S[4] or $20 <> Ord('e')) or (S[5] or $20 <> Ord('c')) or (S[6] or $20 <> Ord('t')) or (S[7] or $20 <> Ord('e')) or (S[8] or $20 <> Ord('d')) then goto unknown; end; // 9, // [__CLASS__]: T_CLASS_C Ord(T_CLASS_C): begin if (S[3] or $20 <> Ord('l')) or (S[4] or $20 <> Ord('a')) or (S[5] or $20 <> Ord('s')) or (S[6] or $20 <> Ord('s')) or (S[7] <> Ord('_')) or (S[8] <> Ord('_')) then goto unknown; end; // 12 // [require_once]: T_REQUIRE_ONCE Ord(T_REQUIRE_ONCE): begin if (S[3] or $20 <> Ord('u')) or (S[4] or $20 <> Ord('i')) or (S[5] or $20 <> Ord('r')) or (S[6] or $20 <> Ord('e')) or (S[7] <> Ord('_')) or (S[8] or $20 <> Ord('o')) or (S[9] or $20 <> Ord('n')) or (S[10] or $20 <> Ord('c')) or (S[11] or $20 <> Ord('e')) then goto unknown; end; else { вообще в данной ситуации никакого else не будет, но для иллюстрации выглядит неплохо } unknown: Value := Ord(T_UNKNOWN); end; // found lexeme LexemeFound(TLexeme(Value)); Inc(PByte(S), LEXEME_LENGTH[Value]); until (False); end;



Вот что на выходе:

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
T_ASSIGN
T_GREATER
T_IS_EQUAL
T_DOUBLE_ARROW
T_SR
T_IS_GREATER_OR_EQUAL
T_IF
T_IS_IDENTICAL
T_SR_EQUAL
T_USE
T_VAR
T_LIST
T_GOTO
T_ISSET
T_RETURN
T_DIR
T_ENDWHILE
T_PROTECTED
T_ENDSWITCH
T_CLASS_C
T_REQUIRE_ONCE

Но многобуквенные лексемы я бы как-нибудь приспособил под универсальный компаратор, честно говоря. Это вообще не та ситуация, где нужно использовать кодогенерацию, ИМХО.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587631
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Да, и тут у меня спрашивали - включена ли "Оптимизация"?
Т.к. сравнивать время выполнения начал еще при Выкл., то для чистоты экспериментов - далее ее не включал!

А вот скажите мне пожалуйста - почему она не включена "По умолчанию"?

Кстати - переход в режим Релиза, тоже даст результат, но я пока тестировал все в Дебаге!
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587632
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
SOFT FOR YOU,
Убедительная просьба - заведите пожалуйста для своих споров ОТДЕЛЬНУЮ тему!!!
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587633
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
kealon(Ruslan)SOFT FOR YOU,
kealon(Ruslan)вообще то задача найти в тексте позиции содержащие слова из группы заданых строк, а не разложить его на лексемы"разложение на лексемы" куда более примитивная задача

Согласен, что примитивная. Так как можно захардкодить.
Но зачем ты мне это пишешь? Я ещё раз акцентирую твоё внимание - вопрос поиска подходящих вершин по Ахо-Корасику: деревьями или хешем :)
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587634
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
kealon(Ruslan)Bellic,
ну чтож, значит с задачей угадали, однозначно Рефал переизобретён
Не совсем понял о чем речь? - Можно поподробнее?
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587636
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
BellicSOFT FOR YOU,
Убедительная просьба - заведите пожалуйста для своих споров ОТДЕЛЬНУЮ тему!!!

В споре рождается истина
Ты просил быстрый поиск нескольких строк или нет?
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587642
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Кстати

Здесь была интересная ветка про StringReplace, но её, похоже затёрли.
Так вот основная проблема StringReplace с множеством вхождений - в реаллоке памяти. Особенно, если речь идёт о нескольких мегабайтах.

Решение следующее. Мы анализируем всю строку и создаём массив структур вида <Указатель, Длина>, где Указатель это либо часть исходной строки, либо заменяемая строка.

Таким образом, когда анализ исходной строки заканчивается - мы имеем полное представление о результате. Сначала подсчитываем результирующую длину, выделяем требуемое количество памяти, потом последовательно заполняем результат нашими "кусками данных".

Там проблема была в том, где хранить массив структур <Указатель, Длина>. В качестве решения был базовый массив на стеке, а при нехватке дополнительно выделялись буферы в куче. На практике всегда хватает стека, но для общего случая реализация тоже подходит.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587647
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
НяшикВыложишь тестовый проект ??? С файлами, с примером что должно получится. И так далее
А история то начиналась еще с Мемори вот в этом Топике:
Поиск и Замена последовательности байт в бинарном файле
До этого была жуткая по времени (24 часа) реальная процедура на реальных файлах - на TFileStream , позже выделенный желтым участок кода был переделан на TByte , а сейчас вот на RawByteString ...)))
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587654
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
SOFT FOR YOU,

А почему код не полны ? Сам меня тыкал выложить полный. А сам свой не выложил.

Кстати, у меня UTF8 может обрабатывать, а твой только AnsiString. Как то немного не честно будет..
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587656
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Няшик,

Ну во-первых, тут без разницы. Можно хоть PAnsiChar указывать с нулём на конце. Во-вторых, ты свой тест так и не выложил, чтобы сравнить. В-третьих, что не хватило для компиляции?
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587660
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
SOFT FOR YOUНяшик,

Ну во-первых, тут без разницы. Можно хоть PAnsiChar указывать с нулём на конце. Во-вторых, ты свой тест так и не выложил, чтобы сравнить. В-третьих, что не хватило для компиляции?

Как не выложил?

21123284

Не хватает THIRD_CHARS и THIRD_CHARS
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587662
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Няшик , SOFT FOR YOU , я Вам не мешаю???..)))
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587664
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Bellic Няшик , SOFT FOR YOU , я Вам не мешаю???..)))

Нет, ты не большой. Можешь не волноваться
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587688
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
НяшикSOFT FOR YOUНяшик,

Ну во-первых, тут без разницы. Можно хоть PAnsiChar указывать с нулём на конце. Во-вторых, ты свой тест так и не выложил, чтобы сравнить. В-третьих, что не хватило для компиляции?

Как не выложил?

21123284

Не хватает THIRD_CHARS и THIRD_CHARS

Я же тебе чёрным по белому написал. Выложи код для 21 токена и байтовой кодировки: 21123290
А таблички я генерю, завтра выложу
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587689
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Bellic Няшик , SOFT FOR YOU , я Вам не мешаю???..)))

Мы обсуждаем твою тему. Что тебя не устраивает?
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587713
rgreat
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
SOFT FOR YOUКстати

Здесь была интересная ветка про StringReplace, но её, похоже затёрли.
Так вот основная проблема StringReplace с множеством вхождений - в реаллоке памяти. Особенно, если речь идёт о нескольких мегабайтах.

Решение следующее. Мы анализируем всю строку и создаём массив структур вида <Указатель, Длина>, где Указатель это либо часть исходной строки, либо заменяемая строка.

Таким образом, когда анализ исходной строки заканчивается - мы имеем полное представление о результате. Сначала подсчитываем результирующую длину, выделяем требуемое количество памяти, потом последовательно заполняем результат нашими "кусками данных".

Там проблема была в том, где хранить массив структур <Указатель, Длина>. В качестве решения был базовый массив на стеке, а при нехватке дополнительно выделялись буферы в куче. На практике всегда хватает стека, но для общего случая реализация тоже подходит.Зачем так сложно?
Выдели изначально памяти с запасом, потом урежешь. Вот и все.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587714
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
rgreat,

А ты не знаешь изначально, сколько будет результирующий размер.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587715
rgreat
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
SOFT FOR YOU,

Взять с запасом. Не хватит - увеличить вдвое.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587716
rgreat
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
По любому быстрей чем вручную считать.

Да и можно тупо OldPattern с NewPattern сравнить для оптимизации памяти.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587747
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
rgreat,

А чего не втрое?
Твоё решение топорное, простое
Моё решение академическое, элегантное

По скорости получается одинаково, но в моём случае есть гарантия, что лишних реаллоков памяти не будет.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587767
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
В продолжении к 21123582 выкладываю таблички

Код: pascal
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.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
const
  {14: #0, #1..#32, ?, 'u', 'v', 'r', 'p', 'i', 'l', 'g', 'e', '_', '=', '>'}
  FIRST_CHARS: array[0..255] of Byte = (
    $00, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01,
    $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $02, $02, $02, $02, $02, $02, $02,
    $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02,
    $02, $0C, $0D, $02, $02, $02, $02, $02, $02, $0A, $02, $09, $02, $07, $02, $02, $08, $02, $02, $02,
    $06, $02, $05, $02, $02, $03, $04, $02, $02, $02, $02, $02, $02, $02, $02, $0B, $02, $02, $02, $02,
    $02, $0A, $02, $09, $02, $07, $02, $02, $08, $02, $02, $02, $06, $02, $05, $02, $02, $03, $04, $02,
    $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02,
    $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02,
    $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02,
    $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02,
    $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02,
    $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02,
    $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02);

  {12: ?, 's', 'a', 'e', 'r', 'i', 'o', 'f', 'n', '_', '=', '>'}
  SECOND_CHARS: array[0..255] of Byte = (
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $8C, $9A, $00, $00, $1C, $00, $00, $00, $2A, $62, $00, $00, $46, $00, $00, $00, $00, $70, $54,
    $00, $00, $38, $0E, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $7E, $00, $1C, $00, $00,
    $00, $2A, $62, $00, $00, $46, $00, $00, $00, $00, $70, $54, $00, $00, $38, $0E, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00);

  {10: ?, 'e', 'r', 'q', 't', 'o', 's', 'd', 'c', '='}
  THIRD_CHARS: array[0..255] of Word = (
    $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000,
    $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000,
    $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000,
    $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000,
    $0000, $0000, $0000, $0000, $0000, $05E8, $0000, $0000, $0000, $0000, $0000, $0540, $0498, $00A8,
    $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0348, $0000, $01F8, $0150, $03F0,
    $02A0, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000,
    $0000, $0540, $0498, $00A8, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0348,
    $0000, $01F8, $0150, $03F0, $02A0, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000,
    $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000,
    $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000,
    $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000,
    $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000,
    $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000,
    $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000,
    $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000,
    $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000,
    $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000,
    $0000, $0000, $0000, $0000);

  LEXEME_TABLE: array[0..1679{14 * 12 * 10}] of Byte = (
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00,
    $00, $00, $00, $00, $00, $07, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $03, $06, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $04, $05, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $01, $02, $00, $00, $00, $0A, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $07, $00, $00, $00, $00, $01, $02,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $03, $06, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $04, $05, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $01, $02, $00, $00, $00, $00, $0B, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00,
    $00, $07, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $03, $06, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $04, $05, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $15, $00, $00, $00, $00, $00, $00, $01, $02,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $01, $02, $00, $00, $00, $00, $00, $00, $00, $07, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $03, $06, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $04, $05, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $0F,
    $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $0D, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $07, $00, $00,
    $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $03, $06, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $04, $05,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00,
    $00, $00, $12, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00,
    $00, $00, $00, $00, $00, $07, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $03, $06, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $04, $05, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $01, $02, $00, $00, $00, $00, $00, $00, $00, $0E, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00,
    $00, $00, $00, $00, $00, $00, $0C, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $07, $00, $00, $00, $00, $01, $02,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $03, $06, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $04, $05, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00,
    $00, $07, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $11, $00,
    $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $10, $01, $02, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $03, $06, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $04, $05, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $01, $02, $00, $00, $00, $00, $00, $00, $00, $07, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $14, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $03, $06, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $04, $05, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $07, $00, $00,
    $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $08, $06, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $04, $09);

...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587770
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Bellic,

Короче, выкладывай исходный файл и список замен. Хватит ходить вокруг да около :)
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587787
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Вы в своем споре похоже пропустили или проигнорировали мое сообщение 21123543 ?..(((
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587797
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Bellic,

Ничего не пропустил. Ты делал разные опыты с разными подходами. Но Ахо-Корасика я там не увидел. Почему?

Возможно твой вопрос с RawByteString связан с этим. Хоть и до конца не ясно, че ты хотел.

Поэтому посыл остаётся прежним. Выкладывай исходный файл и список замен.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587805
s62
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Bellic,

наверное где-то это было, но тема разрослась, а в первом сообщении не нашел: при замене, как я понял, длина новой подстроки совпадает с длиной старой, правильно? (то есть заменяем OldPattern на NewPattern и длины строк OldPattern и NewPattern равны?) Это я делаю вывод из
Код: pascal
1.
2.
3.
4.
begin // Нашли фразу
	   // Копируем RawZamena в RawBin начиная с позиции AdrFind
	   Move(RawZamena[1], RawBin[AdrFind], LenBPoisk);
...
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587816
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
авторНо Ахо-Корасика я там не увидел. Почему?SOFT FOR YOU, ты издеваешься? У меня код поиска и замены получился короче некуда!
Просадка во времени в Реальной процедуре - в другом месте видимо!
В сообщении 21123543 у меня было пара вопросов... Игнор?
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587818
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
s62 , да, в моем случае RawPoisk b RawZamena - равные по длине!
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587820
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Алгоритм Ахо — Корасик - конечно интересная штука, но я долго в нем буду разбираться..
Возможно изучу позже - сейчас отвлекают часто..)) Выходные всеж!
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587823
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
SOFT FOR YOU,

Да.. Быстрее в 1.6 раза, я в своём примере убрал сборку строку. И результаты

0,073298 Мой
0,046160 Твой

На файле из поста 21123284

Кинь статью почитать, про то, как генерировать такие хэши. Я программку динамическую напишу тогда уж, для генерации подобного


Код: pascal
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.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
160.
161.
162.
163.
164.
165.
166.
167.
168.
169.
170.
171.
172.
173.
174.
175.
176.
177.
178.
179.
180.
181.
182.
183.
184.
185.
186.
187.
188.
189.
190.
191.
192.
193.
194.
195.
196.
197.
198.
199.
200.
201.
202.
203.
204.
205.
206.
207.
208.
209.
210.
211.
212.
213.
214.
215.
216.
217.
218.
219.
220.
221.
222.
223.
224.
225.
226.
227.
228.
229.
230.
231.
232.
233.
234.
235.
236.
237.
238.
239.
240.
241.
242.
243.
244.
245.
246.
247.
248.
249.
250.
251.
252.
253.
254.
255.
256.
257.
258.
259.
260.
261.
262.
263.
264.
265.
266.
267.
268.
269.
270.
271.
272.
273.
274.
275.
276.
277.
278.
279.
280.
281.
282.
283.
284.
285.
286.
287.
288.
289.
290.
291.
292.
293.
294.
295.
296.
297.
298.
299.
300.
301.
302.
303.
304.
305.
306.
307.
308.
309.
310.
311.
312.
313.
314.
315.
316.
317.
318.
319.
320.
321.
322.
323.
324.
325.
326.
327.
328.
329.
330.
331.
332.
333.
334.
335.
336.
337.
338.
339.
340.
341.
342.
343.
344.
345.
346.
347.
348.
349.
350.
351.
352.
353.
354.
355.
356.
357.
358.
359.
360.
361.
362.
363.
364.
365.
366.
367.
368.
369.
370.
371.
372.
373.
374.
375.
376.
377.
378.
379.
380.
381.
382.
383.
384.
385.
386.
387.
388.
389.
390.
391.
392.
393.
394.
395.
396.
397.
398.
399.
400.
401.
402.
403.
404.
405.
406.
407.
408.
409.
410.
411.
412.
413.
414.
415.
416.
417.
418.
419.
420.
421.
422.
423.
424.
425.
426.
427.
428.
429.
430.
431.
432.
433.
434.
435.
436.
437.
438.
439.
440.
441.
442.
443.
444.
445.
446.
447.
448.
449.
450.
451.
452.
453.
454.
455.
456.
457.
458.
459.
460.
461.
462.
463.
464.
465.
466.
467.
468.
469.
470.
471.
472.
473.
474.
475.
476.
477.
478.
479.
480.
481.
482.
483.
484.
485.
486.
487.
488.
489.
490.
491.
492.
493.
494.
495.
496.
497.
498.
499.
500.
501.
502.
503.
504.
505.
506.
507.
508.
509.
510.
511.
512.
513.
514.
515.
516.
517.
518.
519.
520.
521.
522.
523.
524.
525.
526.
527.
528.
529.
530.
531.
532.
533.
534.
535.
536.
537.
538.
539.
540.
541.
542.
543.
544.
545.
546.
547.
548.
549.
550.
551.
552.
553.
554.
555.
556.
557.
558.
559.
560.
561.
562.
563.
564.
565.
566.
567.
568.
569.
570.
571.
572.
573.
574.
575.
576.
577.
578.
579.
580.
581.
582.
583.
584.
585.
586.
587.
588.
589.
590.
591.
592.
593.
594.
595.
596.
597.
598.
599.
600.
601.
602.
603.
604.
605.
606.
607.
608.
609.
610.
611.
612.
613.
614.
615.
616.
617.
618.
619.
620.
621.
622.
623.
624.
625.
626.
627.
628.
629.
630.
631.
632.
633.
634.
635.
636.
637.
638.
639.
640.
641.
642.
643.
644.
645.
646.
647.
648.
649.
650.
651.
652.
653.
654.
655.
656.
657.
658.
659.
660.
661.
662.
663.
664.
665.
666.
667.
668.
669.
670.
671.
672.
673.
674.
675.
676.
677.
678.
679.
680.
681.
682.
683.
684.
685.
686.
687.
688.
689.
690.
691.
692.
693.
694.
695.
696.
697.
698.
699.
700.
701.
702.
703.
704.
705.
706.
707.
708.
709.
710.
711.
712.
713.
714.
715.
716.
717.
718.
719.
720.
721.
722.
723.
724.
725.
726.
727.
728.
729.
730.
731.
732.
733.
734.
735.
736.
737.
738.
739.
740.
741.
742.
743.
744.
745.
746.
747.
748.
749.
750.
751.
752.
753.
754.
755.
756.
757.
758.
759.
760.
761.
762.
763.
764.
765.
766.
767.
768.
769.
770.
771.
772.
773.
774.
775.
776.
777.
778.
779.
780.
781.
782.
783.
784.
785.
786.
787.
788.
789.
790.
791.
792.
793.
794.
795.
796.
797.
798.
799.
800.
801.
802.
803.
804.
805.
806.
807.
808.
809.
810.
811.
812.
813.
814.
815.
816.
817.
818.
819.
820.
821.
822.
823.
824.
825.
826.
827.
828.
829.
830.
831.
832.
833.
834.
835.
836.
837.
838.
839.
840.
841.
842.
843.
844.
845.
846.
847.
848.
849.
850.
851.
852.
853.
854.
855.
856.
857.
858.
859.
860.
861.
862.
863.
864.
865.
866.
867.
868.
869.
870.
871.
872.
873.
874.
875.
876.
877.
878.
879.
880.
881.
882.
883.
884.
885.
886.
887.
888.
889.
890.
891.
892.
893.
894.
895.
896.
897.
898.
899.
900.
901.
902.
903.
904.
905.
906.
907.
908.
909.
910.
911.
912.
913.
914.
915.
916.
917.
918.
919.
920.
921.
922.
923.
924.
925.
926.
927.
928.
929.
930.
931.
932.
933.
934.
935.
936.
937.
938.
939.
940.
941.
942.
943.
944.
945.
946.
947.
948.
949.
950.
951.
952.
953.
954.
955.
956.
957.
958.
959.
960.
961.
962.
963.
964.
965.
966.
967.
968.
969.
970.
971.
972.
973.
974.
975.
976.
977.
978.
979.
980.
981.
982.
983.
984.
985.
986.
987.
988.
989.
990.
991.
992.
993.
994.
995.
996.
997.
998.
999.
1000.
1001.
1002.
1003.
1004.
1005.
1006.
1007.
1008.
1009.
1010.
program Project1;

{$APPTYPE CONSOLE}
{$R *.res}

uses
  Winapi.Windows,
  System.SysUtils, TypInfo;

const
  { 14: #0, #1..#32, ?, 'u', 'v', 'r', 'p', 'i', 'l', 'g', 'e', '_', '=', '>' }
  FIRST_CHARS: array [0 .. 255] of Byte = ($00, $01, $01, $01, $01, $01, $01,
    $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01,
    $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $02, $02, $02, $02,
    $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02,
    $02, $02, $02, $02, $02, $02, $02, $02, $02, $0C, $0D, $02, $02, $02, $02,
    $02, $02, $0A, $02, $09, $02, $07, $02, $02, $08, $02, $02, $02, $06, $02,
    $05, $02, $02, $03, $04, $02, $02, $02, $02, $02, $02, $02, $02, $0B, $02,
    $02, $02, $02, $02, $0A, $02, $09, $02, $07, $02, $02, $08, $02, $02, $02,
    $06, $02, $05, $02, $02, $03, $04, $02, $02, $02, $02, $02, $02, $02, $02,
    $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02,
    $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02,
    $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02,
    $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02,
    $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02,
    $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02,
    $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02,
    $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02,
    $02, $02, $02, $02, $02, $02, $02, $02, $02);

  { 12: ?, 's', 'a', 'e', 'r', 'i', 'o', 'f', 'n', '_', '=', '>' }
  SECOND_CHARS: array [0 .. 255] of Byte = ($00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $8C, $9A, $00, $00, $1C, $00,
    $00, $00, $2A, $62, $00, $00, $46, $00, $00, $00, $00, $70, $54, $00, $00,
    $38, $0E, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $7E, $00,
    $1C, $00, $00, $00, $2A, $62, $00, $00, $46, $00, $00, $00, $00, $70, $54,
    $00, $00, $38, $0E, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00);

  { 10: ?, 'e', 'r', 'q', 't', 'o', 's', 'd', 'c', '=' }
  THIRD_CHARS: array [0 .. 255] of Word = ($0000, $0000, $0000, $0000, $0000,
    $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000,
    $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000,
    $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000,
    $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000,
    $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000,
    $0000, $05E8, $0000, $0000, $0000, $0000, $0000, $0540, $0498, $00A8, $0000,
    $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0348, $0000, $01F8,
    $0150, $03F0, $02A0, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000,
    $0000, $0000, $0000, $0000, $0000, $0000, $0540, $0498, $00A8, $0000, $0000,
    $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0348, $0000, $01F8, $0150,
    $03F0, $02A0, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000,
    $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000,
    $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000,
    $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000,
    $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000,
    $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000,
    $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000,
    $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000,
    $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000,
    $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000,
    $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000,
    $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000,
    $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000);

  LEXEME_TABLE: array [0 .. 1679 { 14 * 12 * 10 } ] of Byte = ($00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $07, $00, $00,
    $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $03,
    $06, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $04, $05,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00,
    $00, $00, $0A, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00,
    $07, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $03, $06, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $04, $05, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01,
    $02, $00, $00, $00, $00, $0B, $00, $00, $00, $00, $00, $00, $00, $01, $02,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00,
    $00, $00, $00, $07, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $03, $06, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $04, $05, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $01, $02, $00, $00, $00, $00, $00, $15, $00, $00, $00, $00, $00, $00,
    $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01,
    $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00,
    $00, $00, $00, $00, $00, $00, $07, $00, $00, $00, $00, $01, $02, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $03, $06, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $04, $05, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $0F, $00, $00, $00,
    $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $0D, $00, $00,
    $01, $02, $00, $00, $00, $00, $00, $00, $00, $07, $00, $00, $00, $00, $01,
    $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $03, $06, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $04, $05, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $12,
    $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $07, $00, $00,
    $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $03,
    $06, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $04, $05,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00,
    $00, $00, $00, $00, $00, $00, $0E, $00, $00, $00, $00, $01, $02, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00,
    $00, $00, $00, $0C, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00,
    $07, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $03, $06, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $04, $05, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01,
    $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00,
    $00, $00, $00, $07, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $11, $00, $01, $02, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $10, $01, $02, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $03, $06, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $04, $05, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01,
    $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00,
    $00, $00, $00, $00, $00, $00, $07, $00, $00, $00, $00, $01, $02, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $14, $01, $02, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $03, $06, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $04, $05, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $01, $02, $00, $00, $00, $00, $00, $00, $00, $07, $00, $00, $00, $00, $01,
    $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $08, $06, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $04, $09);

type
  TLexeme = (T_UNKNOWN, T_ASSIGN, T_GREATER, T_IS_EQUAL, T_DOUBLE_ARROW, T_SR,
    T_IS_GREATER_OR_EQUAL, T_IF, T_IS_IDENTICAL, T_SR_EQUAL, T_USE, T_VAR,
    T_LIST, T_GOTO, T_ISSET, T_RETURN, T_DIR, T_ENDWHILE, T_PROTECTED,
    T_ENDSWITCH, T_CLASS_C, T_REQUIRE_ONCE);

const
  LEXEME_LENGTH: array [Ord(Low(TLexeme)) .. Ord(High(TLexeme))] of Byte = (1,
    // :[?]: T_UNKNOWN
    1, // [=]: T_ASSIGN
    1, // [>]: T_GREATER
    2, // [==]: T_IS_EQUAL
    2, // [=>]: T_DOUBLE_ARROW
    2, // [>>]: T_SR
    2, // [>=]: T_IS_GREATER_OR_EQUAL
    2, // [if]: T_IF
    3, // [===]: T_IS_IDENTICAL
    3, // [>>=]: T_SR_EQUAL
    3, // [use]: T_USE
    3, // [var]: T_VAR
    4, // 
    : T_LIST 4, // [goto]: T_GOTO 5, // [isset]: T_ISSET 6, // [return]: T_RETURN 7, // [__DIR__]: T_DIR 8, // [endwhile]: T_ENDWHILE 9, // [protected]: T_PROTECTED 9, // [endswitch]: T_ENDSWITCH 9, // [__CLASS__]: T_CLASS_C 12 // [require_once]: T_REQUIRE_ONCE ); var StartTime, StopTime: Int64; iCounterPerSec: Int64; procedure BeginTime; begin QueryPerformanceCounter(StartTime); end; procedure EndTime; begin if QueryPerformanceCounter(StopTime) and QueryPerformanceFrequency (iCounterPerSec) then Writeln(Format('%.6f', [(StopTime - StartTime) / iCounterPerSec])); end; type PHPTokenType = (T_END, S_START, T_STRING, T_USE1, T_VAR1, T_REQUIRE_ONCE1, T_RETURN1, T_PROTECTED1, T_ISSET1, T_LIST1, T_GOTO1, T_IF1, T_ENDSWITCH1, T_ENDWHILE1, T_CLASS_C1, T_DIR1, T_IS_IDENTICAL1, T_IS_EQUAL1, T_DOUBLE_ARROW1, T_ASSIGN1, T_SR_EQUAL1, T_SR1, T_IS_GREATER_OR_EQUAL1, T_GREATER1); var TokenInfoString: array [PHPTokenType] of string = ( 'T_END', 'S_START', 'T_STRING', 'T_USE', 'T_VAR', 'T_REQUIRE_ONCE', 'T_RETURN', 'T_PROTECTED', 'T_ISSET', 'T_LIST', 'T_GOTO', 'T_IF', 'T_ENDSWITCH', 'T_ENDWHILE', 'T_CLASS_C', 'T_DIR', 'T_IS_IDENTICAL', 'T_IS_EQUAL', 'T_DOUBLE_ARROW', 'T_ASSIGN', 'T_SR_EQUAL', 'T_SR', 'T_IS_GREATER_OR_EQUAL', 'T_GREATER' ); var filelen, tmpAllocSize: Int64; tmpStrCode: PWideChar; CurrentToken: PHPTokenType; StrCode: PWideChar; Value: String; CurrentLenToken, i, i2, i3, i4: Cardinal; function IsCharNext(i: Byte): Boolean; inline; begin case PWideChar(StrCode + i)^ of #0, '$', '!', '@', '#', '%', '^', '&', '*', '+', '[', ']', '{', '}', ':', '"', '|', '\', '''', ';', '<', '>', '?', '/', '.', #32, #10, #13, #9, ',', '-', '=', '`': Result := true; else Result := false; end; end; function GetNextToken(): Boolean; label NewStart, TokenStr; var x: Integer; begin CurrentToken := T_END; NewStart: case PWord(StrCode)^ or $0020 of 61: // = case PWord(StrCode + 1)^ or $0020 of 61: // = case PWord(StrCode + 2)^ or $0020 of 61: // = begin CurrentToken := T_IS_IDENTICAL1; Inc(StrCode, 3); end; else begin CurrentToken := T_IS_EQUAL1; Inc(StrCode, 2); end; end; 62: // > begin CurrentToken := T_DOUBLE_ARROW1; Inc(StrCode, 2); end; else begin CurrentToken := T_ASSIGN1; Inc(StrCode, 1); end; end; 62: // > case PWord(StrCode + 1)^ or $0020 of 61: // = begin CurrentToken := T_IS_GREATER_OR_EQUAL1; Inc(StrCode, 2); end; 62: // > case PWord(StrCode + 2)^ or $0020 of 61: // = begin CurrentToken := T_SR_EQUAL1; Inc(StrCode, 3); end; else begin CurrentToken := T_SR1; Inc(StrCode, 2); end; end; else begin CurrentToken := T_GREATER1; Inc(StrCode, 1); end; end; 95: // _ case PWord(StrCode + 1)^ or $0020 of 95: // _ case PWord(StrCode + 2)^ or $0020 of 99: // c case PWord(StrCode + 3)^ or $0020 of 108: // l case PWord(StrCode + 4)^ or $0020 of 97: // a case PWord(StrCode + 5)^ or $0020 of 115: // s case PWord(StrCode + 6)^ or $0020 of 115: // s case PWord(StrCode + 7)^ or $0020 of 95: // _ case PWord(StrCode + 8)^ or $0020 of 95: // _ begin CurrentToken := T_CLASS_C1; Inc(StrCode, 9); end; else goto TokenStr; end; else goto TokenStr; end; else goto TokenStr; end; else goto TokenStr; end; else goto TokenStr; end; else goto TokenStr; end; 100: // d case PWord(StrCode + 3)^ or $0020 of 105: // i case PWord(StrCode + 4)^ or $0020 of 114: // r case PWord(StrCode + 5)^ or $0020 of 95: // _ case PWord(StrCode + 6)^ or $0020 of 95: // _ begin CurrentToken := T_DIR1; Inc(StrCode, 7); end; else goto TokenStr; end; else goto TokenStr; end; else goto TokenStr; end; else goto TokenStr; end; else goto TokenStr; end; else goto TokenStr; end; 101: // e case PWord(StrCode + 1)^ or $0020 of 110: // n case PWord(StrCode + 2)^ or $0020 of 100: // d case PWord(StrCode + 3)^ or $0020 of 115: // s case PWord(StrCode + 4)^ or $0020 of 119: // w case PWord(StrCode + 5)^ or $0020 of 105: // i case PWord(StrCode + 6)^ or $0020 of 116: // t case PWord(StrCode + 7)^ or $0020 of 99: // c case PWord(StrCode + 8)^ or $0020 of 104: // h if IsCharNext(9) then begin CurrentToken := T_ENDSWITCH1; Inc(StrCode, 9); end else goto TokenStr; else goto TokenStr; end; else goto TokenStr; end; else goto TokenStr; end; else goto TokenStr; end; else goto TokenStr; end; 119: // w case PWord(StrCode + 4)^ or $0020 of 104: // h case PWord(StrCode + 5)^ or $0020 of 105: // i case PWord(StrCode + 6)^ or $0020 of 108: // l case PWord(StrCode + 7)^ or $0020 of 101: // e if IsCharNext(8) then begin CurrentToken := T_ENDWHILE1; Inc(StrCode, 8); end else goto TokenStr; else goto TokenStr; end; else goto TokenStr; end; else goto TokenStr; end; else goto TokenStr; end; else goto TokenStr; end; else goto TokenStr; end; else goto TokenStr; end; 103: // g case PWord(StrCode + 1)^ or $0020 of 111: // o case PWord(StrCode + 2)^ or $0020 of 116: // t case PWord(StrCode + 3)^ or $0020 of 111: // o if IsCharNext(4) then begin CurrentToken := T_GOTO1; Inc(StrCode, 4); end else goto TokenStr; else goto TokenStr; end; else goto TokenStr; end; else goto TokenStr; end; 105: // i case PWord(StrCode + 1)^ or $0020 of 102: // f if IsCharNext(2) then begin CurrentToken := T_IF1; Inc(StrCode, 2); end else goto TokenStr; 115: // s case PWord(StrCode + 2)^ or $0020 of 115: // s case PWord(StrCode + 3)^ or $0020 of 101: // e case PWord(StrCode + 4)^ or $0020 of 116: // t if IsCharNext(5) then begin CurrentToken := T_ISSET1; Inc(StrCode, 5); end else goto TokenStr; else goto TokenStr; end; else goto TokenStr; end; else goto TokenStr; end; else goto TokenStr; end; 108: // l case PWord(StrCode + 1)^ or $0020 of 105: // i case PWord(StrCode + 2)^ or $0020 of 115: // s case PWord(StrCode + 3)^ or $0020 of 116: // t if IsCharNext(4) then begin CurrentToken := T_LIST1; Inc(StrCode, 4); end else goto TokenStr; else goto TokenStr; end; else goto TokenStr; end; else goto TokenStr; end; 112: // p case PWord(StrCode + 1)^ or $0020 of 114: // r case PWord(StrCode + 2)^ or $0020 of 111: // o case PWord(StrCode + 3)^ or $0020 of 116: // t case PWord(StrCode + 4)^ or $0020 of 101: // e case PWord(StrCode + 5)^ or $0020 of 99: // c case PWord(StrCode + 6)^ or $0020 of 116: // t case PWord(StrCode + 7)^ or $0020 of 101: // e case PWord(StrCode + 8)^ or $0020 of 100: // d if IsCharNext(9) then begin CurrentToken := T_PROTECTED1; Inc(StrCode, 9); end else goto TokenStr; else goto TokenStr; end; else goto TokenStr; end; else goto TokenStr; end; else goto TokenStr; end; else goto TokenStr; end; else goto TokenStr; end; else goto TokenStr; end; else goto TokenStr; end; 114: // r case PWord(StrCode + 1)^ or $0020 of 101: // e case PWord(StrCode + 2)^ or $0020 of 113: // q case PWord(StrCode + 3)^ or $0020 of 117: // u case PWord(StrCode + 4)^ or $0020 of 105: // i case PWord(StrCode + 5)^ or $0020 of 114: // r case PWord(StrCode + 6)^ or $0020 of 101: // e case PWord(StrCode + 7)^ or $0020 of 95: // _ case PWord(StrCode + 8)^ or $0020 of 111: // o case PWord(StrCode + 9)^ or $0020 of 110: // n case PWord(StrCode + 10)^ or $0020 of 99: // c case PWord(StrCode + 11)^ or $0020 of 101: // e if IsCharNext(12) then begin CurrentToken := T_REQUIRE_ONCE1; Inc(StrCode, 12); end else goto TokenStr; else goto TokenStr; end; else goto TokenStr; end; else goto TokenStr; end; else goto TokenStr; end; else goto TokenStr; end; else goto TokenStr; end; else goto TokenStr; end; else goto TokenStr; end; else goto TokenStr; end; 116: // t case PWord(StrCode + 3)^ or $0020 of 117: // u case PWord(StrCode + 4)^ or $0020 of 114: // r case PWord(StrCode + 5)^ or $0020 of 110: // n if IsCharNext(6) then begin CurrentToken := T_RETURN1; Inc(StrCode, 6); end else goto TokenStr; else goto TokenStr; end; else goto TokenStr; end; else goto TokenStr; end; else goto TokenStr; end; else goto TokenStr; end; 117: // u case PWord(StrCode + 1)^ or $0020 of 115: // s case PWord(StrCode + 2)^ or $0020 of 101: // e if IsCharNext(3) then begin CurrentToken := T_USE1; Inc(StrCode, 3); end else goto TokenStr; else goto TokenStr; end; else goto TokenStr; end; 118: // v case PWord(StrCode + 1)^ or $0020 of 97: // a case PWord(StrCode + 2)^ or $0020 of 114: // r if IsCharNext(3) then begin CurrentToken := T_VAR1; Inc(StrCode, 3); end else goto TokenStr; else goto TokenStr; end; else goto TokenStr; end; else TokenStr: begin case PWord(StrCode)^ of Ord(#32), Ord(#9), Ord(#13), Ord(#10): begin x := 0; while true do begin case StrCode[x] of #10, #13, #32, #9: Inc(x); else begin Inc(StrCode, x); goto NewStart; end; end; end; Inc(x); end; end; i3 := 0; while not IsCharNext(i3) do Inc(i3); if i3 <> 0 then begin Inc(StrCode, i3); goto NewStart; end; { if i3 <> 0 then begin SetLength(Value, i3); Move(StrCode^, Value[1], i3 * SizeOf(WideChar)); Inc(CurrentLenToken, i3); Inc(StrCode, i3); CurrentToken := T_STRING; end; } end; end; Result := CurrentToken <> T_END; end; function GetTokenName(FTokenId: PHPTokenType): string; inline; begin Result := TokenInfoString[FTokenId]; end; function FileSeek64(Handle: THandle; const Offset: Int64; Origin: Integer): Int64; begin Result := Offset; Int64Rec(Result).Lo := SetFilePointer(Handle, Int64Rec(Result).Lo, @Int64Rec(Result).Hi, Origin); if (Int64Rec(Result).Lo = $FFFFFFFF) and (GetLastError <> 0) then Int64Rec(Result).Hi := $FFFFFFFF; end; function LoadPHPFile(PHPFile: PWideChar): Boolean; var TFile: THandle; baf: TBytes; begin TFile := FileOpen(PHPFile, $0000 or $0020); Result := TFile <> INVALID_HANDLE_VALUE; if Result then begin filelen := FileSeek64(TFile, 0, 2); FileSeek64(TFile, 0, 0); SetLength(baf, filelen); FileRead(TFile, baf, 0, filelen); FileClose(TFile); tmpAllocSize := (filelen + 1) * SizeOf(WideChar); tmpStrCode := AllocMem(tmpAllocSize); MultiByteToWideChar(CP_UTF8, 8, @baf[0], filelen, @tmpStrCode[0], filelen); StrCode := tmpStrCode; Finalize(baf); end; end; procedure ClosePHPFile; begin FreeMem(tmpStrCode, tmpAllocSize); tmpAllocSize := 0; tmpStrCode := nil; StrCode := nil; filelen := 0; CurrentToken := S_START; CurrentLenToken := 0; Value := ''; end; procedure LexemeFound(const Lexeme: TLexeme); begin Writeln(GetEnumName(TypeInfo(TLexeme), Ord(Lexeme))); end; procedure ParseLexemes(const Text: AnsiString); label unknown; type HugeByteArray = array [0 .. High(Integer) - 1] of Byte; var S: ^HugeByteArray; Value: NativeUInt; begin S := Pointer(Text); if (S = nil) then exit; repeat // spaces, #0 Value := FIRST_CHARS[S[0]]; if (Value <= 1) then repeat Inc(PByte(S)); if (Value = 0 { #0 } ) then exit; Value := FIRST_CHARS[S[0]]; until (Value > 1); // offset (3 tables) Inc(Value, SECOND_CHARS[S[1]]); Inc(Value, THIRD_CHARS[S[2]]); // Lexeme Value := LEXEME_TABLE[Value]; if (Value >= NativeUInt(T_LIST) { 4 symbols } ) then case Value of // 4, //
      : T_LIST Ord(T_LIST): begin if (S[3] or $20 <> Ord('t')) then goto unknown; end; // 4, // [goto]: T_GOTO Ord(T_GOTO): begin if (S[3] or $20 <> Ord('o')) then goto unknown; end; // 5, // [isset]: T_ISSET Ord(T_ISSET): begin if (S[3] or $20 <> Ord('e')) or (S[4] or $20 <> Ord('t')) then goto unknown; end; // 6, // [return]: T_RETURN Ord(T_RETURN): begin if (S[3] or $20 <> Ord('u')) or (S[4] or $20 <> Ord('r')) or (S[5] or $20 <> Ord('n')) then goto unknown; end; // 7, // [__DIR__]: T_DIR Ord(T_DIR): begin if (S[3] or $20 <> Ord('i')) or (S[4] or $20 <> Ord('r')) or (S[5] <> Ord('_')) or (S[6] <> Ord('_')) then goto unknown; end; // 8, // [endwhile]: T_ENDWHILE | 9, // [endswitch]: T_ENDSWITCH Ord(T_ENDWHILE): begin case (S[3] or $20) of Ord('w'): begin if (S[4] or $20 <> Ord('h')) or (S[5] or $20 <> Ord('i')) or (S[6] or $20 <> Ord('l')) or (S[7] or $20 <> Ord('e')) then goto unknown; end; Ord('s'): begin Value := Ord(T_ENDSWITCH); if (S[4] or $20 <> Ord('w')) or (S[5] or $20 <> Ord('i')) or (S[6] or $20 <> Ord('t')) or (S[7] or $20 <> Ord('c')) or (S[8] or $20 <> Ord('h')) then goto unknown; end; else goto unknown; end; end; // 9, // [protected]: T_PROTECTED Ord(T_PROTECTED): begin if (S[3] or $20 <> Ord('t')) or (S[4] or $20 <> Ord('e')) or (S[5] or $20 <> Ord('c')) or (S[6] or $20 <> Ord('t')) or (S[7] or $20 <> Ord('e')) or (S[8] or $20 <> Ord('d')) then goto unknown; end; // 9, // [__CLASS__]: T_CLASS_C Ord(T_CLASS_C): begin if (S[3] or $20 <> Ord('l')) or (S[4] or $20 <> Ord('a')) or (S[5] or $20 <> Ord('s')) or (S[6] or $20 <> Ord('s')) or (S[7] <> Ord('_')) or (S[8] <> Ord('_')) then goto unknown; end; // 12 // [require_once]: T_REQUIRE_ONCE Ord(T_REQUIRE_ONCE): begin if (S[3] or $20 <> Ord('u')) or (S[4] or $20 <> Ord('i')) or (S[5] or $20 <> Ord('r')) or (S[6] or $20 <> Ord('e')) or (S[7] <> Ord('_')) or (S[8] or $20 <> Ord('o')) or (S[9] or $20 <> Ord('n')) or (S[10] or $20 <> Ord('c')) or (S[11] or $20 <> Ord('e')) then goto unknown; end; else { вообще в данной ситуации никакого else не будет, но для иллюстрации выглядит неплохо } unknown: Value := Ord(T_UNKNOWN); end; // found lexeme // LexemeFound(TLexeme(Value)); Inc(PByte(S), LEXEME_LENGTH[Value]); until (false); end; begin LoadPHPFile('1.file'); BeginTime; while GetNextToken do begin // Writeln(GetTokenName(CurrentToken) + '. Value(' + IntToStr(CurrentLenToken) // + '):' + Value); end; EndTime; // Writeln('---------------'); BeginTime; ParseLexemes(AnsiString(tmpStrCode)); EndTime; ClosePHPFile; Readln; end.

...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587825
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Bellic,

3 секунды для 10Мб, а особенно с заменой на строки одинаковой длины - это ужасно медленно!
А вопросы твои ужасно сформулированы. Сформулируй по-человечески.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587826
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Нашел по вот http://forum.sources.ru/index.php?showtopic=173106&st=60] этому адресу уже готовый проект с алго "Ахо-Корасик"..))
Будет время - потестирую в разрезе своей реальной процедуры!
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587827
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Bellic,

Выложи свой проект с исходными данными и заменами. Хватит мучить наши мозги.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587830
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
SOFT FOR YOU3 секунды для 10Мб, а особенно с заменой на строки одинаковой длины - это ужасно медленно!Сказал же уже что проседает в другом месте!
А вопросы твои ужасно сформулированы. Сформулируй по-человечески.
Код: pascal
1.
2.
3.
4.
//Для переменых типа String:
s := 'privet';
s := 'poka';
// в результате s='poka'

А теперь попробуйте тоже самое сделать поменяв тип String на RawByteString !
Что-бы получить результат - мне пришлось сделать так:
Код: pascal
1.
2.
3.
4.
5.
//Для переменых типа RawByteString:
s := 'privet';
s :=''; // !!!!!!!!!
s := 'poka';
// в результате s='poka'


Почему нельзя просто переприсвоить значение новыми данными как со Стрингом?
может будет так правильно?:
Код: pascal
1.
2.
3.
4.
//Для переменых типа RawByteString:
s := 'privet';
s[1] := 'poka';
// в результате s='poka'

???
SOFT FOR YOU , надеюсь так мой вопрос понятен?
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587837
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
НяшикДа.. Быстрее в 1.6 раза, я в своём примере убрал сборку строку. И результаты

0,073298 Мой
0,046160 Твой

На файле из поста 21123284
Не корректно замерять производительность на таком файле. Там же UNKNOWN идентификаторы типа "JUTRJHIROTJHOTBHNIkoorth" и мой пример для каждой буквы будет выдавать unknown-токен. К тому же на практике буквенные операторы встречаются значительно реже, чем те же <= или $, а ты частоту их использования уравниваешь.

НяшикКинь статью почитать, про то, как генерировать такие хэши. Я программку динамическую напишу тогда уж, для генерации подобного
Нет никакой статьи. Да и генерацией хешей данную задачку нельзя назвать. Здесь идёт речь о генерации таблиц, и хешами они тут называются из-за отсылки к алгоритму Ахо-Корасика, где нужно идентифицировать символы.

Как и в ситуации ТС, так и в общем случае для подобного класса задач, я рекомендую создать array[Char] для первого символа, по которому уже можно будет определить, что с этим символом можно делать. В случае ТС может содержаться указатель на массив искомых идентификаторов по первой букве или nil. В твоём случае это может быть "класс первого символа".

Например, для #0 "класс первого символа" равен 0. Для всех пробельных символов (включая символы перевода каретки и табуляции) "класс первого символа" равен 1. Поэтому осуществить пропуск пробелов и отследить конец файла - получается весьма элегантно:
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
    // spaces, #0
    Value := FIRST_CHARS[S[0]];
    if (Value <= 1) then
    repeat
      Inc(PByte(S));
      if (Value = 0{#0}) then Exit;
      Value := FIRST_CHARS[S[0]];
    until (Value > 1);


Для буквенных лексем я бы выбрал всего один "класс первого символа" и их идентификацию сделал бы в отдельной функции. Ну а второй и третий символ - сделаны для быстрой идентификации всех твоих многочисленных операторов без ветвлений (надеюсь, ты уже в курсе, чем плоха ошибка предсказания ветвления) и простыней кода. Кидаю, как я генерировал таблички:

Код: pascal
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.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
160.
161.
162.
163.
164.
165.
166.
167.
168.
169.
170.
171.
172.
173.
174.
175.
176.
177.
178.
179.
180.
181.
182.
183.
184.
185.
186.
187.
188.
189.
190.
191.
192.
193.
194.
195.
196.
197.
198.
199.
200.
201.
202.
203.
204.
205.
206.
207.
208.
209.
210.
211.
212.
213.
214.
215.
216.
217.
218.
219.
220.
221.
222.
223.
224.
225.
226.
227.
228.
229.
230.
231.
232.
233.
234.
235.
236.
237.
238.
239.
240.
241.
242.
243.
244.
245.
246.
247.
248.
249.
250.
251.
252.
253.
254.
255.
256.
257.
258.
259.
260.
261.
262.
263.
264.
265.
266.
267.
268.
269.
270.
271.
272.
273.
274.
275.
276.
277.
278.
279.
280.
281.
282.
283.
284.
285.
286.
287.
288.
289.
290.
291.
292.
293.
294.
295.
296.
297.
298.
299.
300.
301.
302.
303.
304.
305.
306.
307.
308.
309.
310.
311.
312.
313.
314.
315.
const
  __FIRST_CHARS: array[0..13] of Char = ( {14}
    #0,
    #32,
    '?',
    'u', // use
    'v', // var
    'r', // require_once, return
    'p', // protected
    'i', // isset, if
    'l', // list
    'g', // goto
    'e', // endswitch, endwhile
    '_', // __CLASS__, __DIR__
    '=', // ===, ==, =>, =
    '>'  // >>=, >>, >=, >
  );

  __SECOND_CHARS: array[0..11] of Char = ( {12}
    '?',
    's', // use, isset
    'a', // var
    'e', // require_once, return
    'r', // protected
    'i', // list
    'o', // goto
    'f', // if
    'n', // endswitch, endwhile
    '_', // __CLASS__, __DIR__
    '=', // ===, ==, >=
    '>'  // >>=, >
  );

  __THIRD_CHARS: array[0..9] of Char = ( {10}
    '?',
    'e', // use
    'r', // var
    'q', // require_once
    't', // return, goto
    'o', // protected
    's', // isset, list
    'd', // endswitch, endwhile, __DIR__
    'c', // __CLASS__
    '='  // ===, >>=
  );

 (*
    Всего исходов: 14 * 12 * 10 = 1680
 *)

var
  {14: #0, #1..#32, ?, 'u', 'v', 'r', 'p', 'i', 'l', 'g', 'e', '_', '=', '>'}
  FIRST_CHARS: array[Byte{AnsiChar}] of Byte;
  {12: ?, 's', 'a', 'e', 'r', 'i', 'o', 'f', 'n', '_', '=', '>'}
  SECOND_CHARS: array[Byte{AnsiChar}] of Byte;
  {10: ?, 'e', 'r', 'q', 't', 'o', 's', 'd', 'c', '='}
  THIRD_CHARS: array[Byte{AnsiChar}] of Word;

  LEXEME_TABLE: array[0..14 * 12 * 10 - 1] of Byte{TLexeme};

procedure InitTables;
var
  i: Integer;
  C: Char;
  Lexeme: TLexeme;
  _F, _S, _T: Integer;
  F, S, T: Char;
begin
  FillChar(FIRST_CHARS, SizeOf(FIRST_CHARS), 2);
  for i := 1 to 32 do FIRST_CHARS[i] := 1;

  for i := 0 to High(__FIRST_CHARS) do
  begin
    C := __FIRST_CHARS[i];
    FIRST_CHARS[Ord(C)] := i;
    case C of
      'a'..'z': FIRST_CHARS[Ord(C) xor $20] := i;
    end;
  end;

  for i := 1 to High(__SECOND_CHARS) do
  begin
    C := __SECOND_CHARS[i];
    SECOND_CHARS[Ord(C)] := i * Length(__FIRST_CHARS);
    case C of
      'a'..'z': SECOND_CHARS[Ord(C) xor $20] :=  i * Length(__FIRST_CHARS);
    end;
  end;

  for i := 1 to High(__THIRD_CHARS) do
  begin
    C := __THIRD_CHARS[i];
    THIRD_CHARS[Ord(C)] := i * Length(__FIRST_CHARS) * Length(__SECOND_CHARS);
    case C of
      'a'..'z': THIRD_CHARS[Ord(C) xor $20] :=  i * Length(__FIRST_CHARS) * Length(__SECOND_CHARS);
    end;
  end;

  for i := Low(LEXEME_TABLE) to High(LEXEME_TABLE) do
  begin
    if (i = 166) then
    begin
      FIRST_CHARS[0] := FIRST_CHARS[0];
    end;

    _F := i mod Length(__FIRST_CHARS);
    _S := (i div (Length(__FIRST_CHARS)) mod Length(__SECOND_CHARS));
    _T := i div (Length(__FIRST_CHARS) * Length(__SECOND_CHARS));
    F := __FIRST_CHARS[_F];
    S := __SECOND_CHARS[_S];
    T := __THIRD_CHARS[_T];

    Lexeme := T_UNKNOWN;
    case F of
      'u': // use
      begin
        if (S = 's') and (T = 'e') then
          Lexeme := T_USE;
      end;
      'v': // var
      begin
        if (S = 'a') and (T = 'r') then
          Lexeme := T_VAR;
      end;
      'r': // require_once, return
      begin
        if (S = 'e') then
        case T of
          'q': Lexeme := T_REQUIRE_ONCE;
          't': Lexeme := T_RETURN;
        end;
      end;
      'p': // protected
      begin
        if (S = 'r') and (T = 'o') then
          Lexeme := T_PROTECTED;
      end;
      'i': // isset, if
      begin
        case S of
          'f': Lexeme := T_IF;
          's':
          begin
            if (T = 's') then
              Lexeme := T_ISSET;
          end;
        end;
      end;
      'l': // list
      begin
        if (S = 'i') and (T = 's') then
          Lexeme := T_LIST;
      end;
      'g': // goto
      begin
        if (S = 'o') and (T = 't') then
          Lexeme := T_GOTO;
      end;
      'e': // endswitch, endwhile
      begin
        if (S = 'n') and (T = 'd') then
          Lexeme := T_ENDWHILE;
      end;
      '_': // __CLASS__, __DIR__
      begin
        if (S = '_') then
        case T of
          'c': Lexeme := T_CLASS_C;
          'd': Lexeme := T_DIR;
        end;
      end;
      '=': // ===, ==, =>, =
      begin
        Lexeme := T_ASSIGN;
        case S of
          '=':
          begin
            Lexeme := T_IS_EQUAL;
            if (T = '=') then
              Lexeme := T_IS_IDENTICAL;
          end;
          '>':
          begin
            Lexeme := T_DOUBLE_ARROW;
          end;
        end;
      end;
      '>':  // >>=, >>, >=, >
      begin
        Lexeme := T_GREATER;
        case S of
          '>':
          begin
            Lexeme := T_SR;
            if (T = '=') then
              Lexeme := T_SR_EQUAL;
          end;
          '=':
          begin
            Lexeme := T_IS_GREATER_OR_EQUAL;
          end;
        end;
      end;
    end;

    LEXEME_TABLE[i] := Ord(Lexeme);
  end;
end;

procedure SaveTables;
var
  List: TStringList;

  procedure Add(const S: string); overload;
  begin
    List.Add(S);
  end;

  procedure Add(const FmtStr: string; const Args: array of const); overload;
  begin
    Add(Format(FmtStr, Args));
  end;

  procedure StartTable(const Name: string; const Count: Integer; const _Type: string);
  begin
    Add('  %s: array[0..%d] of %s = (', [Name, Count - 1, _Type]);
  end;

  procedure AddValuesLine(const Values: string; const Finish: Boolean);
  var
    S: string;
  begin
    S := '    ' + Values;

    if (Finish) then
    begin
      S[Length(S) - 1] := ')';
      S[Length(S)] := ';';
    end;

    Add(S);
    if (Finish) then
      Add('');
  end;

  procedure AddBytesLine(const Values: array of Byte; const Finish: Boolean);
  var
    i: Integer;
    S: string;
  begin
    for i := Low(Values) to High(Values) do
      S := S + Format('$%0.2x, ', [Values[i]]);

    AddValuesLine(S, Finish);
  end;

  procedure AddWordsLine(const Values: array of Word; const Finish: Boolean);
  var
    i: Integer;
    S: string;
  begin
    for i := Low(Values) to High(Values) do
      S := S + Format('$%0.4x, ', [Values[i]]);

    AddValuesLine(S, Finish);
  end;

  procedure AddBytes(const Name: string; const Values: array of Byte);
  const
    ITEMS_COUNT = 20;
  var
    Buffer, SubItems: TArray<Byte>;
  begin
    SetLength(Buffer, Length(Values));
    Move(Values, Pointer(Buffer)^, Length(Values) * SizeOf(Values[Low(Values)]));

    StartTable(Name, Length(Values), 'Byte');
    repeat
      SubItems := Copy(Buffer, 0, ITEMS_COUNT);
      Delete(Buffer, 0, ITEMS_COUNT);
      AddBytesLine(SubItems, (Buffer = nil));
    until (Buffer = nil);
  end;

  procedure AddWords(const Name: string; const Values: array of Word);
  const
    ITEMS_COUNT = 14;
  var
    Buffer, SubItems: TArray<Word>;
  begin
    SetLength(Buffer, Length(Values));
    Move(Values, Pointer(Buffer)^, Length(Values) * SizeOf(Values[Low(Values)]));

    StartTable(Name, Length(Values), 'Word');
    repeat
      SubItems := Copy(Buffer, 0, ITEMS_COUNT);
      Delete(Buffer, 0, ITEMS_COUNT);
      AddWordsLine(SubItems, (Buffer = nil));
    until (Buffer = nil);
  end;
begin
  List := TStringList.Create;
  try
    AddBytes('FIRST_CHARS', FIRST_CHARS);
    AddBytes('SECOND_CHARS', SECOND_CHARS);
    AddWords('THIRD_CHARS', THIRD_CHARS);
    AddBytes('LEXEME_TABLE', LEXEME_TABLE);

    List.SaveToFile('Tables.txt');
  finally
    List.Free;
  end;

  Halt;
end;

...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587838
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Я бы, для замена в строки массово слов. Нашёл сначала все слова которые надо заменить.

Дальше бы, выделил новую строку, вместе с длиной всех заменяемых символов.

Копировал бы строку в новую, до Н найденного. Копировал найденное. Передвинул указатель до X заменяемого. И так, пока всё не скопирую в новую строку.

А старую, бы, попутно через N количество отчищал, что бы память не гадить сильно.


....
Такой подход должен быстро работать, за счёт одного раза выделения новой памяти. И простому копирование в неё.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587839
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
BellicСказал же уже что проседает в другом месте!
Ты нас за лохов что ли держишь?
У тебя 357 пар замен на 48Кб, где он у тебя ещё может проседать при замене в одинаковую длину?

Bellicнадеюсь так мой вопрос понятен?
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
procedure TestString;
var
  S: string;
begin
  S := 'privet';
  S := 'poka';

  Writeln(S);
end;

procedure TestRawByteString;
var
  S: RawByteString;
begin
  S := 'privet';
  S := 'poka';

  Writeln(S);
end;



На выходе:
Код: plaintext
1.
poka
poka

Что я делаю не так?
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587845
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Вот код, одинаковый для фраз Поиска и Замены:
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
//--------------- Заполняем массив фразы Поиска ----------------------
DlinaPoiska := DlinaPoiska div 2; // Длина Фразы-поиска в Байтах
RawPoisk := '';
SetLength(BPoisk, (DlinaPoiska));  // Инициируем длину массива фразы Поиска байтах
for m  := 0 to DlinaPoiska-1 do    // Заполняем массив фразы Поиска в байтах
   begin //FPerevod.Seek(AddressPoiska + m*2, soFromBeginning);
         //FPerevod.ReadBuffer(SPSimvol[1],2);
         SPSimvol[1] := AnsiChar(BPerevod[AddressPoiska + m*2]);
         SPSimvol[2] := AnsiChar(BPerevod[AddressPoiska + m*2 + 1]);
         PSimvol := StrToInt('$' + SPSimvol);
         BPoisk[m] := PSimvol;
   end;
RawPoisk := RawByteString(BPoisk);

При повторном прохождении - без оператора во второй строке (RawPoisk := '';) - последняя строка дает неверный результат!
(Изначально фразы поиска и замены хранятся в Нех-виде, например: "31 32 33 34 45" - это соответственно цифры 1 2 3 4 5)
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587851
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
В данном коде как я понял, строка
Код: pascal
1.
RawPoisk := RawByteString(BPoisk);

Примерно аналогична присваиванию:
Код: pascal
1.
s := 'privet';

???
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587856
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Bellic,

Приведи полноценный тестовый проект (небольшой)
Где можно оттрейсить и найти проблему
Пока ты разговариваешь не непонятном языке
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587861
alekcvp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
BellicВ данном коде
В данном коде нет объявлений переменных, поэтому там может быть всё что угодно.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587897
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
SOFT FOR YOUВ продолжении к 21123582 выкладываю таблички

Код: pascal
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.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
const
  {14: #0, #1..#32, ?, 'u', 'v', 'r', 'p', 'i', 'l', 'g', 'e', '_', '=', '>'}
  FIRST_CHARS: array[0..255] of Byte = (
    $00, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01,
    $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $02, $02, $02, $02, $02, $02, $02,
    $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02,
    $02, $0C, $0D, $02, $02, $02, $02, $02, $02, $0A, $02, $09, $02, $07, $02, $02, $08, $02, $02, $02,
    $06, $02, $05, $02, $02, $03, $04, $02, $02, $02, $02, $02, $02, $02, $02, $0B, $02, $02, $02, $02,
    $02, $0A, $02, $09, $02, $07, $02, $02, $08, $02, $02, $02, $06, $02, $05, $02, $02, $03, $04, $02,
    $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02,
    $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02,
    $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02,
    $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02,
    $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02,
    $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02,
    $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02, $02);

  {12: ?, 's', 'a', 'e', 'r', 'i', 'o', 'f', 'n', '_', '=', '>'}
  SECOND_CHARS: array[0..255] of Byte = (
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $8C, $9A, $00, $00, $1C, $00, $00, $00, $2A, $62, $00, $00, $46, $00, $00, $00, $00, $70, $54,
    $00, $00, $38, $0E, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $7E, $00, $1C, $00, $00,
    $00, $2A, $62, $00, $00, $46, $00, $00, $00, $00, $70, $54, $00, $00, $38, $0E, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00);

  {10: ?, 'e', 'r', 'q', 't', 'o', 's', 'd', 'c', '='}
  THIRD_CHARS: array[0..255] of Word = (
    $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000,
    $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000,
    $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000,
    $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000,
    $0000, $0000, $0000, $0000, $0000, $05E8, $0000, $0000, $0000, $0000, $0000, $0540, $0498, $00A8,
    $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0348, $0000, $01F8, $0150, $03F0,
    $02A0, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000,
    $0000, $0540, $0498, $00A8, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0348,
    $0000, $01F8, $0150, $03F0, $02A0, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000,
    $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000,
    $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000,
    $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000,
    $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000,
    $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000,
    $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000,
    $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000,
    $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000,
    $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000,
    $0000, $0000, $0000, $0000);

  LEXEME_TABLE: array[0..1679{14 * 12 * 10}] of Byte = (
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00,
    $00, $00, $00, $00, $00, $07, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $03, $06, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $04, $05, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $01, $02, $00, $00, $00, $0A, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $07, $00, $00, $00, $00, $01, $02,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $03, $06, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $04, $05, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $01, $02, $00, $00, $00, $00, $0B, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00,
    $00, $07, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $03, $06, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $04, $05, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $15, $00, $00, $00, $00, $00, $00, $01, $02,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $01, $02, $00, $00, $00, $00, $00, $00, $00, $07, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $03, $06, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $04, $05, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $0F,
    $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $0D, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $07, $00, $00,
    $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $03, $06, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $04, $05,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00,
    $00, $00, $12, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00,
    $00, $00, $00, $00, $00, $07, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $03, $06, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $04, $05, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $01, $02, $00, $00, $00, $00, $00, $00, $00, $0E, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00,
    $00, $00, $00, $00, $00, $00, $0C, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $07, $00, $00, $00, $00, $01, $02,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $03, $06, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $04, $05, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00,
    $00, $07, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $11, $00,
    $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $10, $01, $02, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $03, $06, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $04, $05, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $01, $02, $00, $00, $00, $00, $00, $00, $00, $07, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $14, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $03, $06, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $04, $05, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $07, $00, $00,
    $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $02, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $08, $06, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $04, $09);



Начал тестировать твой код тщательнее.. И заметил, что у тебя колоссальная ошибка.

Ты не проверяешь конец слова, к примеру issetError и isset будут ровны, потому что он сравнит только isset и скипнет 5 символов.


И того,если ты добавишь проверки конца слова. Наши коды станут равноценными.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587911
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Няшик,

Так добавь проверку на конец слова сам в коде
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587962
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
alekcvpВ данном коде нет объявлений переменных, поэтому там может быть всё что угодно.
Прилагаю Тестовый проект в котором возникает ошибка в метке "Err" на втором проходе внешнего цикла (i).
В реальном проекте помогало разремливание строчки
Код: pascal
1.
//RawString := '';

Тут эта строка тоже выдает ошибку.
... открывать файл "file.tst" в каталоге проекта.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587970
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Bellic,

Во первых при диалоги открытии ты должен весь код засунуть в begin а не только извлечения имени файла.

Во вторых, у тебя два символа первых будут указывать на $00 = 0 что ровно #0 и твоя строка RawString дальше не выведется.

Пользуйся отладчиком. Ёмаё.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587979
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
НяшикВо первых при диалоги открытии ты должен весь код засунуть в begin а не только извлечения имени файла.
Няшик, Диалог - не суть вопроса, а просто подготовка!.. Это всеж Тестовый код, без проверок и прочего!
Если для тебя это сейчас важно - подправь у себя:
Код: pascal
1.
2.
3.
4.
if OpenDialog1.Execute then
          begin
               FullName := OpenDialog1.FileName;
          end;


Тогда уже и " Try--Finally--End " добавь себе для полноты счастья!..)))
...
я таки и смотрел все в отладчике! - Первый проход все нормально идет, как и запланировано!
Не придирайся к упрощению - запусти отладчик и посмотри сам лучше!
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587980
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Няшик, там так и задумано - первый $00 = 0 и т.д.
И все попадает и в массив и в RawString...
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587987
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Код: pascal
1.
RawString := RawByteString(BPoisk);


Нельзя таким образом приводить массив байт к строке
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587993
чччД
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
BellicПоиск последовательности в бинарном массиве
"Бинарный массив" - это что?
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587995
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
SOFT FOR YOU
Код: pascal
1.
RawString := RawByteString(BPoisk);

Нельзя таким образом приводить массив байт к строкеТогда как?
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39587997
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
чччД"Бинарный массив" - это что?
Вообще то подразумевалось - BFile: TBytes;

Но по совету Бывалых - уже давно на RawByteString перешли!..))
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39588000
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
SOFT FOR YOUНельзя таким образом приводить массив байт к строкеВообще - преобразование через Массив можно и исключить - он остался от реализации на TByte...
И даже BFile: TBytes; - файл сразу прочитать в RawByteString... но смысл преобразования должен остаться!
Видно мне еще мозгов не хватает, чтоб это преобразование (даже и не знаю как его назвать) сделать оптимально правильным..))
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39588001
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Bellic,


А теперь, открой диалог, и закрой его - словишь ошибку, отсутствия файла. Когда ты ничего не выбрал, но ты пытаешься открыть файл, читая переменную которая забита мусором.


....

Ты в отладчике глянь что там за первый символ, не 0. А #0 конец строки! В начале строки.

Вот так ошибок не будет
Код: pascal
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.
procedure TForm1.Test(Sender: TObject);
var
  FFile: TFileStream;
  FullName: string;
  i, m, Dlina, Addr: Integer;
  BPoisk: array of Byte; // Динамический массив
  RawString: RawByteString;
  SPSimvol: ansistring;
  PSimvol: Byte;
  BFile: TBytes;
label Err;
begin
  if OpenDialog1.Execute then
  begin
    FullName := OpenDialog1.FileName;
    FFile := TFileStream.Create(FullName, fmOpenRead);
    SetLength(BFile, FFile.Size);
    FFile.ReadBuffer(BFile, FFile.Size);
    FFile.Free;
    SetLength(SPSimvol, 2);
    Addr := 0;
    Dlina := 6;
    for i := 1 to 2 do
    begin
      Memo1.Lines.Add('Prohod-' + IntToStr(i));
      SetLength(BPoisk, Dlina); // Инициируем длину массива

      for m := 0 to Dlina - 1 do // Заполняем массив
      begin
        SPSimvol[1] := AnsiChar(BFile[Addr + m * 2]);
        SPSimvol[2] := AnsiChar(BFile[Addr + m * 2 + 1]);

        PSimvol := StrToInt('$' + SPSimvol);
        BPoisk[m] := PSimvol;
      end;
    Err:
      RawString := RawByteString(BPoisk);
      PInteger(PByte(RawString) - 8)^ := 0;
      Memo1.Lines.Add('Ok');
    end;
  end;
end;

...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39588003
YuRock
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
НяшикВот так ошибок не будет
Достаточно так:

Няшик
Код: pascal
1.
2.
if not OpenDialog1.Execute then
  Exit;


И лесенка не нужна.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39588004
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
YuRock,

Можно конечно же и так. Хотя в коде, разницы не будет
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39588005
YuRock
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
BellicВообще - преобразование через Массив можно и исключить - он остался от реализации на TByte...
И даже BFile: TBytes; - файл сразу прочитать в RawByteString... но смысл преобразования должен остаться!Не нужны никакие "преобразования", ни разу.
Сразу прочитать надо весь файл в один кусок памяти (TBytes, PByte, PAnsiChar, RawByteString - не важно) и дальше бегать по нему.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39588006
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Точнее в ассемблер, коде
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39588089
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
BellicSOFT FOR YOU
Код: pascal
1.
RawString := RawByteString(BPoisk);

Нельзя таким образом приводить массив байт к строкеТогда как?
Мне лень объяснять
Сразу читай в строку
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39588196
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
SOFT FOR YOUМне лень объяснять
Сразу читай в строку
Дык напиши тогда хоть строку кода - о чем думаешь, без объяснений!
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39588197
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Его код бред, он собирает по два символа

Код: pascal
1.
2.
        SPSimvol[1] := AnsiChar(BFile[Addr + m * 2]);
        SPSimvol[2] := AnsiChar(BFile[Addr + m * 2 + 1]);



Далее, он пытается перевести в Hex
Код: pascal
1.
 PSimvol := StrToInt('$' + SPSimvol);


Когда $00 = 0 и будет #0 (Конец строки) А что должно быть ?

Притом, хоть он и берёт по два символа. Но он использует стандартный for
Код: pascal
1.
for m := 0 to Dlina - 1 do 


Что значит, что m будет + 1 и если мы вернёмся к заполнению SPSimvol то мы опять же пишем пред последний символ записанный, + 1 новый.

Вместо выделения каких - то байт, мог бы выделить RawString и в неё писать по индексу.

..........

Этот код никогда не в какой мере, не должен был работать.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39588210
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
НяшикЭтот код никогда не в какой мере, не должен был работать.
Ну не знаю..
Предложи конкретный вариант кода...

А изначально, когда я еще пытался воспроизвести это на FileStream , там было сразу чтение 2-х байт:
Код: pascal
1.
2.
FPerevod.Seek(Addr + m*2, soFromBeginning);
FPerevod.ReadBuffer(SPSimvol[1],2);


Ну и после верхний код как то сам навеял это:
Код: pascal
1.
2.
PSimvol := StrToInt('$' + SPSimvol);
BPoisk[m] := PSimvol;


А твой вариант:
Код: pascal
1.
2.
Err:      RawString := RawByteString(BPoisk); // Ошибка на 2-м проходе
          PInteger(PByte(RawString) - 8)^ := 0;

и правда помог, но логичнее было бы вторую строку поставить до начала цикла m , потому что ниже с RawString -гом мне еще предстоит поработать!
Но перенеся " PInteger(PByte(RawString) - 8)^ := 0; " выше цикла - получаем Ошибку!
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39588218
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Bellic,

Читай сразу в строку
Что не понятного?
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39588221
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Bellic,

Ты опять несёшь опять бред.

1) Если ты используешь чтение 2 байт, то и получишь что было
2) Твой Hex перевод, в связке с FileStream даст тоже самое, что у тебя уже есть
3) Читай внимательнее

НяшикВместо выделения каких - то байт, мог бы выделить RawString и в неё писать по индексу.


4) Присвоения ссылок обязательна после, потому что ты присвоил массив байт. В котором ничего нету о количесте ссылок, и переменная RawString не на что не указывает, и у неё нет никакого счётчика = муссор = ERROR
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39588227
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
НяшикКогда $00 = 0 и будет #0 (Конец строки) А что должно быть ?
Няшик , а ты вижу - сам то брезгуешь глянуть что происходит с переменными в отладчике!?
А еще загляни что внутри файла "file.txt"!
А там записано "003132333435" и далее куча нулевых байт..
В Hexсе файл выглядит вот так:
Код: pascal
1.
30 30 33 31 33 32 33 33 33 34 35 00 00 00 .......

И задача - прочитать по 2 байта и получить:
00 (тут чисто Ноль), 31h-символ "1", 32h-"2", 33h-"3", ...
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39588238
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Возможно и бред.. но все работает!
Через 15 минут я останусь без света и компа, а вы все общими фразами кидаетесь, да оскорблениями!
Просили тестовый код - вот он есть! По моему суть перекодировки прозрачна!?
Ну может по вашему - не правильная! Возможно!
Ни на чего не притендую, но мне было бы проще понят - увидев конкретный вариант замены "моих ошибочных" строк, на
"ваши правильные"!
А выражения типа "присваивай сразу в строку" - понятие растяжимое!
Теперь я попрошу - приведите конкретный свой код, а не пустые слова!
Справедливо?
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39588247
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Тебя никто не оскорблял, и тебе уже всем помогли. Не строй из себя бедного, лишь потому что до сих пор понять ничего не можешь
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39588269
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Няшик, там ноль и должен быть!!!!
Разве нельзя его в RawByteString записать?
Это вообще то подготовка к Поиску и Замене, которую мы уже реализовали по вашему предложению на РавБайтСтрингах и Пос!
Кстати - нули в реале будут и в конце фраз Поиска и Замены!
Это как то противоречит идеалогии RAW?
...
Сижу без света...((( На мобиле..((
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39588551
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Bellic,

Код: pascal
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.
procedure TForm1.Test(Sender: TObject);
var
  FFile: TFileStream;
  FullName: string;
  i, m, Dlina, Addr: Integer;
  RawString: RawByteString;
  PSimvol: Byte;
  BFile: TBytes;
begin
   if OpenDialog1.Execute then
        FullName := OpenDialog1.FileName;

  FFile:=TFileStream.Create(FullName, fmOpenRead);
  try
    SetLength(BFile, FFile.Size);
    FFile.ReadBuffer(BFile, FFile.Size);
  finally
    FFile.Free;
  end;

  Addr := 0;
  Dlina := 6;
  for i := 1 to 2 do
  begin
    Memo1.Lines.Add('Prohod-'+IntToStr(i));

    //SetLength(BPoisk, Dlina);  // Инициируем длину массива
    SetLength(RawString, Dlina); {можно писать в массив байт, но мы будем писать в строку}
    for m := 0 to Dlina - 1 do    // Заполняем массив
    begin
      // быстрое чтение хекса
      PSimvol := BFile[Addr + m * 2] + (BFile[Addr + m * 2 + 1] shl 4);

      // BPoisk[m] := PSimvol;
      RawString[m + 1] := AnsiChar(PSimvol);
    end;

    Memo1.Lines.Add('Ok');
  end;
end;
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39588563
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Чёрт, совсем забыл :)

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
function HexToByte(const Value: Byte): Byte; inline;
begin
  Result := (Value or $20) - Byte('0');
  if (Result > 9) then
    Dec(Result, Ord('a') - Ord('0') - 10);
end;

      // быстрое чтение хекса
      PSimvol := HexToByte(BFile[Addr + m * 2]) + HexToByte(BFile[Addr + m * 2 + 1]) shl 4;
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39588568
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
SOFT FOR YOU, спасибо большое!!!
Догадывался, что мою мазню "перекодировки" с двумя байтами можно как то более элегантней реализовать!))) Возможно это даже не единственный вариант..
Надеюсь нули не отбрасывает, ибо они есть немаловажная часть получаемых строк!?
Вечером попробую на ХЕ и подопытных кроликах!)))
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39588645
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Только как это поможет искать в другом массиве ??? Если другой массив имеет мб другую последовательность байт, а не ту - которую уже тут навыдумывали.

ТС кстати похоже и сам не знает что там за последовательность байт
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39588649
rgreat
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
НяшикТС кстати похоже и сам не знает что там за последовательность байтИ это основная проблема Bellic в данном топике.

Все эти копания в сорцах - бессмысленны, пока ТС не поймет что ему нужно сделать. В деталях.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39588674
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
НяшикТолько как это поможет искать в другом массиве ??? Если другой массив имеет мб другую последовательность байт, а не ту - которую уже тут навыдумывали.
ТС кстати похоже и сам не знает что там за последовательность байт

rgreatИ это основная проблема Bellic в данном топике.
Все эти копания в сорцах - бессмысленны, пока ТС не поймет что ему нужно сделать. В деталях.
Зачем же так?
Программа собственно уже была написана мной и выполняла свою функцию, просто несколько неторопливо...
начал с простого распарсивания нужных данных, позже заострил внимание на сравнениях (ссылку не буду давать - помните несколько вариантов - на FileStream, TBufferedFileStream, TMemoryStream, TBytes...).
А вот в этой теме, по вашему же совету, в участке кода, отвечающем за Поиск и Замену, воспользовался RawByteString-ом вместо работы с Memory и TByte.
Так что "дом уже давно построен"!
Или вы думаете, что я щупаю сорцы, намереваясь позже из них строить еще не существующий код?
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39588678
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Большущее всем Вам Спасибо от чистого сердца, что помогали и возможно терпели мое непонимание в некоторых моментах!!!
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39588684
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Как я уже упоминал ранее - очень заинтересовал Алгоритм Ахо-Корасика в плане применения в программе...
Но что-бы его реально пощупать и сравнить - мне придется очень много переделывать в уже достаточно разросшемся коде (на самом деле - ту несколько отдельных утилит), а все из-за того, что для Алго Ахо-Корасика нужно сразу иметь "массив" того, что нужно искать!
У меня же пока реализован последовательный тип - распарсиваем одну пару Поиск-Замена, ищем и меняем в бинарнике, затем распарсиваем вторую пару и т.д.
А надо бы одним проходом распарсить все-привсе, а потом уже браться за поиск-замену, ну естественно прикрутив Карасика..)))
Наверняка там тоже появятся какие-то вопросы..)
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39588689
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Bellic,

Мне непонятно, как ты открыл старый замок - новым ключом.. Да так, что бы он отлично работал... Хотяя, мне кажется что это не последняя твоя тема мольбы о помощи, в том что ты не понимаешь


По мне так, string или же RawByteString или же даже AnsiString никакого значения не имеет - совсем. Так как идёт всё тоже самое присвоение по индексу, за счёт одного - раза, выделения памяти под данные.

И что бы не быть многословным, приведу примеры, из твоего же кода

Код: pascal
1.
2.
3.
var
  FullName: string;
  RawString: RawByteString;



Присвою им значение, и открою в отладчике. И гляну как ASM код отличается во всех случаях

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
Unit1.pas.46: FullName := 'ytjyuk';
8D45F8           lea eax,[ebp-$08]
BA5C805D00       mov edx,$005d805c
E85A23E3FF       call @UStrLAsg
Unit1.pas.47: RawString := 'ytjyuk';
8D45F4           lea eax,[ebp-$0c]
BA78805D00       mov edx,$005d8078
E8E923E3FF       call @LStrLAsg
Unit1.pas.49: FullName[1] := 'H';
8D45F8           lea eax,[ebp-$08]
E8C924E3FF       call @UniqueStringU
66C7004800       mov word ptr [eax],$0048
Unit1.pas.50: RawString[1] := 'H';
8D45F4           lea eax,[ebp-$0c]
E8C424E3FF       call @UniqueStringA
C60048           mov byte ptr [eax],$48




Можем заметить, что при присвоении по индексу, в случае RawByte был использован byte прессование, а там word

И использованы функции
Код: pascal
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.
procedure _LStrLAsg(var Dest: _AnsiStr; const Source: _AnsiStr);
var
  P: Pointer;
begin
  P := Pointer(Source);
  if P <> nil then
    _LStrAddRef(P);
  P := Pointer(Dest);
  Pointer(Dest) := Pointer(Source);
  _LStrClr(P);
end;

procedure _UStrLAsg(var Dest: UnicodeString; const Source: UnicodeString); // locals
var
  P: Pointer;
begin
  if Pointer(Source) <> nil then
    _UStrAddRef(Pointer(Source));
  P := Pointer(Dest);
  Pointer(Dest) := Pointer(Source);
  _UStrClr(P);
end;

function _LStrClr(var S): Pointer;
var
  P: PStrRec;
begin
  if Pointer(S) <> nil then
  begin
    P := Pointer(PByte(S) - SizeOf(StrRec));
    Pointer(S) := nil;
    if P.refCnt > 0 then
    begin
      if AtomicDecrement(P.refCnt) = 0 then
        FreeMem(P);
    end;
  end;
  Result := @S;
end;

function _UStrClr(var S): Pointer;
var
  P: PStrRec;
begin
  if Pointer(S) <> nil then
  begin
    P := Pointer(PByte(S) - SizeOf(StrRec));
    Pointer(S) := nil;
    if P.refCnt > 0 then
    begin
      if AtomicDecrement(P.refCnt) = 0 then
        FreeMem(P);
    end;
  end;
  Result := @S;
end;



Но как видим, всё это ягоды одного поля, и разница если будет, то очень не большая.

Так что, нужно написать тестер - который покажет, есть ли она разница и на сколько

Код: pascal
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.
program Project1;

{$APPTYPE CONSOLE}
{$R *.res}

uses
  Winapi.Windows,
  System.SysUtils;

var
  StartTime, StopTime: Int64;
  iCounterPerSec: Int64;
  I, S: Integer;

procedure BeginTime;
begin
  QueryPerformanceCounter(StartTime);
end;

procedure EndTime;
begin
  if QueryPerformanceCounter(StopTime) and QueryPerformanceFrequency
    (iCounterPerSec) then
    Writeln(Format('%.6f', [(StopTime - StartTime) / iCounterPerSec]));
end;

procedure TestString;
var
  str: string;
  r: Integer;
begin
  SetLength(str, 255);
  for I := 0 to 50000000 do
  begin
    r := I mod 255;
    str[r] := chr(r);
  end;
end;

procedure TestRawByteString;
var
  str: RawByteString;
  r: Integer;
begin
  SetLength(str, 255);
  for I := 0 to 50000000 do
  begin
    r := I mod 255;
    str[r] := AnsiChar(r);
  end;
end;

procedure TestStringGlobalSet;
var
  str: string;
  r: Integer;
begin
  for S := 0 to 10000 do
  begin
    str := '';
    for I := 0 to 1000 do
      str := str + chr(I);
  end;
end;

procedure TestRawByteStringGlobalSet;
var
  str: RawByteString;
  r: Integer;
begin
  for S := 0 to 10000 do
  begin
    str := '';
    for I := 0 to 1000 do
      str := str + AnsiChar(I);
  end;
end;

begin
  Write('String Set Index: ');
  BeginTime;
  TestString;
  EndTime;

  Write('RawByteString Set Index: ');
  BeginTime;
  TestString;
  EndTime;

  Writeln(' ---------- ');

  Write('String Set global: ');
  BeginTime;
  TestStringGlobalSet;
  EndTime;

  Write('RawByteString Set global: ');
  BeginTime;
  TestRawByteStringGlobalSet;
  EndTime;

  Readln;

end.



Тесты такие
String Set Index: 0,294398
RawByteString Set Index: 0,291288
----------
String Set global: 0,584003
RawByteString Set global: 0,599694

Ураа!!! В случае установки по индексу, ты выиграл целых 0.00311!!!!! Поздравляю!!!!
Но в случае с установкой, + дописыванию, ты потеря целых 0.015691

Тестировал с включённой оптимизацией. Без неё
String Set Index: 0,288884
RawByteString Set Index: 0,294933
----------
String Set global: 0,570846
RawByteString Set global: 0,606367


Вообще !!! RawByteString проигрывает
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39588714
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Няшик, попрошу поосторожней быть в своих выражениях и прочитать еще раз на всякий случай "Правила" данного форума!!!

(Цитата из правил: Форум предназначен для обсуждения вопросов, связанных с СУБД и родственными темами. Возможно обсуждение других вопросов согласно наименованию разделов форума.)

Я по сути - спрашивал совета знающих и более опытных людей, и получал на них ответы - кому было не лень читать и отвечать - помогали мне в решении вопросов!
Никого насильно в Тему я не затаскивал и уж тем более - на коленях с мольбой не стоял!

Кстати - еще раз отдельное спасибо SOFT FOR YOU за его терпимость к моему упрощению вызова Диалогового окна:
Код: pascal
1.
2.
   if OpenDialog1.Execute then
        FullName := OpenDialog1.FileName;

- Человек и так понял суть, и не стал читать морали и уводить в сторону обсуждение!

Что касается АСМа, то до таких внутренностей Дэлфи я еще не спустился (или не поднялся), хотя в свое время изучал и EC ЭВМ с его Асмом, а позже - Асм СPU 580, Z80, 1801-1803...

Няшик, спасибо и Вам за подсказки и участие в обсуждении!
Будут вопросы - конечно же обращусь сюда еще и возможно не раз! Да, пинали, но не до смерти же?!..))
Или Вы против?..)))
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39588729
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Жаль правда, код от SOFT FOR YOU не дал ожидаемого результата, ни с функцией, ни без нее!
Вкурю покамесь и пошагово побегаю по нему - может и заработает правильно!..)
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39588731
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Няшик,

Не понял, что ты тестировал
Но RawByteString может проигрывать на операции присвоения символа, т.к. при каждом присвоении вызывается UniqueString

Bellic,

Ну так я тебе тысячу раз говорил, мол выкладывай свой тест. В итоге оказалось, у тебя вообще ничего нет. Мы не сможем показать тебе Ахо-Корасика и быстрый Replace - если ты сам не открываешь код.

А что до диалога... ну я согласен, ты просто не знаешь как принято работать с диалогом и ребята тебе на это указали. Я показал try/finally - это тоже стандартный способ создания/удаления объектов. А так дерзай. Здорово, что человек не связанный профессией с программированием, делает такие успехи.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39588738
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
SOFT FOR YOU А что до диалога... ну я согласен, ты просто не знаешь как принято работать с диалогом и ребята тебе на это указали. Я показал try/finally - это тоже стандартный способ создания/удаления объектов.
Не поверишь - знаю прекрасно и как Диалогами пользоваться и try/finally - просто для теста упростил код, на скорую руку, чтоб он работал, и не думая что найдутся "умники", желающие щелкнуть на Крестик, открыть файл нулевой длины или вообще отказаться от загрузки файла в открытом диалоге!!! Код для Вас был - в надежде, что сокращение поймете молча!
Ну что тут было не понятно??? Сколько можно уже мусолить???

P.S. В своих реальных программах стараюсь ничем не пренебрегать, не упрощать и предусматривать все возможные варианты (возможно даже уж черезчур строго), особенно что касается выбора файлов или же некорректные действия пользователя (например выбор файла - только через диалоговое окно с последующей кучей проверок, ТEdit-ы индикации выбранных файлов при этом делаю ReadOnly и т.д.)
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39588745
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
SOFT FOR YOU Ну так я тебе тысячу раз говорил, мол выкладывай свой тест. В итоге оказалось, у тебя вообще ничего нет. Мы не сможем показать тебе Ахо-Корасика и быстрый Replace - если ты сам не открываешь код.
Чего это у меня нет?
Выкладывать сюда код реального набора утилит?..))
Извините - такого в мои планы не входило! (Три юнита и более 3000 строк включая комменты!)
Это породило бы еще больше вопросов и мнений - как бы кто реализовал то или иное место!
А еще пришлось бы рассказывать ТехЗадание и форматы файлов - еще неделя пустых разговоров и придирок...
Оно Вам надо???

P.S. а Ахо-Красика, будет время, я после и сам думаю сумею освоить!
Что касается Replace, то он мне не подходит, потому что:
1. Необходим подсчет произведенных замен
2. Кроме автоматического режима будет еще и полу-автомат с подтверждением
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39588771
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
BellicНяшик, попрошу поосторожней быть в своих выражениях и прочитать еще раз на всякий случай "Правила" данного форума!!!

А что я написал не так ??? Скорее, ты прочитал что - то не так..

Bellicк моему упрощению вызова Диалогового окна:

Да ты мог бы написать так
Код: pascal
1.
2.
  OpenDialog1.Execute;
FullName := OpenDialog1.FileName;



Было бы тоже самое.

SOFT FOR YOUНяшик,
Не понял, что ты тестировал
Но RawByteString может проигрывать на операции присвоения символа, т.к. при каждом присвоении вызывается UniqueString


Производительность типов. Но, при установки в индексы - слишком маленький выигрыш, у меня на компьютера составляет от 0.00600 до 0.00100
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39588772
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Bellic,

Тебя просили выложить маленький - реальный пример, подобного - имитирующего то, что тебе надо было реализовать. Чтоб, не гадать алгоритмы какие - то, исходя из твоих надуманных годов, и мол - так может быть, но я и сам не знаю. По этому, подскажите мне, гадая на своих шарах
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39588773
YuRock
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
НяшикЧтоб, не гадать алгоритмы какие - то, исходя из твоих надуманных годов, и мол - так может быть, но я и сам не знаю. По этому, подскажите мне, гадая на своих шарахЭто уже не первая его тема такая)
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39588837
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Няшик, лично для Вас - дополнил инфу в своем профиле!..)))
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39588861
Фотография Док
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Bellicдополнил инфу в своем профиле!..)))
да ты - романтик ;)
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39589061
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Докда ты - романтик ;) Спасибо за комплемент, Док !..))

Разобрался где ошибка в коде SOFT FOR YOU :
Код: pascal
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.
procedure TForm1.Test(Sender: TObject);
var
  FFile: TFileStream;
  FullName: string;
  i, m, Dlina, Addr: Integer;
  RawString: RawByteString;
  PSimvol: Byte;
  BFile: TBytes;
begin
   if OpenDialog1.Execute then
        FullName := OpenDialog1.FileName;

  FFile:=TFileStream.Create(FullName, fmOpenRead);
  try
    SetLength(BFile, FFile.Size);
    FFile.ReadBuffer(BFile, FFile.Size);
  finally
    FFile.Free;
  end;

  Addr := 0;
  Dlina := 6;
  for i := 1 to 2 do
  begin
    Memo1.Lines.Add('Prohod-'+IntToStr(i));

    //SetLength(BPoisk, Dlina);  // Инициируем длину массива
    SetLength(RawString, Dlina); {можно писать в массив байт, но мы будем писать в строку}
    for m := 0 to Dlina - 1 do    // Заполняем массив
    begin
      // быстрое чтение хекса

      // БЫЛО ТАК (строку заремить!):
      PSimvol := HexToByte(BFile[Addr + m * 2]) + HexToByte(BFile[Addr + m * 2 + 1]) shl 4

      // ПРАВИЛЬНО ТАК:
      PSimvol := HexToByte(BFile[Addr + m * 2]) shl 4 + HexToByte(BFile[Addr + m * 2 + 1]);

      // BPoisk[m] := PSimvol;
      RawString[m + 1] := AnsiChar(PSimvol);
    end;

    Memo1.Lines.Add('Ok');
  end;
end;

В результате у автора была сдвинута влево младшая тетрада вместо старшей, а это значит к примеру вместо
PSimvol= $31 получалось $13 , ну и в RawString - полная каша!
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39589081
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Bellic,

Разве в твоём файле нет бинарных данных ? Юникод там
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39589091
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
НяшикРазве в твоём файле нет бинарных данных ? Юникод там
Доброе утро! Только проснулся?...))))
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39589108
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Bellic,

Дай - ка вспомнить, хм... Я пошёл спать в 8 и проснулся в 13:30... Хм.. Сейчас 16:03 и делаем сложный расчёт 16-13 : 30 - 03 получается 3:10 уже кааак

А сиго?
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39589127
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Няшик, хочешь разминку для мозгов?..))
Мой вариант кода в цикле на 1000 итераций выполнился за 0,85 а быстродействующий SOFT FOR YOU - за 0,92 секунды!..))
Исходники выложить или сам хрустальными шарами сообразишь?..))
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39589139
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Bellic,

Вот блин, к чему это??? Конечно же его код, может работать медленнее - при неправильном использование...

Кстати, я нАрочно кое где сделал ошибку, а ты и не заметил?

... Меня до сих пор волнует, каким образом - ты его структуру, в свой код применил.

И кстати - да, ты правильно заметил что у него в алгоритме ошибка. В SysUtils есть такая функция
Код: pascal
1.
2.
3.
4.
  function HexByte(p: PChar): Byte;
  begin
    Result := Byte((HexChar(p[0]) shl 4) + HexChar(p[1]));
  end;



Которая выполняет ту же логику.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39589174
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Няшик, ты не только ошибку сделал, ты кое что и проигнорировал в другой теме - ну да ладно, проехали!
Няшик... Меня до сих пор волнует, каким образом - ты его структуру, в свой код применил.
О какой структуре речь то???
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39589180
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
НяшикКстати, я нАрочно кое где сделал ошибку, а ты и не заметил?
Где, что, когда?
Вот ты негоДяй, а не Няшик!..))))
Видимо я пропустил мимо ушей или же в голове сработал авто-исправлятель и твоя "нАрочная" ошибка не вызвала фотальной ошибки моего вычислительного устройства под названием "Мозг"..))))
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39589190
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Bellic,

Вот видишь, как замечательно. На таких примерах лучше познаёшь хекс :)
Но насчёт скорости не согласен. Не может мой пример работать медленее твоего.
Ты скорее всего в моём коде поменял RawByteString на TBytes и получил профит.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39589192
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
BellicО какой структуре речь то???

У тебя есть база данных, в каком формате (Алгоритме шифровки) - ты постеснялся написать.


Тебе дали код, который пакует несколько байт в один. И ты такой довольный заявляешь : Это - то, что надо!

Вопрос, ты переписал базу данных под (hex(c) << 4) + hex(b) Пакуя её компактнее ???

Или же, ты прост воткнул его код, и думаешь что он работает? Ведь, если бы ты свою базу данных не перелопатил, то сравнение бы не произошло



BellicГде, что, когда?

Когда ты спрашивал давно ли я проснулся. А ты ?) xD
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39589210
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
SOFT FOR YOUНо насчёт скорости не согласен. Не может мой пример работать медленее твоего.
Ты скорее всего в моём коде поменял RawByteString на TBytes и получил профит.
Лови исходники и тестируй сам!
Твой код, SOFT FOR YOU:
Код: pascal
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.
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, DateUtils;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    OpenDialog1: TOpenDialog;
  procedure Test(Sender: TObject);
  procedure BeginTime(Sender: TObject);
  procedure EndTime(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function HexToByte(const Value: Byte): Byte; inline;
begin
  Result := (Value or $20) - Byte('0');
  if (Result > 9) then
    Dec(Result, Ord('a') - Ord('0') - 10);
end;

procedure TForm1.Test(Sender: TObject);
var
FFile: TFileStream;
FullName: string;
i, m, Dlina, Addr: Integer;
BPoisk: array of Byte;   // Динамический массив
RawBin, RawString: RawByteString;
SPSimvol: ansistring;
PSimvol: Byte;
BFile: TBytes;
//---- Переменные для подсчета времени выполнения программы ----------
StartTime: TDateTime; // Время перед подсчетом
EndTime: TDateTime;   // Время после подсчета
DelayTime: Double;    // Разность времени (Время выполнения программы)
//--------------------------------------------------------------------
label Err;
begin
     if OpenDialog1.Execute then
               FullName := OpenDialog1.FileName;

     FFile:=TFileStream.Create(FullName, fmOpenRead);
     try  //====== Читаем Файл в TByte ======
          SetLength(BFile, FFile.Size);
          FFile.ReadBuffer(BFile, FFile.Size);

          //====== Читаем Файл в RawByteString ======
          SetLength(RawBin,FFile.Size);
          FFile.Position := 0;
          //FBin.ReadBuffer(PAnsiChar(RawBin)^,FFile.Size);
          FFile.ReadBuffer(&RawBin[1],FFile.Size);
     finally
          FFile.Free;
     end;

     StartTime := Now;        // Фиксируем время Старта
     SetLength(SPSimvol, 2);
     Addr := 0;
     Dlina := 6;
     for i := 1 to 1000 do
          begin
               Memo1.Lines.Add('Prohod-'+IntToStr(i));
               //SetLength(BPoisk, Dlina);  // Инициируем длину массива
               //PInteger(PByte(RawString) - 8)^ := 0;
               SetLength(RawString, Dlina); // можно писать в массив байт, но мы будем писать в строку
               for m  := 0 to Dlina-1 do    // Заполняем массив
                    begin
                         //SPSimvol[1] := AnsiChar(BFile[Addr + m*2]);
                         //[2] := AnsiChar(BFile[Addr + m*2 + 1]);

                         // быстрое чтение хекса
                         PSimvol := HexToByte(BFile[Addr + m * 2]) shl 4 + HexToByte(BFile[Addr + m * 2 + 1]);

                         //PSimvol := StrToInt('$' + SPSimvol);
                         //BPoisk[m] := PSimvol;
                         RawString[m+1] := AnsiChar(PSimvol);
                    end;
Err:           //RawString := RawByteString(BPoisk);
               //PInteger(PByte(RawString) - 8)^ := 0;
               Memo1.Lines.Add('Ok');
          end;
     EndTime := Now;  // Фиксируем время СТОПА
     // Вычисляем время выполнения ПРОЦЕДУРЫ
     DelayTime := SecondSpan(EndTime, StartTime);
     Memo1.Lines.Add('Время выполнения=' + FloatToStr(DelayTime) + ' сек.');
end;
end.



Вот мой код
Мой код:
Код: pascal
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.
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, DateUtils;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    OpenDialog1: TOpenDialog;
  procedure Test(Sender: TObject);
  procedure BeginTime(Sender: TObject);
  procedure EndTime(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function HexToByte(const Value: Byte): Byte; inline;
begin
  Result := (Value or $20) - Byte('0');
  if (Result > 9) then
    Dec(Result, Ord('a') - Ord('0') - 10);
end;

procedure TForm1.Test(Sender: TObject);
var
FFile: TFileStream;
FullName: string;
i, m, Dlina, Addr: Integer;
BPoisk: array of Byte;   // Динамический массив
RawBin, RawString: RawByteString;
SPSimvol: ansistring;
PSimvol: Byte;
BFile: TBytes;
//---- Переменные для подсчета времени выполнения программы ----------
StartTime: TDateTime; // Время перед подсчетом
EndTime: TDateTime;   // Время после подсчета
DelayTime: Double;    // Разность времени (Время выполнения программы)
//--------------------------------------------------------------------
label Err;
begin
     if OpenDialog1.Execute then
               FullName := OpenDialog1.FileName;

     FFile:=TFileStream.Create(FullName, fmOpenRead);
     try  //====== Читаем Файл в TByte ======
          SetLength(BFile, FFile.Size);
          FFile.ReadBuffer(BFile, FFile.Size);

          //====== Читаем Файл в RawByteString ======
          SetLength(RawBin,FFile.Size);
          FFile.Position := 0;
          //FBin.ReadBuffer(PAnsiChar(RawBin)^,FFile.Size);
          FFile.ReadBuffer(&RawBin[1],FFile.Size);
     finally
          FFile.Free;
     end;

     StartTime := Now;        // Фиксируем время Старта
     SetLength(SPSimvol, 2);
     Addr := 0;
     Dlina := 6;
     for i := 1 to 1000 do
          begin
               Memo1.Lines.Add('Prohod-'+IntToStr(i));
               SetLength(BPoisk, Dlina);  // Инициируем длину массива
               //PInteger(PByte(RawString) - 8)^ := 0;
               //SetLength(RawString, Dlina); // можно писать в массив байт, но мы будем писать в строку
               for m  := 0 to Dlina-1 do    // Заполняем массив
                    begin
                         SPSimvol[1] := AnsiChar(BFile[Addr + m*2]);
                         SPSimvol[2] := AnsiChar(BFile[Addr + m*2 + 1]);

                         // быстрое чтение хекса
                         //PSimvol := HexToByte(BFile[Addr + m * 2])shl 4 + HexToByte(BFile[Addr + m * 2 + 1]);

                         PSimvol := StrToInt('$' + SPSimvol);
                         BPoisk[m] := PSimvol;
                         //RawString[m+1] := AnsiChar(PSimvol);
                    end;
Err:           RawString := RawByteString(BPoisk);
               PInteger(PByte(RawString) - 8)^ := 0;
               Memo1.Lines.Add('Ok');
          end;
     EndTime := Now;  // Фиксируем время СТОПА
     // Вычисляем время выполнения ПРОЦЕДУРЫ
     DelayTime := SecondSpan(EndTime, StartTime);
     Memo1.Lines.Add('Время выполнения=' + FloatToStr(DelayTime) + ' сек.');
end;
end.


Запускай и сравнивай сам...
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39589227
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Bellic,

Выложи отдельный проект с исходным файлом и двумя кнопками
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39589229
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Няшик, ничего не понимаю в твоих вопросах:
НяшикУ тебя есть база данных, в каком формате (Алгоритме шифровки) - ты постеснялся написать.
Тебе дали код, который пакует несколько байт в один. И ты такой довольный заявляешь : Это - то, что надо!
Вопрос, ты переписал базу данных под (hex(c) << 4) + hex(b) Пакуя её компактнее ???
Или же, ты прост воткнул его код, и думаешь что он работает? Ведь, если бы ты свою базу данных не перелопатил, то сравнение бы не произошло
База данных - это наборы пар Поиск-Замена. Так понятно?
Ничего я не перелопачивал! База осталась в нетронутом состоянии!
Просто был выложен код в надежде, что есть иной способ его исполнения. Вот SOFT FOR YOU и предложил читать сразу в RawString вместо Массива. Его вариант с учетом моей поправки - работает, как и правильно работает мой предыдущий!
Все!
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39589230
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Я ему уже сто раз напрямую сказал - выложить исходный файл. А он всё кодами размахивается, как будто в них счастье и ключ ко всему
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39589237
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
SOFT FOR YOUBellic,
Выложи отдельный проект с исходным файлом и двумя кнопками
Извини, друг!!!
А не ах..л ли ты? я только что выложил два кода!
...
И вообще - так не честно - ты выкладываешь свой код, даже не удосужившись проверить его правильность, а я тебе должен из Двух уже опубликованных только что - собирать с двумя кнопками????
Копипасть...
Мне пора собираться выезжать...
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39589241
Tactical Nuclear Penguin
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
BellicЗапускай и сравнивай сам...

ты в основном сравниваешь вывод строк в мемо
выкинь мемо
сделай цикл хотя бы пару миллионов и сравнивай
и увидишь твой код хуже...
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39589243
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
НяшикЯ ему уже сто раз напрямую сказал - выложить исходный файл. А он всё кодами размахивается, как будто в них счастье и ключ ко всемуНяшик, ты что - слепой??? 21131122
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39589249
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Tactical Nuclear PenguinBellicЗапускай и сравнивай сам...
ты в основном сравниваешь вывод строк в мемо
выкинь мемо
сделай цикл хотя бы пару миллионов и сравнивай
и увидишь твой код хуже...
Мы говорим о сравнении, а не вообще о времени выполнения!
Мемо в обоих случаях теоретически выполняется за одно и то же время и присутствует в обоих кодах!
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39589254
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
=_= Ребята ??? Ему сказать, что в данных примерах он сравнивает скорость вывода в memo ? Ой.. Похоже уже сказал - как не ловко...
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39589255
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
...приеду вечером, удалю Мемо и запущу на паре миллионов!
А вообще - мне это в общем то не важно, не меряемся мы силой алго, а просто хотяб примерно сравнили два варианта!
В итоге - они практически равнозначные оказались...
Но Пяток миллионов я всеж заФигачу вечерком!...)))))))))))))))
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39589257
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
BellicМы говорим о сравнении, а не вообще о времени выполнения!
Мемо в обоих случаях теоретически выполняется за одно и то же время и присутствует в обоих кодах!

Неверно! Никогда такого не будет. Запусти свой код, без вывода всех memo и увидишь "Время выполнения=0 сек."

Я даже не запуская могу сказать это
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39589260
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Няшик=_= Ребята ??? Ему сказать, что в данных примерах он сравнивает скорость вывода в memo ? Ой.. Похоже уже сказал - как не ловко...Няшик, и Две кнопки для SOFT FOR YOU - тоже сделаю, по просьбе трудящихся (если до этого сами их не "нарисуете")...)))
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39589265
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Няшик,
авторНеверно! Никогда такого не будет. Запусти свой код, без вывода всех memo и увидишь "Время выполнения=0 сек."я такое уже видел сегодня!
Мой код в цикле на 2 итерации выдал 0 секунд, а SOFT FOR YOU - ноль с копеками!
Пришлось увеличить число итераций до 1000!
Все парни, опаздываю.. пардон!
До вечера!
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39589290
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Я сделал адекватный тестер

Без включённой оптимизации
Nyashik: 1,514717
SOFTFORYOU: 1,541704
Bellic: 10,928764

С включённой оптимизацией


Nyashik: 0,743173
SOFTFORYOU: 0,766512
Bellic: 10,819108




Код: pascal
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.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, DateUtils;

const
  TestCount = 10000000;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    OpenDialog1: TOpenDialog;
    procedure Test(Sender: TObject);
    procedure ReadFile;
    procedure StartCodeNyashik;
    procedure StartCodeSOFTFORYOU;
    procedure StartCodeBellic;
    procedure BeginTime;
    function EndTime: string;
  private
    { Private declarations }
  public
    StartTime, StopTime: Int64;
    iCounterPerSec: Int64;

    FFile: TFileStream;
    BFile: TBytes;
    Dlina, Addr: Integer;
  end;

var
  Form1: TForm1;
  I, m: Integer;

implementation

{$R *.dfm}

procedure TForm1.BeginTime;
begin
  QueryPerformanceCounter(StartTime);
end;

function TForm1.EndTime: string;
begin
  if QueryPerformanceCounter(StopTime) and QueryPerformanceFrequency
    (iCounterPerSec) then
    Result := Format('%.6f', [(StopTime - StartTime) / iCounterPerSec]);
end;

function HexToByte(const Value: Byte): Byte;
begin
  Result := (Value or $20) - Byte('0');
  if (Result > 9) then
    Dec(Result, Ord('a') - Ord('0') - 10);
end;

procedure TForm1.ReadFile;
begin
  if not OpenDialog1.Execute then
    exit;

  FFile := TFileStream.Create(OpenDialog1.FileName, fmOpenRead);
  try
    SetLength(BFile, FFile.Size);
    FFile.ReadBuffer(BFile, FFile.Size);
  finally
    FFile.Free;
  end;

  Addr := 0;
  Dlina := 6;

end;

procedure TForm1.StartCodeNyashik;
var
  RawString: RawByteString;
  PSimvol: Byte;
  x: Byte;
begin
  for I := 1 to TestCount do
  begin
    SetLength(RawString, Dlina);
    for m := 0 to Dlina - 1 do
    begin
      x := Addr + m * 2;
      PSimvol := (HexToByte(BFile[x]) shl 4) + HexToByte(BFile[x + 1]);

      RawString[m + 1] := AnsiChar(PSimvol);
    end;
  end;
end;

procedure TForm1.StartCodeSOFTFORYOU;
var
  RawString: RawByteString;
  PSimvol: Byte;
begin
  for I := 1 to TestCount do
  begin
    SetLength(RawString, Dlina);
    for m := 0 to Dlina - 1 do
    begin
      PSimvol := HexToByte(BFile[Addr + m * 2]) shl 4 +
        HexToByte(BFile[Addr + m * 2 + 1]);

      RawString[m + 1] := AnsiChar(PSimvol);
    end;
  end;
end;

procedure TForm1.StartCodeBellic;
var
  RawString: RawByteString;
  BPoisk: array of Byte; // Динамический массив
  PSimvol: Byte;
  SPSimvol: ansistring;
begin
  SetLength(SPSimvol, 2);
  for I := 1 to TestCount do
  begin
    SetLength(BPoisk, Dlina);
    for m := 0 to Dlina - 1 do
    begin
      SPSimvol[1] := AnsiChar(BFile[Addr + m * 2]);
      SPSimvol[2] := AnsiChar(BFile[Addr + m * 2 + 1]);
      PSimvol := StrToInt('$' + SPSimvol);

      BPoisk[m] := PSimvol;
    end;
    RawString := RawByteString(BPoisk);
    PInteger(PByte(RawString) - 8)^ := 0;
  end;
end;

procedure TForm1.Test(Sender: TObject);
begin
  ReadFile;

  BeginTime;
  StartCodeNyashik;
  Memo1.Lines.Add('Nyashik: ' + EndTime);

  BeginTime;
  StartCodeSOFTFORYOU;
  Memo1.Lines.Add('SOFTFORYOU: ' + EndTime);

  BeginTime;
  StartCodeBellic;
  Memo1.Lines.Add('Bellic: ' + EndTime);
end;

end.

...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39589293
чччД
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Няшик.

А не замахнуться ли тебе на собственную версию Кэшед Буфферз?
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39589305
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
чччДНяшик.

А не замахнуться ли тебе на собственную версию Кэшед Буфферз?

Я для себя уже сделал такое. Работает так - выделяю 16 байт, заканчивается - выделяю ещё раз. И работаю с этими данными с помощью SSE инструкций

Кстати, Delphi сам умеет хорошо выделять память (с помощью SysGetMem) по 16 границе, при включённой опции mba16Byte

Слепил за пару часиков, и рад, что без мучений
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39589379
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Няшик, для начала - перемести обьявления переменных во всех трех процедурах - вверх, в начало юнита!
И кода будет поменьше и думаю подготовка к циклу - это не существенно!
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39589404
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Bellic,

В моём примере всё сделано идеально. Мы тестируем только алгоритм. А не засранный не понять чем код.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39589470
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
НяшикВ моём примере всё сделано идеально. Мы тестируем только алгоритм. А не засранный не понять чем код.
Няшик, ты читать умеешь?
Прочти еще раз сообщение 21131776
На алгоритм никто не покушается... пока.. и про код там ни слова!
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39589480
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Няшик,

Спасибо за тест
А то я и сам грешным делом подумал, что там могло сработать медленно

Кстати
Раз уж у тебя тест под рукой - можешь сделать вывод в TBytes, а не RawByteString. Он по идее ещё раза в полтора должен быстрее работать )
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39589482
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Bellic,

Тут очень странный человек
Тебя учат работать с хексом, показывают, как ускорить твой код. А ты говоришь, что я о...ел.

Ну если не хочешь - я не стану помогать с твоим кодом
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39589485
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
И вот это по идее должно ускорить

Код: pascal
1.
2.
3.
4.
5.
6.
function HexToByte(const Value: Cardinal): Cardinal; inline;
begin
  Result := (Value or $20) - Cardinal('0');
  if (Result > 9) then
    Dec(Result, Ord('a') - Ord('0') - 10);
end;
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39589507
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Без инлайна
Nyashik: 0,719825
SOFTFORYOU: 0,724851
Bellic: 11,049624


С инлайном
Nyashik: 0,842163
SOFTFORYOU: 0,896055
Bellic: 11,008099
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39589515
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
StartCode: 0,655306
StartCodeTBytes: 0,434061



Код: pascal
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.
122.
123.
124.
125.
126.
127.
128.
129.
130.
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, DateUtils;

const
  TestCount = 10000000;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    OpenDialog1: TOpenDialog;
    procedure Test(Sender: TObject);
    procedure ReadFile;
    procedure StartCode;
    procedure StartCodeTBytes;
    procedure BeginTime;
    function EndTime: string;
  private
    { Private declarations }
  public
    StartTime, StopTime: Int64;
    iCounterPerSec: Int64;

    FFile: TFileStream;
    BFile: TBytes;
    Dlina, Addr: Integer;
  end;

var
  Form1: TForm1;
  I, m: Integer;

implementation

{$R *.dfm}

procedure TForm1.BeginTime;
begin
  QueryPerformanceCounter(StartTime);
end;

function TForm1.EndTime: string;
begin
  if QueryPerformanceCounter(StopTime) and QueryPerformanceFrequency
    (iCounterPerSec) then
    Result := Format('%.6f', [(StopTime - StartTime) / iCounterPerSec]);
end;

function HexToByte(const Value: Byte): Byte;
begin
  Result := (Value or $20) - Byte('0');
  if (Result > 9) then
    Dec(Result, Ord('a') - Ord('0') - 10);
end;

procedure TForm1.ReadFile;
begin
  if not OpenDialog1.Execute then
    exit;

  FFile := TFileStream.Create(OpenDialog1.FileName, fmOpenRead);
  try
    SetLength(BFile, FFile.Size);
    FFile.ReadBuffer(BFile, FFile.Size);
  finally
    FFile.Free;
  end;

  Addr := 0;
  Dlina := 6;

end;

procedure TForm1.StartCode;
var
  RawString: RawByteString;
  PSimvol: Byte;
  x: Byte;
begin
  SetLength(RawString, Dlina);
  for I := 1 to TestCount do
  begin
    for m := 0 to Dlina - 1 do
    begin
      x := Addr + m * 2;
      PSimvol := (HexToByte(BFile[x]) shl 4) + HexToByte(BFile[x + 1]);

      RawString[m + 1] := AnsiChar(PSimvol);
    end;
  end;
end;

procedure TForm1.StartCodeTBytes;
var
  ArrBytes: TBytes;
  PSimvol: Byte;
  x: Byte;
begin
  SetLength(ArrBytes, Dlina);
  for I := 1 to TestCount do
  begin
    for m := 0 to Dlina - 1 do
    begin
      x := Addr + m * 2;
      ArrBytes[m + 1] := (HexToByte(BFile[x]) shl 4) + HexToByte(BFile[x + 1]);
    end;
  end;
end;

procedure TForm1.Test(Sender: TObject);
begin
  ReadFile;

  BeginTime;
  StartCode;
  Memo1.Lines.Add('StartCode: ' + EndTime);

  BeginTime;
  StartCodeTBytes;
  Memo1.Lines.Add('StartCodeTBytes: ' + EndTime);

end;

end.

...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39589517
Bellic
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
SOFT FOR YOUТут очень странный человек
Тебя учат работать с хексом, показывают, как ускорить твой код. А ты говоришь, что я о...ел.
Ну если не хочешь - я не стану помогать с твоим кодом
Извини, но у тебя очень странные манеры обучения!
Причину моего возмущения - я тебе объяснил! Только не говори, что не понял ее!
Если обидел своей несдержиннастью - не серчай, я и правда очень спешил тогда..((

SOFT FOR YOUРаз уж у тебя тест под рукой - можешь сделать вывод в TBytes, а не RawByteString. Он по идее ещё раза в полтора должен быстрее работать
Если это касается моей темы "Поиска и замены.." - в этом цикле мы готовили один из параметров для процедуры Поиска и Замены, который Вы, SOFT FOR YOU, предложили сделать на RawByteString и Pos()...
Тогда по идее нужно будет переделывать и ее на TBytes?
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39589522
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Няшик,

Ну как я и говорил )
Полтора раза ))
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39589523
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Bellic,

Ты же сам всё прекрасно знаешь
Что я тебе буду объяснять
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39589614
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
SOFT FOR YOU,

Отдыхая, проветривая мозг... Я начал обдумывать твою оптимизацию функции...
Полез в asm и увидел, что можно сократить его на 1 лишнюю инструкцию
Код: pascal
1.
0FB600           movzx eax,[eax]



Но увы и ах... Мне не удалось сделать это из кода

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
function HexToByte(const Value: Byte): Byte;
asm
  or al,$20
  sub al,$30
  cmp al,$09
  jbe @exit
  sub al,$27
@exit:
end;



Результат выполнения

StartCode: 0,639610
StartCodeTBytes: 0,414529
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39589618
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Няшик,

Попробуй так (не проверял)

function HexToByte(const Value: Cardinal): Cardinal;
asm
or eax, $20
lea ecx, [eax - $57]
cmp eax, $39
lea eax, [eax - $30]
cmova eax, ecx
end;
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39589621
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
SOFT FOR YOU,

Стало гораздо лучше

StartCode: 0,566828
StartCodeTBytes: 0,411922
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39590183
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Если я правильно понял, о чем идет речь, то можно попробовать по 2 байта за раз
Код: pascal
1.
2.
3.
4.
function HexToByte(Value: Cardinal): Cardinal;
begin
  Result:=(Value and $4040 * $02402400 + Value and $0F0F * $10010000) shr 24;
end;
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39590201
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Aleksandr Sharahov,

Мне кажется лучше так (но я не тестировал)

Код: pascal
1.
2.
3.
4.
function HexToByte(Value: Integer{Word}): Integer;
begin
  Result := (Value - $3030) + ((Value and $4040) shr 4) * -$27;
end;
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39590203
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
shr 6 наверно )
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39590207
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
SOFT FOR YOU,

моя переставляет для little endian, если переставлять не надо, то наверно можно проще
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39590219
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Aleksandr Sharahov,

Да, ты прав. У тебя же ещё микс байт делается. Только Cardinal лучше на Integer заменить - там нет ограничения на регистры.

Кстати изложи логику расстановки констант. Ребятам, да и мне тоже, будет познавательно.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39590294
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Логика прозрачная.
Финальный сдвиг на 24, чтобы не надо было в конце and-ить с $FF.
$0F0F - очевидное выделение младших ниблов для цифр и букв.
В константе $10010000 старшая единица ставит на место биты 0..3, младшая - биты 8..11, т.е. переставили.
Замечаем, что при этом буковки дают результат на 9 меньше положенного.
Недостающую 9 формируем аналогично из битов $4040, которые не присутствуют в цифрах.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39590303
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Не одна из функций, не работает правильно...

У Aleksandr Sharahov функция не работает как надо.


SOFT FOR YOU Asm: 0,414427
SOFT FOR YOU Code: 0,455227
MyAsm: 0,398304


Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
function TestHexToByte(Value: Byte): Byte;
asm
  mov ecx, eax
  shr ecx, 6
  and ecx, 257
  imul ecx, ecx, -39
  lea eax, [eax + ecx - 12336]
end;



Я вздёрнул всех
Код: pascal
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.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
160.
161.
162.
163.
164.
165.
166.
167.
168.
169.
170.
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, DateUtils;

const
  TestCount = 10000000;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    OpenDialog1: TOpenDialog;
    procedure Test(Sender: TObject);
    procedure ReadFile;
    procedure StartCodeTestHexToByte;
    procedure StartCode;
    procedure StartCodeAsm;
    procedure BeginTime;
    function EndTime: string;
  private
    { Private declarations }
  public
    StartTime, StopTime: Int64;
    iCounterPerSec: Int64;

    FFile: TFileStream;
    BFile: TBytes;
    Dlina, Addr: Integer;
  end;

var
  Form1: TForm1;
  I, m: Integer;

implementation

{$R *.dfm}

procedure TForm1.BeginTime;
begin
  QueryPerformanceCounter(StartTime);
end;

function TForm1.EndTime: string;
begin
  if QueryPerformanceCounter(StopTime) and QueryPerformanceFrequency
    (iCounterPerSec) then
    Result := Format('%.6f', [(StopTime - StartTime) / iCounterPerSec]);
end;

function HexToByteAsmSOFTFORYOU(const Value: Cardinal): Cardinal;
asm
  or eax, $20
  lea ecx, [eax - $57]
  cmp eax, $39
  lea eax, [eax - $30]
  cmova eax, ecx
end;

function HexToByteSOFTFORYOU(Value: Integer { Word } ): Integer;
begin
  Result := (Value - $3030) + ((Value and $4040) shr 6) * -$27;
end;

function TestHexToByte(Value: Byte): Byte;
asm
  mov ecx, eax
  shr ecx, 6
  and ecx, 257
  imul ecx, ecx, -39
  lea eax, [eax + ecx - 12336]
end;

procedure TForm1.ReadFile;
begin
  if not OpenDialog1.Execute then
    exit;

  FFile := TFileStream.Create(OpenDialog1.FileName, fmOpenRead);
  try
    SetLength(BFile, FFile.Size);
    FFile.ReadBuffer(BFile, FFile.Size);
  finally
    FFile.Free;
  end;

  Addr := 0;
  Dlina := 6;

end;

procedure TForm1.StartCodeAsm;
var
  ArrBytes: TBytes;
  PSimvol: Byte;
  x: Byte;
begin
  SetLength(ArrBytes, Dlina);
  for I := 1 to TestCount do
  begin
    for m := 0 to Dlina - 1 do
    begin
      x := Addr + m * 2;
      ArrBytes[m + 1] := (HexToByteAsmSOFTFORYOU(BFile[x]) shl 4) +
        HexToByteAsmSOFTFORYOU(BFile[x + 1]);
    end;
  end;
end;

procedure TForm1.StartCode;
var
  ArrBytes: TBytes;
  PSimvol: Byte;
  x: Byte;
begin
  SetLength(ArrBytes, Dlina);
  for I := 1 to TestCount do
  begin
    for m := 0 to Dlina - 1 do
    begin
      x := Addr + m * 2;
      ArrBytes[m + 1] := (HexToByteSOFTFORYOU(BFile[x]) shl 4) +
        HexToByteSOFTFORYOU(BFile[x + 1]);
    end;
  end;
end;

procedure TForm1.StartCodeTestHexToByte;
var
  ArrBytes: TBytes;
  PSimvol: Byte;
  x: Byte;
begin
  SetLength(ArrBytes, Dlina);
  for I := 1 to TestCount do
  begin
    for m := 0 to Dlina - 1 do
    begin
      x := Addr + m * 2;
      ArrBytes[m + 1] := (TestHexToByte(BFile[x]) shl 4) +
        TestHexToByte(BFile[x + 1]);
    end;
  end;
end;

procedure TForm1.Test(Sender: TObject);
begin

  ReadFile;

  BeginTime;
  StartCodeAsm;
  Memo1.Lines.add('SOFT FOR YOU Asm: ' + EndTime);

  BeginTime;
  StartCode;
  Memo1.Lines.add('SOFT FOR YOU Code: ' + EndTime);

  BeginTime;
  StartCodeTestHexToByte;
  Memo1.Lines.add('MyAsm: ' + EndTime);

end;

end.

...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39590304
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
НяшикНе одна из функций, не работает правильно...

Эта фраза не сюда относилась. Перепутал форумы. И пока делал тесты, не заметил что это сюда написал
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39590315
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
НяшикУ Aleksandr Sharahov функция не работает как надо.


Возможно, я не понимаю, как надо.
Поясни.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39590322
Няшик
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Aleksandr Sharahov,

Я просто глянул на результаты, и увидел что они отличаются от того, что было. А потом глянул, что генерируется у SOFT FOR YOU и переделал под ASM
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39590348
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Няшик,

Александр (и я неудачно попытался повторить) реализовал чтение не одного, а сразу двух байт. А в твоём тесте его функция вызывается дважды
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39590358
kep-ko
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
НяшикЯ вздёрнул всех смотри, а то пропишут на пмж в баллистическую ракету ( http://smartfiction.ru/prose/sens_of_power/ )

зы. Прeдлагаю затестить табличку в 64KB !
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39590362
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
kep-ko,

Давно пора :)
Но мы оптимизируем чтение хексового буфера ТС с массивом замен
А на самом деле надо оптимизировать поиск и замену :)
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39590399
kep-ko
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
SOFT FOR YOUна самом деле надо оптимизировать поиск и заменуопять-таки 'табличка' по первому байту(символу) искомых строк :)
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39590401
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
kep-ko,

Ога
Ахо-Корасик
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39590478
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Aleksandr SharahovВ константе $10010000 старшая единица ставит на место биты 0..3, младшая - биты 8..11, т.е. переставили.
Логически я это понимаю. Не могу самостоятельно в случае чего просчитать такую константу.

Вот есть число 00000X0Y
Необходимо получить YX~~~~~~
Соответственно Y нужно поместить на место 28 бита, X нужно поместить на 24 бит.

Соответственно для Y у меня выходит константа $0001 shl 28
А для X я подставляю $0100 shl (24 - 8). И это не правильно.

Расскажи, какой логикой руководствуешься, определяя константу. Туплю :)
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39590506
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
SOFT FOR YOUAleksandr SharahovВ константе $10010000 старшая единица ставит на место биты 0..3, младшая - биты 8..11, т.е. переставили.
Логически я это понимаю. Не могу самостоятельно в случае чего просчитать такую константу.

Вот есть число 00000X0Y
Необходимо получить YX~~~~~~
Соответственно Y нужно поместить на место 28 бита, X нужно поместить на 24 бит.

Соответственно для Y у меня выходит константа $0001 shl 28
А для X я подставляю $0100 shl (24 - 8). И это не правильно.

Расскажи, какой логикой руководствуешься, определяя константу. Туплю :)

Важно не на какое место поставить, а на сколько битов сдвинуть с прежнего места.
И если надо сдвинуть и на A и на B битов, то просто OR-им биты A и B и получаем константу.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39590521
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Aleksandr Sharahov,

Оки
А как просчитать, не затрут ли биты друг друга

Ну вот пример
Есть число 000А0БВГ
Каждая «буква» это 4 бита.
Допустим, я хочу взять от каждой буквы по 3 бита и занять верхние 12 бит. По изложенному принципу я сформирую константу. Как я могу однозначно определить, глядя на константу, что написанная мной операция работает для любых АБВГ?

И ещё момент. Насколько я понял, принцип предполагает расположение элементов в обратном порядке? Т.е. сохранить порядок элементов не удастся.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39590630
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
SOFT FOR YOUAleksandr Sharahov,

Оки
А как просчитать, не затрут ли биты друг друга

Ну вот пример
Есть число 000А0БВГ
Каждая «буква» это 4 бита.
Допустим, я хочу взять от каждой буквы по 3 бита и занять верхние 12 бит. По изложенному принципу я сформирую константу. Как я могу однозначно определить, глядя на константу, что написанная мной операция работает для любых АБВГ?

Тупо считаем, как описано. Берем худший случай - все 1. Проверяем наложение. Если оно есть, начинаем дополнительно изворачиваться при помощи масок, чтобы сделать по частям.


SOFT FOR YOUИ ещё момент. Насколько я понял, принцип предполагает расположение элементов в обратном порядке? Т.е. сохранить порядок элементов не удастся.
Если внимательно посмотришь на произведение, в нем всегда есть все возможные порядки. А порядок расположения и наличие битов в нужном месте определяется коэффициентом (т.е. заданными тобой сдвигами).
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39590632
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
SOFT FOR YOU,

Вот это может настроить мозг на нужную волну: http://guildalfa.ru/alsha/node/14
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39591761
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Aleksandr Sharahov,

Спасибо тебе за познавательную лекцию

Кстати я так и не разобрался, как расчитывать константу и сдвиг для целочисленного деления.
Причём там целая кипа особенностей:
* если Cardinal делится на Cardinal - там один код
* причём результат может не убраться в нижние 32 бита - тогда приходится делать умножение в Int64 - и смотреть старшие 32 бита
* если Integer делится на Cardinal - то там используется корректировка в зависимости от знака
* если Integer делится на отрицательное - я не знаю, можно ли обойтись без операции neg
* не всегда понятно, удастся ли обойтись imul или нужен mul

Сейчас я обхожусь полным перебором, нахожу подходящие константы. Например, если X в диапазоне 0..9999, то его деление на 100 у меня выглядит так: (X * $147B) shr 19

Но всё это не серьезно. Хочется иметь динамическое решение. Так что если напишешь толковую статью по сему поводу - цены тебе не будет :)
Кстати через FPU тоже вариант, но выполняется дольше, и вопросы по точности. Поэтому если есть возможность решать через целочисленные регистры - я стараюсь делать через них.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39591812
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
SOFT FOR YOU,

а это читал? http://guildalfa.ru/alsha/node/34
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39591829
Фотография makhaon
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
SOFT FOR YOU,

о много нам открытий чудных готовит просвещенья дух

Александру спасибо. Твои алгоритмы всегда были лучшими :)
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39591954
kep-ko
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
SOFT FOR YOUполным перебором, нахожу подходящие константы ...а это уже полный перебор!
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
procedure TForm1.Button1Click(Sender: TObject);
var
  i : Integer;
  n : Cardinal;
  x : TExtended80Rec;
  m : UInt64;
  e : Integer;
begin
  n := StrToIntDef(Edit1.Text, 100);
  x := TExtended80Rec(1/n);
  e := x.Exponent + 1;
  m := x.Mantissa shr 48;
  for i := 0 to 3 do
    Memo1.Lines.Add(Inttostr(n)+'^-1 = $'+IntToHex(m shr i,4)+' *2^'+IntToStr(e+i+48-64));
end;

...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39591961
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Aleksandr SharahovSOFT FOR YOU,

а это читал? http://guildalfa.ru/alsha/node/34

Видимо оно
Почитаю на досуге :)
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39591982
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Aleksandr Sharahov,

Статья конечно хорошая, но считаю её как минимум не полной. Вот к примеру Си-шный дизасм деления на 10:
Код: sql
1.
2.
3.
4.
5.
u32div10(unsigned int):
  mov edx, -858993459
  mul edx
  mov eax, edx
  shr eax, 3


Конечно, можно сказать, что здесь двойная длинна, которую на чистом Delphi без ущерба производительности реализовать не удастся.
Но во-первых, сейчас активно используют x64 и подобную манипуляцию совершат в два счёта. Во-вторых, при ограниченном диапазоне делимого - вполне можно реализовать деление через обычный imul и сдвиг, что я продемонстрировал на примере ранее.

Немаловажно то, что делимое может и скорее всего будет со знаком. В этом случае логика сильно меняется, и заслуживает детального рассмотрения. Опять таки при ограниченном делимом наверняка можно делать "короткое" умножение.
Код: sql
1.
2.
3.
4.
5.
6.
7.
  mov ecx, eax
  mov edx, 1717986919
  sar ecx, 31
  imul edx
  sar edx, 2
  mov eax, edx
  sub eax, ecx
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39591987
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
SOFT FOR YOUAleksandr Sharahov,

Статья конечно хорошая, но считаю её как минимум не полной. Вот к примеру Си-шный дизасм деления на 10:
Код: sql
1.
2.
3.
4.
5.
u32div10(unsigned int):
  mov edx, -858993459
  mul edx
  mov eax, edx
  shr eax, 3


Конечно, можно сказать, что здесь двойная длинна, которую на чистом Delphi без ущерба производительности реализовать не удастся.
Но во-первых, сейчас активно используют x64 и подобную манипуляцию совершат в два счёта. Во-вторых, при ограниченном диапазоне делимого - вполне можно реализовать деление через обычный imul и сдвиг, что я продемонстрировал на примере ранее.

Немаловажно то, что делимое может и скорее всего будет со знаком. В этом случае логика сильно меняется, и заслуживает детального рассмотрения. Опять таки при ограниченном делимом наверняка можно делать "короткое" умножение.
Код: sql
1.
2.
3.
4.
5.
6.
7.
  mov ecx, eax
  mov edx, 1717986919
  sar ecx, 31
  imul edx
  sar edx, 2
  mov eax, edx
  sub eax, ecx


Во-первых, эти алгоритмы не вместо, а кроме.
Во-вторых, у меня нет ограничения диапазона - перечитай, если не уловил это.
В-третьих, и как ты тогда на x64 тогда будешь делить 64-битные? Там двойная длина 128 бит.
Знак - это как раз хорошо, ты снова не въехал. Это свободный лишний бит.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39592000
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Aleksandr Sharahov,

Я не хотел унизить или оскорбить. Я указал на то, что статью имеет смысл доработать, раскрыв вопрос в полной мере.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39592001
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
SOFT FOR YOUAleksandr Sharahov,

Я не хотел унизить или оскорбить. Я указал на то, что статью имеет смысл доработать, раскрыв вопрос в полной мере.

Ну, ты же не понял самой сути.

Предлагается ОРИГИНАЛЬНЫЙ, СОВЕРШЕННО НОВЫЙ, РАНЕЕ НИГДЕ НЕ ОПИСАННЫЙ АЛГОРИТМ.

Так понятнее? Нафига описание нового алгоритма превращать в обзор существующих?
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39592013
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Aleksandr Sharahov,

Я понимаю, что ты хочешь явить миру изобретение. Но практический смысл его только в том случае, если человек не умеет сделать дизасм си-кода (я его кстати делал онлайн), реализовать обратное умножение через FPU, или подобрать константы перебором для своего диапазона чисел. Как минимум в двух случаях из трёх код выполнится быстрее.

Согласен, у тебя универсальный способ, и с ассемблером, тем боле ARM, мучиться не нужно. Но если цель не только попиариться, а ещё и раскрыть тему деления, то без описанных мной выше нюансов - статью считаю не полной.

Алгоритм в литературе раскрыт слабо или практически не раскрыт. У одного чувака псевдокод касался только Cardinal/Cardinal и вроде бы не работал, точно не помню. У второго только Integer/Integer, с сопутствующими ограничениями. Во всяком случае диапазон значений делимого не учитывался нигде, поэтому короткий вариант операции не был рассмотрен нигде.

Может быть ты сталкивался с другой литературой. Но тем и хороши твои статьи, что написаны для людей. С примерами и рассуждениями. По крайней мере на то претендуют.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39592021
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
SOFT FOR YOUМожет быть ты сталкивался с другой литературой.

Довольно подробно известный алгоритм с двойной шириной описан и у Фога, и Уоррена (+ на сайте Уоррена есть дополнения). Для того чтобы понять идею и, используя шаблоны, написать деление самому без дизасма и перебора вполне достаточно. Останется только прогнать полную проверку написанного, ну, уж без этого никуда.

Описывать то, что всем и так давно известно, в сотый раз совершенно не за чем.
Все равно, чтоб получилось подробнее чем у Уоррена ни сил, ни умения, ни терпения не хватит.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39592026
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
SOFT FOR YOUЯ понимаю, что ты хочешь явить миру изобретение. Но практический смысл его только в том случае, если человек не умеет сделать дизасм си-кода (я его кстати делал онлайн), реализовать обратное умножение через FPU, или подобрать константы перебором для своего диапазона чисел. Как минимум в двух случаях из трёх код выполнится быстрее.


Добавь сюда ИМХО, и я забуду этот бред.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39592032
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Aleksandr Sharahov,

В смысле бред?
Твоё деление на 10 выполняется дольше на 1 сдвиг, вычитание и операцию чтения из памяти, чем в сишном дизасме
Моё (на диапазоне) деление на 100 делается вообще в две операции
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39592033
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
SOFT FOR YOUAleksandr Sharahov,

В смысле бред?
Твоё деление на 10 выполняется дольше на 1 сдвиг, вычитание и операцию чтения из памяти, чем в сишном дизасме
Моё (на диапазоне) деление на 100 делается вообще в две операции

Бред в том, что ты говоришь
"Мне никогда не понадобится велосипед, я воспользуюсь автомобилем",
как будто у тебя всегда под рукой есть автомобиль.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39592036
SOFT FOR YOU
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Aleksandr Sharahov,

Та никто не говорит, что твой алгоритм никогда не понадобится
Собственно и статьи твои обычно описывают то, что ранее кем-то было описано
Я смотрю с практической точки зрения. Ранее ты разжёвывал и более хорошо описанные подходы. Сейчас деление NativeInt/UInt наиболее оптимально подсматривается в си-выхлопе.
...
Рейтинг: 0 / 0
Поиск последовательности в бинарном массиве
    #39592114
Aleksandr Sharahov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
SOFT FOR YOU,

Знаем, плавали: все придумано до нас, "наиболее оптимально" летать самолетами.
...
Рейтинг: 0 / 0
270 сообщений из 270, показаны все 11 страниц
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Поиск последовательности в бинарном массиве
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]