Rambler's Top100

Твой мир ПРОграммирования-Delphi, Pascal, C++

Объявление

Если это Ваш первый визит на форум, то советуем зарегистрироваться. Зарегистрированные пользователи могут задавать вопросы и просматривать темы со скрытым текстом. Чтобы зарегистрироваться, нажмите Регистрация.

Информация о пользователе

Привет, Гость! Войдите или зарегистрируйтесь.

Метод сжатия строк

Страница: 1

Сообщений 1 страница 8 из 8

1

  • Автор: Bill
  • Админ
  • Bill
  • Откуда: Россия
  • Зарегистрирован: 2008-02-15
  • Приглашений: 0
  • Сообщений: 206
  • Уважение: [+0/-0]
  • Позитив: [+0/-0]
  • Пол: Мужской
  • Возраст: 34 [1991-08-08]
  • Провел на форуме:
    17 часов 33 минуты
  • Последний визит:
    2008-06-03 13:32:20

Вот код:

Код:
unit MainForm;

interface

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

type
TForm1 = class(TForm)
ButtonEncode: TButton;
ButtonDecode: TButton;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
InputFileName: TEdit;
OutputFileName: TEdit;
ButtonExit: TButton;
Label1: TLabel;
Label2: TLabel;
ButtonSelectInputFile: TButton;
ButtonSelectOutputFile: TButton;
Label3: TLabel;
procedure ButtonSelectInputFileClick(Sender: TObject);
procedure ButtonSelectOutputFileClick(Sender: TObject);
procedure ButtonDecodeEncodeClick(Sender: TObject);
procedure ButtonExitClick(Sender: TObject);
private
public
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

uses
basE91;

procedure TForm1.ButtonDecodeEncodeClick(Sender: TObject);
var
basE91: TBasE91;
fin, fout: TFileStream;
Buf: array[0..1024] of byte;
c: integer;
written: integer;
begin
written := 0;
fin := TFileStream.Create(InputFileName.Text, fmOpenRead);
fout := TFileStream.Create(OutputFileName.Text, fmCreate);
if (TComponent(Sender).Name = 'ButtonEncode') then
base91 := TBase91Encoder.Create(fout);
if (TComponent(Sender).Name = 'ButtonDecode') then
base91 := TBase91Decoder.Create(fout);
if not assigned(basE91) then
begin
Beep;
exit;
end;
while ((fin.Position + SizeOf(Buf)) < fin.Size) do
begin
fin.Read(Buf, SizeOf(Buf));
c := base91.Update(@Buf, 0, SizeOf(Buf));
Inc(written, c);
end;
c := fin.Size - fin.Position;
fin.Read(Buf, c);
c := base91.Update(@Buf, 0, c);
Inc(written, c);
c := base91.Finalize();
Inc(written, c);
base91.Free;
fin.Free;
fout.Free;
ShowMessageFmt('Total bytes written: %d', [written]);
end;

0

2

  • Автор: Bill
  • Админ
  • Bill
  • Откуда: Россия
  • Зарегистрирован: 2008-02-15
  • Приглашений: 0
  • Сообщений: 206
  • Уважение: [+0/-0]
  • Позитив: [+0/-0]
  • Пол: Мужской
  • Возраст: 34 [1991-08-08]
  • Провел на форуме:
    17 часов 33 минуты
  • Последний визит:
    2008-06-03 13:32:20
Код:
procedure TForm1.ButtonExitClick(Sender: TObject);
begin
Application.Terminate;
end;

procedure TForm1.ButtonSelectInputFileClick(Sender: TObject);
begin
OpenDialog1.FileName := InputFileName.Text;
if (OpenDialog1.Execute) then
InputFileName.Text := OpenDialog1.FileName;
end;

procedure TForm1.ButtonSelectOutputFileClick(Sender: TObject);
begin
SaveDialog1.FileName := OutputFileName.Text;
if (SaveDialog1.Execute) then
OutputFileName.Text := SaveDialog1.FileName;
end;

end.

0

3

  • Автор: Bill
  • Админ
  • Bill
  • Откуда: Россия
  • Зарегистрирован: 2008-02-15
  • Приглашений: 0
  • Сообщений: 206
  • Уважение: [+0/-0]
  • Позитив: [+0/-0]
  • Пол: Мужской
  • Возраст: 34 [1991-08-08]
  • Провел на форуме:
    17 часов 33 минуты
  • Последний визит:
    2008-06-03 13:32:20

