Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Разное > Исходники и статьи
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 04.11.2011, 11:19
Аватар для Admin
Admin Admin вне форума
Администратор
 
Регистрация: 03.10.2005
Адрес: Россия, Москва
Сообщения: 1,560
Версия Delphi: Delphi 7
Репутация: выкл
По умолчанию [Исходный код] - Кодирование Unicode строк в base64

Автор: gta126

Цитата:
Я искал какое-то время, как кодировать Unicode строк в base64, но не находя код на чистый я решил сделать это сам с нуля.Только коды нашел в сети, либо для кодирования ASCII строк (ANSI) является кодирование байтов в ASCII (ANSI)

Источник: http://www.delphifr.com/codes/CODAGE...ODE_53731.aspx

Код:
unit untComBase64;

// Version Unicode by gta126

interface

uses SysUtils;

function encode64(s: string): string;
function decode64(s: string): string;

implementation

const
  tabChar = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';

function encode64(s: string): string;
var
  i       : Integer; // compteur
  charCode: Integer; // code du caractиre dans la table Unicode
  valToDec: Integer; // valeur а dйcrйmenter au fur а mesure de la conversion
  nbrBits : Integer; // nombre de bits actuellement dans vaToDec (maximum 16 + 4)
  charPos : Integer; // position dans le tableau de codage en base64
begin
  Result   := '';
  charCode := 0;
  nbrBits  := 0;
  valToDec := 0;

  //parcours des caractиres
  for i := 1 to Length(s) do
  begin
    charCode := Ord(s[i]);
    nbrBits  := nbrBits + 16;
    valToDec := (valToDec shl 16) + charCode;

    // traiter les bits tant que l'on sais faire des groupements de 6
    while (nbrBits - 6) >= 0 do
    begin
      nbrBits  := nbrBits - 6;
      charPos  := valToDec shr nbrBits;
      valToDec := valToDec - (charPos shl nbrBits);
      Result   := Result + tabChar[charPos + 1];
    end;
  end;

  // gestion des desniers bits + ajout des complйments
  if nbrBits > 0 then
  begin
    charPos := valToDec shl (6 - nbrBits);
    Result  := Result + tabChar[charPos + 1];

    for i := 1 to (6 - nbrBits) div 2 do
      Result := Result + '=';
  end;
end;

function decode64(s: string): string;
var
  i       : Integer; // compteur
  charPos : Integer; // position dans le tableau de codage en base64
  valToDec: Integer; // valeur а dйcrйmenter au fur а mesure de la conversion
  nbrBits : Integer; // nombre de bits actuellement dans vaToDec (maximum 14 + 6)
  charCode: Integer; // code du caractиre dans la table Unicode
  quitLoop: Boolean; // quitter la boucle oui / non
begin
  Result   := '';
  nbrBits  := 0;
  valToDec := 0;
  quitLoop := False;

  // parcours des caractиres
  for i := 1 to Length(s) do
  begin
    charPos  := Pos(s[i], tabChar) - 1;
    nbrBits  := nbrBits + 6;
    valToDec := (valToDec shl 6) + charPos;

    // cas des derniers bits trop long ( signe = )
    if (i + 1 <= Length(s)) and (s[i+1] = '=') then
    begin
      valToDec := valToDec shr 2;
      nbrBits := nbrBits - 2;

      if (i + 2 <= Length(s)) and (s[i+2] = '=') then
      begin
        valToDec := valToDec shr 2;
        nbrBits := nbrBits - 2;
      end;

      quitLoop := True;
    end;

    // traitement des bits dиs qu'un groupe de 16 est possible
    if (nbrBits - 16) >= 0 then
    begin
      nbrBits  := nbrBits - 16;
      charCode := valToDec shr nbrBits;
      valToDec := valToDec - (charCode shl nbrBits);
      Result   := Result + Char(charCode);
    end;

    // quitter la boucle en ignorant les autres caractиres ( ignorer les = )
    if quitLoop then
      Break;
  end;

  // vйrification
  if nbrBits > 0 then
    Result:= '';
end;

end.

Последний раз редактировалось Admin, 04.11.2011 в 11:33.
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 05:31.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2023

ВКонтакте   Facebook   Twitter