Модераторы: Poseidon, Snowy, bems, MetalFan

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Самый быстрый алгоритм Base64? 
V
    Опции темы
Ak47black
  Дата 31.3.2007, 12:51 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Завсегдатай
Сообщений: 2205
Регистрация: 2.12.2005

Репутация: 1
Всего: 0



Кодирую и декодирую , очень большие потоки данных при помоши Base64 и хотелбы узнать самый быстрый алгоритм.
Может кто поделиться, буду очень благодарин.
Видал много вариантов ,включая с DRKB3, хотелбы найти найбыстрейший способ. smile 
PM MAIL   Вверх
W4FhLF
Дата 31.3.2007, 14:55 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


found myself
****


Профиль
Группа: Участник Клуба
Сообщений: 2831
Регистрация: 2.12.2006

Репутация: 6
Всего: 121



Ну могу дать тебе пример на ассемблере, работает очень быстро, но переписать придётся тебеsmile

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


--------------------
"Бог умер" © Ницше
"Ницше умер" © Бог
PM ICQ   Вверх
Ak47black
Дата 31.3.2007, 15:04 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Завсегдатай
Сообщений: 2205
Регистрация: 2.12.2005

Репутация: 1
Всего: 0



W4FhLF, я толком тестить неумею, но так как у меня большими кусками шифрует то разница сразу видна.
Пока-что на этом остановился
Код

type TAByte = array [0..maxInt-1] of byte;
type TPAByte = ^TAByte;

function Encode(data:string) : string; overload;
const b64 : array [0..63] of char = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
var ic,len : integer;
  pi, po : TPAByte;
  c1 : DWORD;
begin
  len:=length(data);
  if len > 0 then
  begin
    SetLength(result, ((len + 2) div 3) * 4);
    pi := pointer(data);
    po := pointer(result);
    for ic := 1 to len div 3 do
    begin
      c1 := pi^[0] shl 16 + pi^[1] shl 8 + pi^[2];
      po^[0] := byte(b64[(c1 shr 18) and $3f]);
      po^[1] := byte(b64[(c1 shr 12) and $3f]);
      po^[2] := byte(b64[(c1 shr 6) and $3f]);
      po^[3] := byte(b64[(c1 ) and $3f]);
      inc(dword(po), 4);
      inc(dword(pi), 3);
    end;
    case len mod 3 of
    1 :
    begin
      c1 := pi^[0] shl 16;
      po^[0] := byte(b64[(c1 shr 18) and $3f]);
      po^[1] := byte(b64[(c1 shr 12) and $3f]);
      po^[2] := byte('=');
      po^[3] := byte('=');
    end;
    2 :
    begin
      c1 := pi^[0] shl 16 + pi^[1] shl 8;
      po^[0] := byte(b64[(c1 shr 18) and $3f]);
      po^[1] := byte(b64[(c1 shr 12) and $3f]);
      po^[2] := byte(b64[(c1 shr 6) and $3f]);
      po^[3] := byte('=');
    end;
  end;
  end else
  result := '';
end;

function Decode(data:string) : string; overload;
var
  i1,i2,len : integer;
  pi, po : TPAByte;
  ch1 : char;
  c1 : dword;
begin
  len:=length(data);
  if (len > 0) and (len mod 4 = 0) then
  begin
    len := len shr 2;
    SetLength(result, len * 3);
    pi := pointer(data);
    po := pointer(result);
    for i1 := 1 to len do
    begin
      c1 := 0;
      i2 := 0;
      while true do
      begin
        ch1 := char(pi^[i2]);
        case ch1 of
          'A'..'Z' : c1 := c1 or (dword(ch1) - byte('A') );
          'a'..'z' : c1 := c1 or (dword(ch1) - byte('a') + 26);
          '0'..'9' : c1 := c1 or (dword(ch1) - byte('0') + 52);
          '+' : c1 := c1 or 62;
          '/' : c1 := c1 or 63;
          else
          begin
            if i2 = 3 then
            begin
              po^[0] := c1 shr 16;
              po^[1] := byte(c1 shr 8);
              SetLength(result, Length(result) - 1);
            end else
            begin
              po^[0] := c1 shr 10;
              SetLength(result, Length(result) - 2);
            end;
          exit;
          end;
        end;
      if i2 = 3 then
      break;
      inc(i2);
      c1 := c1 shl 6;
    end;
    po^[0] := c1 shr 16;
    po^[1] := byte(c1 shr 8);
    po^[2] := byte(c1);
    inc(dword(pi), 4);
    inc(dword(po), 3);
  end;
  end else
  result := '';
end; 

PM MAIL   Вверх
W4FhLF
Дата 31.3.2007, 16:04 (ссылка)  | (голосов:1) Загрузка ... Загрузка ... Быстрая цитата Цитата


found myself
****


Профиль
Группа: Участник Клуба
Сообщений: 2831
Регистрация: 2.12.2006

Репутация: 6
Всего: 121



Жестьsmile

Пробуй:

Код

{
 str_in   - Указатель на входную строку, заканчивающуюся
            нулём.
 str_out  - Указатель на буфер, в который будет загружена
            сконвертированная строка.
 ВНИМАНИЕ:  Размер сконвертированной строки примерно на
            1/3 больше размера входных данных.
}
function b64_encode(str_in, str_out: pChar): Boolean; assembler;
asm
     mov esi,str_in
     mov edi,str_out