это листинг самого модуля Base91

Код:
unit basE91;

interface

uses
SysUtils, Windows, Classes;

type
// Abstract base class for encoding or decoding
TBasE91 = class
protected
FOutputStream: TStream;
public
constructor Create(OutputStream: TStream);
// Returns the number of bytes written to OutputStream
function Update(InputData: PByte; Offset: integer; Length: integer): integer;
virtual; abstract;
// Returns the number of bytes written to OutputStream
function Finalize(): integer; virtual; abstract;
procedure reset(); virtual; abstract;
end;

[hide=0]TBasE91Encoder = class(TBasE91)
private
ebq, en: integer;
protected
public
function Update(InputData: PByte; Offset: integer; Length: integer): integer;
override;
function Finalize(): integer; override;
procedure reset(); override;
end;[/hide]

0

4

  • Автор: Bill
  • Админ
  • Bill
  • Откуда: Россия
  • Зарегистрирован: 2008-02-15
  • Приглашений: 0
  • Сообщений: 206
  • Уважение: [+0/-0]
  • Позитив: [+0/-0]
  • Пол: Мужской
  • Возраст: 34 [1991-08-08]
  • Провел на форуме:
    17 часов 33 минуты
  • Последний визит:
    2008-06-03 13:32:20
Код:
[hide=0]TBasE91Decoder = class(TBasE91)
private
dbq, dn, dv: integer;
protected
public
function Update(InputData: PByte; Offset: integer; Length: integer): integer;
override;
function Finalize(): integer; override;
procedure reset(); override;
end;[/hide]
implementation

const
EncodingTable: array[0..90] of byte = (
Ord('A'), Ord('B'), Ord('C'), Ord('D'), Ord('E'), Ord('F'), Ord('G'), Ord('H'),
Ord('I'), Ord('J'), Ord('K'), Ord('L'), Ord('M'), Ord('N'), Ord('O'), Ord('P'),
Ord('Q'), Ord('R'), Ord('S'), Ord('T'), Ord('U'), Ord('V'), Ord('W'), Ord('X'),
Ord('Y'), Ord('Z'), Ord('a'), Ord('b'), Ord('c'), Ord('d'), Ord('e'), Ord('f'),
Ord('g'), Ord('h'), Ord('i'), Ord('j'), Ord('k'), Ord('l'), Ord('m'), Ord('n'),
Ord('o'), Ord('p'), Ord('q'), Ord('r'), Ord('s'), Ord('t'), Ord('u'), Ord('v'),
Ord('w'), Ord('x'), Ord('y'), Ord('z'), Ord('0'), Ord('1'), Ord('2'), Ord('3'),
Ord('4'), Ord('5'), Ord('6'), Ord('7'), Ord('8'), Ord('9'), Ord('!'), Ord('#'),
Ord('$'), Ord('%'), Ord('&'), Ord('('), Ord(')'), Ord('*'), Ord('+'), Ord(','),
Ord('.'), Ord('/'), Ord(':'), Ord(';'), Ord('<'), Ord('='), Ord('>'), Ord('?'),
Ord('@'), Ord('['), Ord(']'), Ord('^'), Ord('_'), Ord('`'), Ord('{'), Ord('|'),
Ord('}'), Ord('~'), Ord('"'));

var
DecodingTable: array[0..255] of byte;

constructor TBasE91.Create(OutputStream: TStream);
begin
FOutputStream := OutputStream;
Reset();
end;

procedure TBasE91Encoder.Reset();
begin
ebq := 0;
en := 0;
end;

0

5

  • Автор: Bill
  • Админ
  • Bill
  • Откуда: Россия
  • Зарегистрирован: 2008-02-15
  • Приглашений: 0
  • Сообщений: 206
  • Уважение: [+0/-0]
  • Позитив: [+0/-0]
  • Пол: Мужской
  • Возраст: 34 [1991-08-08]
  • Провел на форуме:
    17 часов 33 минуты
  • Последний визит:
    2008-06-03 13:32:20
