Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 03.04.2016, 10:20   #1
mitiay
Форумчанин
 
Регистрация: 16.01.2011
Сообщений: 288
По умолчанию base64 decode по списку

Гружу текст в мемо
Как организовать раскодировку base64 по списку чтоб раскодированный текст отображался в мемо2?в таком же порядке

Код:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function EncodeBase64(const inStr: string): string;

  function Encode_Byte(b: Byte): char;
  const
    Base64Code: string[64] =
      'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
  begin
    Result := Base64Code[(b and $3F)+1];
  end;

var
  i: Integer;
begin
  i := 1;
  Result := '';
  while i <= Length(InStr) do
  begin
    Result := Result + Encode_Byte(Byte(inStr[i]) shr 2);
    Result := Result + Encode_Byte((Byte(inStr[i]) shl 4) or (Byte(inStr[i+1]) shr 4));
    if i+1 <= Length(inStr) then
      Result := Result + Encode_Byte((Byte(inStr[i+1]) shl 2) or (Byte(inStr[i+2]) shr 6))
    else
      Result := Result + '=';
    if i+2 <= Length(inStr) then
      Result := Result + Encode_Byte(Byte(inStr[i+2]))
    else
      Result := Result + '=';
    Inc(i, 3);
  end;
end;
// Base64 decoding
function DecodeBase64(const CinLine: string): string;
const
  RESULT_ERROR = -2;
var
  inLineIndex: Integer;
  c: Char;
  x: SmallInt;
  c4: Word;
  StoredC4: array[0..3] of SmallInt;
  InLineLength: Integer;
begin
  Result := '';
  inLineIndex := 1;
  c4 := 0;
  InLineLength := Length(CinLine);
 
  while inLineIndex <= InLineLength do
  begin
    while (inLineIndex <= InLineLength) and (c4 < 4) do
    begin
      c := CinLine[inLineIndex];
      case c of
        '+'     : x := 62;
        '/'     : x := 63;
        '0'..'9': x := Ord(c) - (Ord('0')-52);
        '='     : x := -1;
        'A'..'Z': x := Ord(c) - Ord('A');
        'a'..'z': x := Ord(c) - (Ord('a')-26);
      else
        x := RESULT_ERROR;
      end;
      if x <> RESULT_ERROR then
      begin
        StoredC4[c4] := x;
        Inc(c4);
      end;
      Inc(inLineIndex);
    end;
 
    if c4 = 4 then
    begin
      c4 := 0;
      Result := Result + Char((StoredC4[0] shl 2) or (StoredC4[1] shr 4));
      if StoredC4[2] = -1 then Exit;
      Result := Result + Char((StoredC4[1] shl 4) or (StoredC4[2] shr 2));
      if StoredC4[3] = -1 then Exit;
      Result := Result + Char((StoredC4[2] shl 6) or (StoredC4[3]));
    end;
  end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Memo1.Text:=EncodeBase64(Memo1.Text);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
Memo1.Text:=DecodeBase64(Memo1.Text);
end;

end.

Последний раз редактировалось mitiay; 03.04.2016 в 14:17.
mitiay вне форума Ответить с цитированием
Старый 03.04.2016, 13:31   #2
min@y™
Цифровой кот
Старожил
 
Аватар для min@y™
 
Регистрация: 29.08.2014
Сообщений: 7,629
По умолчанию

Не вижу листбоксов в коде. Куды делись?
Расскажу я вам, дружочки, как выращивать грибочки: нужно в поле утром рано сдвинуть два куска урана...
min@y™ вне форума Ответить с цитированием
Старый 03.04.2016, 13:56   #3
mitiay
Форумчанин
 
Регистрация: 16.01.2011
Сообщений: 288
По умолчанию

Цитата:
Сообщение от min@y™ Посмотреть сообщение
Не вижу листбоксов в коде. Куды делись?
Здесь пример с мемо
mitiay вне форума Ответить с цитированием
Старый 03.04.2016, 14:06   #4
min@y™
Цифровой кот
Старожил
 
Аватар для min@y™
 
Регистрация: 29.08.2014
Сообщений: 7,629
По умолчанию

Цитата:
Здесь пример с мемо
который вводит в заблуждение.
переформулируй вопрос.
Расскажу я вам, дружочки, как выращивать грибочки: нужно в поле утром рано сдвинуть два куска урана...
min@y™ вне форума Ответить с цитированием
Старый 03.04.2016, 14:17   #5
mitiay
Форумчанин
 
Регистрация: 16.01.2011
Сообщений: 288
По умолчанию

Цитата:
Сообщение от min@y™ Посмотреть сообщение
который вводит в заблуждение.
переформулируй вопрос.
Код:
Код:
Гружу текст в мемо
Как организовать раскодировку base64 по списку чтоб раскодированный текст отображался в мемо2?в таком же порядке
mitiay вне форума Ответить с цитированием
Старый 03.04.2016, 14:30   #6
min@y™
Цифровой кот
Старожил
 