@1:  mov eax,'===='
     mov al,[esi]
     test al,al
     jz @3
     inc esi
     mov ah,[esi]
     mov edx,eax
     shr al,2
     call @X // Байт №1
     ror eax,8
     shr al,4
     shl dl,4
     or al,dl
     call @X // Байт №2
     mov dl,0FFh
     and dl,dh
     ror eax,16
     jz @2
     rol eax,8
     inc esi
     mov al,[esi]
     mov dl,al
     shr al,6
     shl dh,2
     or al,dh
     call @X // Байт №3
     test dl,dl
     ror eax,8
     jz @2
     mov al,dl
     call @X // Байт №4
     inc esi
@2:  ror eax,8
     mov [edi],eax
     add edi,4
     test dl,dl
     jnz @1
@3:  mov BYTE PTR [edi],0
     ret
     // Переводим в 6-битный ASCII
@X:  and al,3Fh
     add al,'A'
     cmp al,'Z' + 1
     jb @end
     add al,6
     cmp al,'z' + 1
     jb @end
     sub al,75
     cmp al,58
     jb @end
     mov al,'+'
     je @end
     mov al,'/'
@end:  retn
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  s1,s2:pChar;
begin
  GetMem(s2, 20);
  s1 := pChar('Hello World!');
  b64_encode(s1, s2);
  MessageBox(Application.Handle, s2, nil, MB_OK);
  FreeMem(s2);
end;



--------------------
"Бог умер" © Ницше
"Ницше умер" © Бог
PM ICQ   Вверх
Ak47black
Дата 31.3.2007, 16:14 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Завсегдатай
Сообщений: 2205
Регистрация: 2.12.2005

Репутация: 1
Всего: 0



А в обратную сторону?
PM MAIL   Вверх
W4FhLF
Дата 31.3.2007, 16:29 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


found myself
****


Профиль
Группа: Участник Клуба
Сообщений: 2831
Регистрация: 2.12.2006

Репутация: 6
Всего: 121



Код

function b64_encode(str_in, str_out: pChar): Boolean; assembler;
asm
     pushad
     mov esi,str_in
     mov edi,str_out
@1:  mov eax,'===='
     mov al,[esi]
     test al,al
     jz @3
     inc esi
     mov ah,[esi]
     mov edx,eax
     shr al,2
     call @X // Байт №1
     ror eax,8
     shr al,4
     shl dl,4
     or al,dl
     call @X // Байт №2
     mov dl,0FFh
     and dl,dh
     ror eax,16
     jz @2
     rol eax,8
     inc esi
     mov al,[esi]
     mov dl,al
     shr al,6
     shl dh,2
     or al,dh
     call @X // Байт №3
     test dl,dl
     ror eax,8
     jz @2
     mov al,dl
     call @X // Байт №4
     inc esi
@2:  ror eax,8
     mov [edi],eax
     add edi,4
     test dl,dl
     jnz @1
@3:  mov BYTE PTR [edi],0
     popad
     ret
     // Переводим в 6-битный ASCII
@X:  and al,3Fh
     add al,'A'
     cmp al,'Z' + 1
     jb @end
     add al,6
     cmp al,'z' + 1
     jb @end
     sub al,75
     cmp al,58
     jb @end
     mov al,'+'
     je @end
     mov al,'/'
@end:  retn
end;

function b64_decode(str_in: pChar): Boolean; assembler;
asm
     pushad
     mov edi,str_in
     mov esi,str_in
     xor edx,edx
     // Переводим из печатного ASCII в двоичный формат (0 - 63)
@L:  mov al,[esi]
     test al,al
     jz @R
     inc esi
     sub al,'A'
     cmp al,26
     jb @n
     sub al,6
     cmp al,52
     jb @n
     add al,90
     cmp al,62
     je @n
     sub al,3
     cmp al,63
     je @n
     sub al,12
     cmp al,62
     jb @n
     xor eax,eax
@n:  mov [edi],al
     inc edx
     inc edi
     cmp edx,4
     jl @L
     sub edi,4
     mov eax,[edi]
     // Компактуем байты (4 -> 3)
     shl al,2
     mov dl,ah
     shr ah,4
     and ah,3
     or al,ah
     mov [edi],al // Байт №1
     inc edi
     shr eax,8
     shl dl,4
     xchg al,dl
     mov dl,ah
     shr ah,2
     and ah,15
     or al,ah
     mov [edi],al // Байт №2
     inc edi
     shr eax,8
     shl dl,6
     xchg al,dl
     and ah,63
     or al,ah
     mov [edi],al // Байт №3
     inc edi
     xor edx,edx
     jmp @L
@R:  sub edi,edx
     mov byte ptr[edi],0
     popad
     ret
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  s1,s2:pChar;
begin
  GetMem(s2, 20);
  s1 := pChar('Hello World!');
  b64_encode(s1, s2);
  MessageBox(Application.Handle, s2, nil, MB_OK);
  b64_decode(s2);
  MessageBox(Application.Handle, s2, nil, MB_OK);
  FreeMem(s2);
end;


Как скорость?


--------------------
"Бог умер" © Ницше
"Ницше умер" © Бог
PM ICQ   Вверх
Ak47black
Дата 31.3.2007, 16:34 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Завсегдатай
Сообщений: 2205
Регистрация: 2.12.2005

Репутация: 1
Всего: 0



Шас заценю.

Добавлено через 7 минут и 24 секунды
А как-бы тут мне сделать что-бы string функция принималаю и возврашала?, а то неудобно
PM MAIL   Вверх
Ak47black
Дата 31.3.2007, 17:45 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Завсегдатай
Сообщений: 2205
Регистрация: 2.12.2005

Репутация: 1
Всего: 0