Код:
[hide=0]function TBasE91Encoder.Update(InputData: PByte; Offset: integer;
Length: integer): integer;
var
WriteBuf: array[0..1] of byte;
i, ev: integer;
begin
Result := 0;
Inc(InputData, Offset);
for i := 1 to Length do
begin
ebq := ebq or ((InputData^) shl en);
Inc(InputData);
Inc(en, 8);
if (en > 13) then
begin
ev := ebq and 8191;
if (ev > 88) then
begin
ebq := ebq shr 13;
Dec(en, 13);
end
else
begin
ev := ebq and 16383;
ebq := ebq shr 14;
Dec(en, 14);
end;
WriteBuf[0] := EncodingTable[ev mod 91];
WriteBuf[1] := EncodingTable[ev div 91];
FOutputStream.Write(WriteBuf, 2);
Inc(Result, 2);
end;
end;
end;[/hide]

0

6

  • Автор: Bill
  • Админ
  • Bill
  • Откуда: Россия
  • Зарегистрирован: 2008-02-15
  • Приглашений: 0
  • Сообщений: 206
  • Уважение: [+0/-0]
  • Позитив: [+0/-0]
  • Пол: Мужской
  • Возраст: 34 [1991-08-08]
  • Провел на форуме:
    17 часов 33 минуты
  • Последний визит:
    2008-06-03 13:32:20
Код:
function TBasE91Encoder.Finalize(): integer;
begin
Result := 0;
if (en > 0) then
begin
FOutPutStream.Write(EncodingTable[ebq mod 91], 1);
Inc(Result);
if ((en > 7) or (ebq > 90)) then
begin
FOutPutStream.Write(EncodingTable[ebq div 91], 1);
Inc(Result);
end;
end;
Reset();
end;

procedure TBasE91Decoder.Reset();
begin
dbq := 0;
dn := 0;
dv := -1;
end;

0

7

  • Автор: Bill
  • Админ
  • Bill
  • Откуда: Россия
  • Зарегистрирован: 2008-02-15
  • Приглашений: 0
  • Сообщений: 206
  • Уважение: [+0/-0]
  • Позитив: [+0/-0]
  • Пол: Мужской
  • Возраст: 34 [1991-08-08]
  • Провел на форуме:
    17 часов 33 минуты
  • Последний визит:
    2008-06-03 13:32:20
Код:
function TBasE91Decoder.Update(InputData: PByte; Offset: integer;
Length: integer): integer;
var
i: integer;
inputByte: byte;
begin
Result := 0;
Inc(InputData, Offset);
for i := 1 to Length do
begin
inputByte := InputData^;
Inc(InputData);
if (DecodingTable[inputByte] = byte(-1)) then
Continue;
if (dv = -1) then
dv := DecodingTable[inputByte]
else
begin
Inc(dv, DecodingTable[InputByte] * 91);
dbq := dbq or (dv shl dn);
if ((dv and 8191) > 88) then
Inc(dn, 13)
else
Inc(dn, 14);
repeat
FOutputStream.Write(byte(dbq), 1);
Inc(Result);
dbq := dbq shr 8;
Dec(dn, 8);
until (dn <= 7);
dv := -1;
end;
end;
end;

0

8

  • Автор: Bill
  • Админ
  • Bill
  • Откуда: Россия
  • Зарегистрирован: 2008-02-15
  • Приглашений: 0
  • Сообщений: 206
  • Уважение: [+0/-0]
  • Позитив: [+0/-0]
  • Пол: Мужской
  • Возраст: 34 [1991-08-08]
  • Провел на форуме:
    17 часов 33 минуты
  • Последний визит:
    2008-06-03 13:32:20
Код:
function TBasE91Decoder.Finalize(): integer;
var
OutputByte: byte;
begin
Result := 0;
if (dv <> -1) then
begin
OutputByte := dbq or dv shl dn;
FOutputStream.Write(OutputByte, 1);
end;
Reset();
end;


procedure PrepareDecodingTable();
var
i: integer;
begin
for i := 0 to 255 do
DecodingTable[i] := byte(-1);
for i := 0 to 90 do
DecodingTable[EncodingTable[i]] := i;
end;

begin
PrepareDecodingTable();
end.

0

Страница: 1