Аватар для min@y™
 
Регистрация: 29.08.2014
Сообщений: 7,629
По умолчанию

Цитата:
Гружу текст в мемо
не вижу ни одного вызова LoadFromXXX().
если грузишь из файла - дай файл.
Цитата:
раскодировку base64 по списку
По какому списку?
Цитата:
чтоб раскодированный текст отображался в мемо2
Memo2 тоже куда-то делся из кода.
Цитата:
в таком же порядке
о каком порядке идёт речь?

З.Ы. Переформулировать воспрос - это написать его с нуля и так, чтобы человеки, которые не в курсе всех флуктуаций в твоём межвисочном ганглии, поняли без разночтений все твои хотелки.
Если хочешь ускорить процесс - прицепи скриншот(ы) и/или скринкаст(ы).
Расскажу я вам, дружочки, как выращивать грибочки: нужно в поле утром рано сдвинуть два куска урана...
min@y™ вне форума Ответить с цитированием
Старый 03.04.2016, 16:44   #7
mitiay
Форумчанин
 
Регистрация: 16.01.2011
Сообщений: 288
По умолчанию

Цитата:
Сообщение от min@y™ Посмотреть сообщение
не вижу ни одного вызова LoadFromXXX().
если грузишь из файла - дай файл.

По какому списку?

Memo2 тоже куда-то делся из кода.

о каком порядке идёт речь?
memo1
Код:
допустим
asd1
asd2
asd3
asd4
asd5
В мемо2
Код:
закодированный asd1
закодированный asd2
закодированный asd3
закодированный asd4
закодированный asd5
mitiay вне форума Ответить с цитированием
Старый 03.04.2016, 16:54   #8
min@y™
Цифровой кот
Старожил
 
Аватар для min@y™
 
Регистрация: 29.08.2014
Сообщений: 7,629
По умолчанию

Код:
procedure FuckItBase64(ASource, ADest: TStrings);
var
  idx: int32;
begin
  ADest.BeginUpdate();
  try
    ADest.Clear();
    for idx:= 0 to ASource.Count - 1 do
      ADest.Add(EncodeBase64(ASource[idx]));
  finally
    ADest.EndUpdate();
  end;
end;
ну и нафига кодировать текст в base64? Эта хрень придумана для передачи бинарных данных в текстовых сообщениях (например, файлы к емейлам прицеплять).
Расскажу я вам, дружочки, как выращивать грибочки: нужно в поле утром рано сдвинуть два куска урана...
min@y™ вне форума Ответить с цитированием
Старый 03.04.2016, 16:57   #9
mitiay
Форумчанин
 
Регистрация: 16.01.2011
Сообщений: 288
По умолчанию

Цитата:
Сообщение от min@y™ Посмотреть сообщение
Код:
procedure FuckItBase64(ASource, ADest: TStrings);
var
  idx: int32;
begin
  ADest.BeginUpdate();
  try
    ADest.Clear();
    for idx:= 0 to ASource.Count - 1 do
      ADest.Add(EncodeBase64(ASource[idx]));
  finally
    ADest.EndUpdate();
  end;
end;
ну и нафига кодировать текст в base64? Эта хрень придумана для передачи бинарных данных в текстовых сообщениях (например, файлы к емейлам прицеплять).
Код:
Код:
procedure FuckItBase64(ASource, ADest: TStrings);
var
  idx: int32;
begin
  ADest.BeginUpdate();
  try
    ADest.Clear();
    for idx:= 0 to ASource.Count - 1 do
      ADest.Add(EncodeBase64(ASource[idx]));
  finally
    ADest.EndUpdate();
  end;
end;
Как быть с мемо?
mitiay вне форума Ответить с цитированием
Старый 03.04.2016, 17:01   #10
min@y™
Цифровой кот
Старожил
 
Аватар для min@y™
 
Регистрация: 29.08.2014
Сообщений: 7,629
По умолчанию

Цитата:
Как быть с мемо?
подставить в процедуру их свойства Lines.
На вопрос-то ответь!
Цитата:
нафига кодировать текст в base64?
Расскажу я вам, дружочки, как выращивать грибочки: нужно в поле утром рано сдвинуть два куска урана...
min@y™ вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Нужна библиотека с base64 (decode, encode) для synapse FleXik Общие вопросы Delphi 3 13.03.2014 17:27
json encode\decode в javascript mrgrudge JavaScript, Ajax 5 01.06.2011 16:34
HTML Decode kroŧ Работа с сетью в Delphi 2 26.10.2010 13:54
Decode Yoger Общие вопросы Delphi 2 17.01.2007 14:55