W4FhLF, твои функции быстрые но тут одна пролема ,как подсшитать длину выходной строки?
PM MAIL   Вверх
W4FhLF
Дата 31.3.2007, 18:00 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


found myself
****


Профиль
Группа: Участник Клуба
Сообщений: 2831
Регистрация: 2.12.2006

Репутация: 6
Всего: 121



Ak47black, точно так же, как и обычной: lenght(s2)


--------------------
"Бог умер" © Ницше
"Ницше умер" © Бог
PM ICQ   Вверх
Ak47black
Дата 31.3.2007, 18:02 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Завсегдатай
Сообщений: 2205
Регистрация: 2.12.2005

Репутация: 1
Всего: 0



W4FhLF, Да точно, сорри я тут уже запутался.
Спасибо за код. +
PM MAIL   Вверх
Alix
Дата 28.12.2009, 19:39 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


L45
**


Профиль
Группа: Участник
Сообщений: 581
Регистрация: 4.5.2005
Где: Pskov/Spb

Репутация: 7
Всего: 23



Цитата(Ak47black @  31.3.2007,  18:45 Найти цитируемый пост)
одна пролема ,как подсшитать длину выходной строки? 

Цитата(W4FhLF @  31.3.2007,  19:00 Найти цитируемый пост)
Ak47black, точно так же, как и обычной: lenght(s2) 

Видел функцию для подсчета необходимой длины ДО декодирования, чтобы создать буфер необходимой длины:
Код
function CalcEncodedSize(InSize: Cardinal): Cardinal;
begin
  // no buffers passed along, calculate outbuffer size needed
  Result := (InSize div 3) shl 2;
  if ((InSize mod 3) > 0)
  then Inc(Result, 4);
end;

Взято сhttp://www.delphi3000.com/articles/article_3404.asp?SK=, там тоже на ассемблере, кстати.

Пишу для тех, кто наткнется на тему по поиску.


--------------------
Знание только тогда знание, когда оно приобретено усилиями своей мысли, а не памятью (с) Л. Толстой
High tech. Low live. (с) Gardner Dozois
PM MAIL ICQ Skype   Вверх
Alix
Дата 28.12.2009, 20:16 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


L45
**


Профиль
Группа: Участник
Сообщений: 581
Регистрация: 4.5.2005
Где: Pskov/Spb

Репутация: 7
Всего: 23



Кстати, код из этого поста не переваривает во входной строке символы с 0 кодом.

Взял код для конвертации по ссылке из своего предыдущего поста. Получилось примерно так (это только implementation часть модуля):
Код
const
  cBase64Codec: array[0..63] of AnsiChar =
    'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
  Base64Filler = '=';

procedure Base64Encode(const InBuffer; InSize: Cardinal; var OutBuffer); overload; register;
var
  ByThrees, LeftOver: Cardinal;
  // reset in- and outbytes positions

asm

  // load addresses for source and destination
  // PBYTE(InBuffer);
  mov  ESI, [EAX]
  // PBYTE(OutBuffer);
  mov  EDI, [ECX]
  // ByThrees := InSize div 3;
  // LeftOver := InSize mod 3;
  // load InSize (stored in EBX)
  mov  EAX, EBX
  // load 3
  mov  ECX, $03
  // clear upper 32 bits
  xor  EDX, EDX
  // divide by ECX
  div  ECX
  // save result
  mov  ByThrees, EAX
  // save remainder
  mov  LeftOver, EDX
  // load addresses
  lea  ECX, cBase64Codec[0]
  // while I < ByThrees do
  // begin
  xor  EAX, EAX
  xor  EBX, EBX
  xor  EDX, EDX
  cmp  ByThrees, 0
  jz   @@LeftOver
  @@LoopStart:
    // load the first two bytes of the source triplet
    LODSW
    // write Bits 0..5 to destination
    mov  BL, AL
    shr  BL, 2
    mov  DL, BYTE PTR [ECX + EBX]
    // save the Bits 12..15 for later use [1]
    mov  BH, AH
    and  BH, $0F
    // save Bits 6..11
    rol  AX, 4
    and  AX, $3F
    mov  DH, BYTE PTR [ECX + EAX]
    mov  AX, DX
    // store the first two bytes of the destination quadruple
    STOSW
    // laod last byte (Bits 16..23) of the source triplet
    LODSB
    // extend bits 12..15 [1] with Bits 16..17 and save them
    mov  BL, AL
    shr  BX, 6
    mov  DL, BYTE PTR [ECX + EBX]
    // save bits 18..23
    and  AL, $3F
    xor  AH, AH
    mov  DH, BYTE PTR [ECX + EAX]
    mov  AX, DX
    // store the last two bytes of the destination quadruple
    STOSW
    dec  ByThrees
  jnz  @@LoopStart
  @@LeftOver:
  // there are up to two more bytes to encode
  cmp  LeftOver, 0
  jz   @@Done
  // clear result
  xor  EAX, EAX
  xor  EBX, EBX
  xor  EDX, EDX
  // get left over 1
  LODSB
  // load the first six bits
  shl  AX, 6
  mov  BL, AH
  // save them
  mov  DL, BYTE PTR [ECX + EBX]
  // another byte ?
  dec  LeftOver
  jz   @@SaveOne
  // save remaining two bits
  shl  AX, 2
  and  AH, $03
  // get left over 2
  LODSB
  // load next 4 bits
  shl  AX, 4
  mov  BL, AH
  // save all 6 bits
  mov  DH, BYTE PTR [ECX + EBX]
  shl  EDX, 16
  // save last 4 bits
  shr  AL, 2
  mov  BL, AL
  // save them
  mov  DL, BYTE PTR [ECX + EBX]
  // load base 64 'no more data flag'
  mov  DH, Base64Filler
  jmp  @@WriteLast4
  @@SaveOne:
  // adjust the last two bits
  shr  AL, 2
  mov  BL, AL
  // save them
  mov  DH, BYTE PTR [ECX + EBX]
  shl  EDX, 16
  // load base 64 'no more data flags'
  mov  DH, Base64Filler
  mov  DL, Base64Filler
  // ignore jump, as jump reference is next line !
  // jmp  @@WriteLast4
  @@WriteLast4:
    // load and adjust result
    mov  EAX, EDX
    ror EAX, 16
    // save it to destination
    STOSD
  @@Done:
end;

procedure Base64Decode(const InBuffer; InSize: Cardinal; var OutBuffer); overload; register;
const
  cBase64Codec: array[0..127] of Byte =
  (
    $FF, $FF, $FF, $FF, $FF, {005>} $FF, $FF, $FF, $FF, $FF, // 000..009
    $FF, $FF, $FF, $FF, $FF, {015>} $FF, $FF, $FF, $FF, $FF, // 010..019
    $FF, $FF, $FF, $FF, $FF, {025>} $FF, $FF, $FF, $FF, $FF, // 020..029
    $FF, $FF, $FF, $FF, $FF, {035>} $FF, $FF, $FF, $FF, $FF, // 030..039
    $FF, $FF, $FF, $3E, $FF, {045>} $FF, $FF, $3F, $34, $35, // 040..049
    $36, $37, $38, $39, $3A, {055>} $3B, $3C, $3D, $FF, $FF, // 050..059
    $FF, $FF, $FF, $FF, $FF, {065>} $00, $01, $02, $03, $04, // 060..069
    $05, $06, $07, $08, $09, {075>} $0A, $0B, $0C, $0D, $0E, // 070..079
    $0F, $10, $11, $12, $13, {085>} $14, $15, $16, $17, $18, // 080..089
    $19, $FF, $FF, $FF, $FF, {095>} $FF, $FF, $1A, $1B, $1C, // 090..099
    $1D, $1E, $1F, $20, $21, {105>} $22, $23, $24, $25, $26, // 100..109
    $27, $28, $29, $2A, $2B, {115>} $2C, $2D, $2E, $2F, $30, // 110..119
    $31, $32, $33, $FF, $FF, {125>} $FF, $FF, $FF            // 120..127
  );

asm
  push EBX
  mov  ESI, [EAX]
  mov  EDI, [ECX]
  mov  EAX, InSize
  shr  EAX, 2
  jz   @@Done
  lea  ECX, cBase64Codec[0]
  xor  EBX, EBX
  dec  EAX
  jz   @@LeftOver
  push EBP
  mov  EBP, EAX
  @@LoopStart:
    // load four bytes into EAX
    LODSD
    // save them to EDX as AX is used to store results
    mov  EDX, EAX
    // get bits 0..5
    mov  BL, DL
    // decode
    mov  AH, BYTE PTR [ECX + EBX]
    // get bits 6..11
    mov  BL, DH
    // decode
    mov  AL, BYTE PTR [ECX + EBX]
    // align last 6 bits
    shl  AL, 2
    // get first 8 bits
    ror  AX, 6
    // store first byte
    STOSB
    // align remaining 4 bits
    shr  AX, 12
    // get next two bytes from source quad
    shr  EDX, 16
    // load bits 12..17
    mov  BL, DL
    // decode
    mov  AH, BYTE PTR [ECX + EBX]
    // align ...
    shl  AH, 2
    // ... and adjust
    rol  AX, 4
    // get last bits 18..23
    mov  BL, DH
    // decord
    mov  BL, BYTE PTR [ECX + EBX]
    // enter in destination word
    or   AH, BL
    // and store to destination
    STOSW
    // more coming ?
    dec  EBP
  jnz  @@LoopStart
  pop  EBP
  // no
  // last four bytes are handled separately, as special checking is needed
  // on the last two bytes (may be end of data signals '=' or '==')
  @@LeftOver:
  // get the last four bytes
  LODSD
  // save them to EDX as AX is used to store results
  mov  EDX, EAX
  // get bits 0..5
  mov  BL, DL
  // decode
  mov  AH, BYTE PTR [ECX + EBX]
  // get bits 6..11
  mov  BL, DH
  // decode
  mov  AL, BYTE PTR [ECX + EBX]
  // align last 6 bits
  shl  AL, 2
  // get first 8 bits
  ror  AX, 6
  // store first byte
  STOSB
  // get next two bytes from source quad
  shr  EDX, 16
  // check DL for "end of data signal"
  cmp  DL, Base64Filler
  jz   @@SuccessDone
  // align remaining 4 bits
  shr  AX, 12
  // load bits 12..17
  mov  BL, DL
  // decode
  mov  AH, BYTE PTR [ECX + EBX]
  // align ...
  shl  AH, 2
  // ... and adjust
  rol  AX, 4
  // store second byte
  STOSB
  // check DH for "end of data signal"
  cmp  DH, Base64Filler
  jz   @@SuccessDone
  // get last bits 18..23
  mov  BL, DH
  // decord
  mov  BL, BYTE PTR [ECX + EBX]
  // enter in destination word
  or   AH, BL
  // AH - AL for saving last byte
  mov  AL, AH
  // store third byte
  STOSB
  @@SuccessDone:
  @@Done:
  pop  EBX
end;

function CalcEncodedSize(InSize: Cardinal): Cardinal;
begin
  // no buffers passed along, calculate outbuffer size needed
  Result := (InSize div 3) shl 2;
  if ((InSize mod 3) > 0)
  then Inc(Result, 4);
end;

function CalcDecodedSize(const InBuffer; InSize: Cardinal): Cardinal;
const
  Base64Filler = '=';

type
  BA = array of Byte;

begin
  Result := 0;
  if InSize = 0 then
    Exit;

  if InSize mod 4 <> 0 then
    Exit;

  Result := InSize div 4 * 3;
  if (BA(InBuffer)[InSize - 2] = Ord(Base64Filler))
  then Dec(Result, 2)
  else if BA(InBuffer)[InSize - 1] = Ord(Base64Filler)
       then Dec(Result);
end;


procedure Base64Encode(const InText: AnsiString; var OutText: AnsiString); overload;
var
  InSize, OutSize: Cardinal;
  PIn, POut: Pointer;

begin
  // get size of source
  InSize := Length(InText);
  // calculate size for destination
  OutSize := CalcEncodedSize(InSize);
  // prepare string length to fit result data
  SetLength(OutText, OutSize);
  PIn := @InText[1];
  POut := @OutText[1];
  // encode !
  Base64Encode(PIn, InSize, POut);
end;

procedure Base64Decode(const InText: AnsiString; var OutText: AnsiString); overload;
var
  InSize, OutSize: Cardinal;
  PIn, POut: Pointer;

begin
  // get size of source
  InSize := Length(InText);
  // calculate size for destination
  PIn := @InText[1];
  OutSize := CalcDecodedSize(PIn, InSize);
  // prepare string length to fit result data
  SetLength(OutText, OutSize);
  FillChar(OutText[1], OutSize, '.');
  POut := @OutText[1];
  // encode !
  Base64Decode(PIn, InSize, POut);
end;

function Base64Encode(const InText : string) : string; overload;
begin
  Base64Encode(InText, Result);
end;

function Base64Decode(const InText : string) : string; overload;
begin
  Base64Decode(InText, Result);
end;


Это сообщение отредактировал(а) Alix - 28.12.2009, 20:47


--------------------
Знание только тогда знание, когда оно приобретено усилиями своей мысли, а не памятью (с) Л. Толстой
High tech. Low live. (с) Gardner Dozois
PM MAIL ICQ Skype   Вверх
CodeMonkey
Дата 29.12.2009, 15:01 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1839
Регистрация: 24.6.2008
Где: Россия, Тверь

Репутация: 38
Всего: 89



Код по ссылке http://www.delphi3000.com/articles/article_3404.asp?SK= , а также код от Alix содержит баг. Конкретно - memory corruption.
Ещё конкретнее: в Base64Encode, третья строка (mov  EAX, EBX) - какой ещё EBX? Он неопределён.

Добавлено @ 15:04
Поправленный and оптимизированный вариант (прошёл тесты и работает, кстати, быстрее ассемблерного варианта от Delphi3000):

Код
unit Base64;

interface

uses 
  Windows, SysUtils;

function CalcEncodedSize(InSize: DWord): DWord;
function CalcDecodedSize(const InBuffer; InSize: DWord): DWord;

procedure Base64Encode(const InBuffer; InSize: DWord; var OutBuffer);
procedure Base64Decode(const InBuffer; InSize: DWord; var OutBuffer);

function Base64EncodeString(const InText: AnsiString): AnsiString;
function Base64DecodeString(const InText: AnsiString): AnsiString;

function Base64EncodeToString(const InBuffer; InSize: DWord): AnsiString;

implementation

const
  cBase64Codec: array[0..63] of AnsiChar =
    'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
  Base64Filler: AnsiChar = '=';

type
  TAByte = array[0..MaxInt - 1] of Byte;
  TPAByte = ^TAByte;

function CalcEncodedSize(InSize: DWord): DWord;
begin
  // no buffers passed along, calculate outbuffer size needed
  Result := (InSize div 3) shl 2;
  if (InSize mod 3) > 0 then 
    Inc(Result, 4);
end;

function CalcDecodedSize(const InBuffer; InSize: DWord): DWord;
begin
  Result := 0;
  if InSize = 0 then
    Exit;
  if (InSize mod 4 <> 0) then
    Exit;
  Result := InSize div 4 * 3;
  if (PByte(DWord(InBuffer) + InSize - 2)^ = Ord(Base64Filler)) then
    Dec(Result, 2)
  else
  if (PByte(DWord(InBuffer) + InSize - 1)^ = Ord(Base64Filler)) then
    Dec(Result);
end;

procedure Base64Encode(const InBuffer; InSize: DWord; var OutBuffer);
var
  X: Integer;
  PIn, POut: TPAByte;
  Acc: Cardinal;
begin
  if InSize > 0 then
  begin
    PIn := @InBuffer;
    POut := @OutBuffer;
    for X := 1 to InSize div 3 do
    begin
      Acc := PIn^[0] shl 16 + PIn^[1] shl 8 + PIn^[2];
      POut^[0] := Byte(cBase64Codec[(Acc shr 18) and $3f]);
      POut^[1] := Byte(cBase64Codec[(Acc shr 12) and $3f]);
      POut^[2] := Byte(cBase64Codec[(Acc shr 6 ) and $3f]);
      POut^[3] := Byte(cBase64Codec[(Acc       ) and $3f]);
      Inc(Cardinal(POut), 4);
      Inc(Cardinal(PIn),  3);
    end;
    case InSize mod 3 of
      1 :
      begin
        Acc := PIn^[0] shl 16;
        POut^[0] := Byte(cBase64Codec[(Acc shr 18) and $3f]);
        POut^[1] := Byte(cBase64Codec[(Acc shr 12) and $3f]);
        POut^[2] := Byte(Base64Filler);
        POut^[3] := Byte(Base64Filler);
      end;
      2 :
      begin
        Acc := PIn^[0] shl 16 + PIn^[1] shl 8;
        POut^[0] := Byte(cBase64Codec[(Acc shr 18) and $3f]);
        POut^[1] := Byte(cBase64Codec[(Acc shr 12) and $3f]);
        POut^[2] := Byte(cBase64Codec[(Acc shr 6 ) and $3f]);
        POut^[3] := Byte(Base64Filler);
      end;
    end;
  end;
end;

procedure Base64Decode(const InBuffer; InSize: DWord; var OutBuffer);
const
  cBase64Codec: array[0..255] of Byte =
  (
    $FF, $FF, $FF, $FF, $FF, {005>} $FF, $FF, $FF, $FF, $FF, // 000..009
    $FF, $FF, $FF, $FF, $FF, {015>} $FF, $FF, $FF, $FF, $FF, // 010..019
    $FF, $FF, $FF, $FF, $FF, {025>} $FF, $FF, $FF, $FF, $FF, // 020..029
    $FF, $FF, $FF, $FF, $FF, {035>} $FF, $FF, $FF, $FF, $FF, // 030..039
    $FF, $FF, $FF, $3E, $FF, {045>} $FF, $FF, $3F, $34, $35, // 040..049
    $36, $37, $38, $39, $3A, {055>} $3B, $3C, $3D, $FF, $FF, // 050..059
    $FF, $00, $FF, $FF, $FF, {065>} $00, $01, $02, $03, $04, // 060..069
    $05, $06, $07, $08, $09, {075>} $0A, $0B, $0C, $0D, $0E, // 070..079
    $0F, $10, $11, $12, $13, {085>} $14, $15, $16, $17, $18, // 080..089
    $19, $FF, $FF, $FF, $FF, {095>} $FF, $FF, $1A, $1B, $1C, // 090..099
    $1D, $1E, $1F, $20, $21, {105>} $22, $23, $24, $25, $26, // 100..109
    $27, $28, $29, $2A, $2B, {115>} $2C, $2D, $2E, $2F, $30, // 110..119
    $31, $32, $33, $FF, $FF, {125>} $FF, $FF, $FF, $FF, $FF, // 120..129
    $FF, $FF, $FF, $FF, $FF, {135>} $FF, $FF, $FF, $FF, $FF, // 130..139
    $FF, $FF, $FF, $FF, $FF, {145>} $FF, $FF, $FF, $FF, $FF, // 140..149
    $FF, $FF, $FF, $FF, $FF, {155>} $FF, $FF, $FF, $FF, $FF, // 150..159
    $FF, $FF, $FF, $FF, $FF, {165>} $FF, $FF, $FF, $FF, $FF, // 160..169
    $FF, $FF, $FF, $FF, $FF, {175>} $FF, $FF, $FF, $FF, $FF, // 170..179
    $FF, $FF, $FF, $FF, $FF, {185>} $FF, $FF, $FF, $FF, $FF, // 180..189
    $FF, $FF, $FF, $FF, $FF, {195>} $FF, $FF, $FF, $FF, $FF, // 190..199
    $FF, $FF, $FF, $FF, $FF, {205>} $FF, $FF, $FF, $FF, $FF, // 200..209
    $FF, $FF, $FF, $FF, $FF, {215>} $FF, $FF, $FF, $FF, $FF, // 210..219
    $FF, $FF, $FF, $FF, $FF, {225>} $FF, $FF, $FF, $FF, $FF, // 220..229
    $FF, $FF, $FF, $FF, $FF, {235>} $FF, $FF, $FF, $FF, $FF, // 230..239
    $FF, $FF, $FF, $FF, $FF, {245>} $FF, $FF, $FF, $FF, $FF, // 240..249
    $FF, $FF, $FF, $FF, $FF, {255>} $FF                      // 250..255
  );
var
  X, Y: Integer;
  PIn, POut: TPAByte;
  Acc : dword;
begin
  if (InSize > 0) and (InSize mod 4 = 0) then
  begin
    InSize := InSize shr 2;
    PIn := @InBuffer;
    POut := @OutBuffer;
    for X := 1 to InSize - 1 do
    begin
      Acc := 0;
      Y := -1;
      repeat
        Inc(Y);
        Acc := Acc shl 6;

        Acc := Acc or cBase64Codec[PIn^[Y]];

      until Y = 3;
      POut^[0] := Acc shr 16;
      POut^[1] := Byte(Acc shr 8);
      POut^[2] := Byte(Acc);
      Inc(Cardinal(PIn),  4);
      Inc(Cardinal(POut), 3);
    end;

    Acc := 0;
    Y := -1;
    repeat
      Inc(Y);
      Acc := Acc shl 6;

      if PIn^[Y] = Byte(Base64Filler) then
      begin
        if Y = 3 then
        begin
          POut^[0] := Acc shr 16;
          POut^[1] := Byte(Acc shr 8);
        end
        else
          POut^[0] := Acc shr 10;
        Exit;
      end;

      Acc := Acc or cBase64Codec[PIn^[Y]];

    until Y = 3;
    POut^[0] := Acc shr 16;
    POut^[1] := Byte(Acc shr 8);
    POut^[2] := Byte(Acc);
  end;
end;

procedure Base64EncodeStr(const InText: AnsiString; var OutText: AnsiString);
var
  InSize, OutSize: DWord;
  PIn, POut: Pointer;
begin
  // get size of source
  InSize := Length(InText);
  // calculate size for destination
  OutSize := CalcEncodedSize(InSize);
  // prepare AnsiString length to fit result data
  SetLength(OutText, OutSize);
  if OutSize > 0 then
  begin
    PIn := @InText[1];
    POut := @OutText[1];
    // encode !
    Base64Encode(PIn^, InSize, POut^);
  end;
end;

procedure Base64DecodeStr(const InText: AnsiString; var OutText: AnsiString);
var
  InSize, OutSize: DWord;
  PIn, POut: Pointer;
begin
  // get size of source
  InSize := Length(InText);
  // calculate size for destination
  PIn := @InText[1];
  OutSize := CalcDecodedSize(PIn, InSize);
  // prepare AnsiString length to fit result data
  SetLength(OutText, OutSize);
  if OutSize > 0 then
  begin
    FillChar(OutText[1], OutSize, '.');
    POut := @OutText[1];
    // encode !
    Base64Decode(PIn^, InSize, POut^);
  end;
end;

function Base64EncodeString(const InText: AnsiString): AnsiString;
begin
  Base64EncodeStr(InText, Result);
end;

function Base64DecodeString(const InText: AnsiString): AnsiString;
begin
  Base64DecodeStr(InText, Result);
end;

function Base64EncodeToString(const InBuffer; InSize: DWord): AnsiString;
var
  POut: Pointer;
begin
  SetLength(Result, CalcEncodedSize(InSize));
  POut := @Result[1];
  Base64Encode(InBuffer, InSize, POut^);
end;

end.



Это сообщение отредактировал(а) CodeMonkey - 30.12.2009, 13:53


--------------------
Опытный программист на C++ легко решает любые не существующие в Паскале проблемы.
PM MAIL WWW ICQ Skype GTalk Jabber   Вверх
Alexeis
Дата 29.12.2009, 15:17 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 109
Всего: 459



Цитата(CodeMonkey @  29.12.2009,  14:01 Найти цитируемый пост)
третья строка (mov  EAX, EBX) - какой ещё EBX? Он неопределён.

  Разве параметры функции не передаются в регистрах?


--------------------
Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
Rrader
Дата 29.12.2009, 17:38 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Inspired =)
***


Профиль
Группа: Экс. модератор
Сообщений: 1535
Регистрация: 7.5.2005

Репутация: 70
Всего: 191



В таком порядке - eax, edx, ecx, stack


--------------------
Let's do this quickly!
Rest in peace, Vit!
PM MAIL Skype   Вверх
Alix
Дата 29.12.2009, 19:49 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


L45
**


Профиль
Группа: Участник
Сообщений: 581
Регистрация: 4.5.2005
Где: Pskov/Spb

Репутация: 7
Всего: 23



Цитата(CodeMonkey @  29.12.2009,  16:01 Найти цитируемый пост)
Код по ссылке http://www.delphi3000.com/articles/article_3404.asp?SK= , а также код от Alix содержит баг. Конкретно - memory corruption.
Ещё конкретнее: в Base64Encode, третья строка (mov  EAX, EBX) - какой ещё EBX? Он неопределён.

пардон, а как он тогда работает? (я не спорю, просто интересно).
Прув слов Rrader'a и немного полезной инфы:
Цитата
Under the register convention, up to three parameters are passed in CPU registers, and the rest (if any) are passed on the stack. The parameters are passed in order of declaration (as with the pascal convention), and the first three parameters that qualify are passed in the EAX, EDX, and ECX registers, in that order. Real, method-pointer, variant, Int64, and structured types) do not qualify as register parameters, but all other parameters do. If more than three parameters qualify as register parameters, the first three are passed in EAX, EDX, and ECX, and the remaining parameters are pushed onto the stack in order of declaration. For example, given the declaration

procedure Test(A: Integer; var B: Char; C: Double; const D: string; E: Pointer);

a call to Test passes A in EAX as a 32-bit integer, B in EDX as a pointer to a Char, and D in ECX as a pointer to a long-string memory block; C and E are pushed onto the stack as two double-words and a 32-bit pointer, in that order.

Register saving conventions

Procedures and functions must preserve the EBX, ESI, EDI, and EBP registers, but can modify the EAX, EDX, and ECX registers. When implementing a constructor or destructor in assembler, be sure to preserve the DL register. Procedures and functions are invoked with the assumption that the CPU's direction flag is cleared (corresponding to a CLD instruction) and must return with the direction flag cleared. 


Это сообщение отредактировал(а) Alix - 29.12.2009, 19:56


--------------------
Знание только тогда знание, когда оно приобретено усилиями своей мысли, а не памятью (с) Л. Толстой
High tech. Low live. (с) Gardner Dozois
PM MAIL ICQ Skype   Вверх
Alexeis
Дата 29.12.2009, 19:59 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 109
Всего: 459



Обратите внимание на 
procedure Base64Encode(const InBuffer; InSize: Cardinal; var OutBuffer); overload; register;

Возможно эта директива что-то меняет в передаче параметров (хотя это больше похоже на порт с паскаля)


--------------------
Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
Rrader
  Дата 29.12.2009, 20:09 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Inspired =)
***


Профиль
Группа: Экс. модератор
Сообщений: 1535
Регистрация: 7.5.2005

Репутация: 70
Всего: 191



Директива register есть соглашение:
Цитата(Rrader @  29.12.2009,  23:38 Найти цитируемый пост)
В таком порядке - eax, edx, ecx, stack

Register в Delphi подразумевается по умолчанию, поэтому мы даже не пишем ее. Это __fastcall.


--------------------
Let's do this quickly!
Rest in peace, Vit!
PM MAIL Skype   Вверх
Alexeis
Дата 29.12.2009, 20:51 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 109
Всего: 459



 // load InSize (stored in EBX)

Судя по комменту следует EBX заменить на EDX


--------------------
Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
CodeMonkey
Дата 29.12.2009, 22:05 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1839
Регистрация: 24.6.2008
Где: Россия, Тверь

Репутация: 38
Всего: 89



Цитата(Alix @  29.12.2009,  19:49 Найти цитируемый пост)
пардон, а как он тогда работает? (я не спорю, просто интересно).

А так и работает...  затирая вам память...

Цитата(Alexeis @  29.12.2009,  20:51 Найти цитируемый пост)
Судя по комменту следует EBX заменить на EDX 

А ещё лучше - на InSize, как это сделано (правильно, кстати) в Base64Decode.

Добавлено @ 22:08
P.S. Столкнулся с этим в поддержке EurekaLog. Мы получили баг-отчёт с memory corruption на ровном месте. К счастью была предоставлена воспроизводимая демка, и я по ней вышел на этот код, который когда-то был взят с Delphi3000 и встроен в EurekaLog. Вместе с багом. Удивительно, что это работало несколько лет. Окей, наверняка кто-то сталкивался с загадочными багами, но причину найти не могли. Вот она, сила copy&paste.

Добавлено @ 22:14
P.P.S. Конкретно в варианте с EurekaLog EBX оказывался равен OutSize из Base64EncodeStr (вместо InSize; InSize <= OutSize). Соответственно, Base64Encode кодировала больше данных, чем было нужно (заодно портя память, т.к. выходной буфер был предназначен только для содержания кодированных InSize байт, а не OutSize байт). Например, вместо взятия, скажем, 11-ти байт с входного буфера и записи их в 16-ти байтный выходной буфер, эта функция брала 16 байт из исходного буфера (ага, шанс на AV не сработал) и записывала 24 байта в выходной буфер (который имел размер 16 байт).

Добавлено через 14 минут и 1 секунду
Цитата(Rrader @  29.12.2009,  20:09 Найти цитируемый пост)
Это __fastcall

Кстати, сишный fastcall не совместим с register: он использует только два регистра (ECX и EDX) вместо трёх и имеет другую семантику.

Это сообщение отредактировал(а) CodeMonkey - 29.12.2009, 22:16


--------------------
Опытный программист на C++ легко решает любые не существующие в Паскале проблемы.
PM MAIL WWW ICQ Skype GTalk Jabber   Вверх
Alexeis
Дата 29.12.2009, 22:32 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 109
Всего: 459



Цитата(CodeMonkey @  29.12.2009,  21:05 Найти цитируемый пост)
Кстати, сишный fastcall не совместим с register: он использует только два регистра (ECX и EDX) вместо трёх и имеет другую семантику.

  Ну тогда бы билдер не смог компилироваться с делфи. Везде где делфийские вызовы у него __fastcall, так что либо билдер обманывает либо MS __fastcall отличается от билдеровского.


--------------------
Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
CodeMonkey
Дата 29.12.2009, 22:35 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1839
Регистрация: 24.6.2008
Где: Россия, Тверь

Репутация: 38
Всего: 89



Цитата(Alexeis @  29.12.2009,  19:59 Найти цитируемый пост)
хотя это больше похоже на порт с паскаля

Могу ошибаться, но в 16-ти битном Паскале вроде бы не было соглашения register. Возможно, это был порт с Delphi 1. Хз.

Добавлено через 1 минуту и 16 секунд
Цитата(Alexeis @  29.12.2009,  22:32 Найти цитируемый пост)
Ну тогда бы билдер не смог компилироваться с делфи.

Вы меня неверно поняли. Я не говорил про билдеровский __fastcall. Я говорил про MS-ский fastcall. Это разные вещи. Про что я и сказал.


--------------------
Опытный программист на C++ легко решает любые не существующие в Паскале проблемы.
PM MAIL WWW ICQ Skype GTalk Jabber   Вверх
Rrader
  Дата 1.1.2010, 17:04 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Inspired =)
***


Профиль
Группа: Экс. модератор
Сообщений: 1535
Регистрация: 7.5.2005

Репутация: 70
Всего: 191



Цитата(Rrader @  30.12.2009,  02:09 Найти цитируемый пост)
Register в Delphi подразумевается по умолчанию, поэтому мы даже не пишем ее. Это __fastcall. 

Здесь имелось в виду, что __fastcall в Delphi - это register (свое зарезервированное слово), по аналогии с другими компиляторами, где __fastcall прописывается как есть. Соглашение о вызове так и называется - fastcall. Причем у __fastcall есть несколько вариантов (мне известно 4). Наверное, мне стоило убрать два нижних подчеркивания, потому что к Delphi они здесь особого отношения не имеют, зато вводят в заблуждение smile 


--------------------
Let's do this quickly!
Rest in peace, Vit!
PM MAIL Skype   Вверх
Страницы: (2) [Все] 1 2 
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Общие вопросы"
SnowyMetalFan
bemsPoseidon
Rrader

Запрещается!

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи


Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, MetalFan, bems, Poseidon, Rrader.

 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Общие вопросы | Следующая тема »


 




[ Время генерации скрипта: 0.1364 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.