Кодирование. - Общие вопросы Delphi

Blizzz · 18.01.2009, 12:17

Помоги пожалуйста с программой. Программа шифрования. Вот текст программы в турбо паскале его нужно "перевести" в делфи. чтобы было два мемо окна и две кнопки Зашифровать и Расшифровать. Как не делал не получается в делфи никак...не компилится чтото...

Код:

program proba;
const
  n = 8;
type
  sType = string[n];
  matrix = array[1 .. n] of sType;
const
  mask: matrix = (
    'x...x...',
    '.x...x..',
    '..x...x.',
    '...x...x',
    '..x...x.',
    '...x....',
    'x...x..x',
    '..x..x..'
  );

  st: string =
    'skolkocelix4etirexzna4nix4iselmognopolu4itizcifr0123';

var
  encoded: matrix;
  masked: matrix;

{ Процедура поворота матрицы }
procedure T(var res: matrix);
var
  i, j: integer;
  mx: matrix;
begin
  mx := res;
  for i := 1 to n do
    for j := 1 to n do
      res[j, n - i + 1] := mx[i, j];
end;

{ Зашифровка текста }
procedure EncodeText(const s: string;
          const mask: matrix; var mx: matrix);
var
  i, j, count: integer;
  masked: matrix;
begin
  { Заполнение матрицы mx строками по N пробелов }
  for i := 1 to n do
    for j := 1 to n do mx[i] := mx[i] + #32;

  masked := mask;
  count := 1;
  while count <= length(s) do begin

    for i := 1 to n do
      for j := 1 to n do
        if masked[i, j] = 'x' then begin
          mx[i][j] := s[count];
          inc(count)
        end;
    T(masked);

  end;
end;

{ Расшифровка текста }
function DecodeText(const mask, encoded: matrix): string;
var
  s: string;
  i, j, count: integer;
  masked: matrix;
begin

  masked := mask;
  count := 0; s := '';
  while length(s) < n*n do begin
    for i := 1 to n do
      for j := 1 to n do
        if masked[i, j] = 'x' then s := s + encoded[i, j];
    T(masked);
  end;
  DecodeText := s;

end;
var
  i: integer;
begin

  EncodeText(st, mask, encoded);

  writeln('encoded text: ');
  for i := 1 to n do begin
    writeln(encoded[i]);
  end;

  writeln(DecodeText(mask, encoded));

end.

Terran · 18.01.2009, 12:40

Цитата:

Помоги пожалуйста с программой. Программа шифрования. Вот текст программы в турбо паскале его нужно "перевести" в делфи. чтобы было два мемо окна и две кнопки Зашифровать и Расшифровать. Как не делал не получается в делфи никак...не компилится чтото...

Вот держите. Перевёл из Паскаля в Делфи правда может не очень красиво перевёл, но если что, то подкорректируйте.

Код:

unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation

{$R *.dfm}

const
  n = 8;
type
  sType = string[n];
  matrix = array[1 .. n] of sType;
const
  mask: matrix = (
    'x...x...',
    '.x...x..',
    '..x...x.',
    '...x...x',
    '..x...x.',
    '...x....',
    'x...x..x',
    '..x..x..');
  st: string ='skolkocelix4etirexzna4nix4iselmognopolu4itizcifr0123';
var
  encoded: matrix;
  masked: matrix;
{ Процедура поворота матрицы }
procedure T(var res: matrix);
var
  i, j: integer;
  mx: matrix;
begin
  mx := res;
  for i := 1 to n do
    for j := 1 to n do
      res[j, n - i + 1] := mx[i, j];
end;
{ Зашифровка текста }
procedure EncodeText(const s: string; const mask: matrix; var mx: matrix);
var
  i, j, count: integer;
  masked: matrix;
begin
  { Заполнение матрицы mx строками по N пробелов }
  for i := 1 to n do
    for j := 1 to n do mx[i] := mx[i] + #32;

  masked := mask;
  count := 1;
  while count <= length(s) do begin

    for i := 1 to n do
      for j := 1 to n do
        if masked[i, j] = 'x' then begin
          mx[i][j] := s[count];
          inc(count)
        end;
    T(masked);

  end;
end;
{ Расшифровка текста }
function DecodeText(s: string;const mask, encoded: matrix): string;
var
  i, j, count: integer;
  masked: matrix;
begin
  masked := mask;
  count := 0; s := '';
  while length(s) < n*n do begin
    for i := 1 to n do
      for j := 1 to n do
        if masked[i, j] = 'x' then s := s + encoded[i, j];
    T(masked);
  end;
  DecodeText := s;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
form1.Memo2.Lines.Add('Decode text: ');
form1.Memo2.Lines.Add(DecodeText(st,mask, encoded));
end;
procedure TForm1.Button1Click(Sender: TObject);
var
  i: integer;
begin
 form1.Memo1.Lines.Add('Encode text: ');
EncodeText(st, mask, encoded);
 for i := 1 to n do
 begin
form1.Memo1.Lines.Add(encoded[i]);
end;
end;
end.

Blizzz · 18.01.2009, 12:46

спасибо большое. щас все работает.

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

Код:

const
  mask: matrix = (
    'x...x...',
    '.x...x..',
    '..x...x.',
    '...x...x',
    '..x...x.',
    '...x....',
    'x...x..x',
    '..x..x..');

чтобы это значение было не константой а загружалось из файла.

Serge_Bliznykov · 19.01.2009, 16:24

приблизительно так:
вместо Const Mask... пишем:

Код:

var
  f : TextFile;
  Mask : matrix;
  s : string;
  i : integer;
...
begin
   AssignFile(f, 'someone.txt');
   Reset(f);
   for i:=1 to n do 
   begin
     Readln(f,s);
     Mask[i] := s; 
   end;
   CloseFile(f);

Blizzz · 19.01.2009, 17:50

сделал вот так

Код:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, sMemo, sButton, sSkinManager, jpeg, ExtCtrls, sLabel;

type
  TForm1 = class(TForm)
    sSkinManager1: TsSkinManager;
    sButton1: TsButton;
    sButton2: TsButton;
    sMemo1: TsMemo;
    sButton3: TsButton;
    sMemo2: TsMemo;
    sButton4: TsButton;
    sButton5: TsButton;
    sButton6: TsButton;
    sButton7: TsButton;
    sButton8: TsButton;
    sLabel1: TsLabel;
    sLabel2: TsLabel;
    Image1: TImage;
    sLabel3: TsLabel;
    sLabel4: TsLabel;
    procedure sButton4Click(Sender: TObject);
    procedure sButton5Click(Sender: TObject);
    procedure sButton7Click(Sender: TObject);
    procedure sButton6Click(Sender: TObject);
    procedure sButton3Click(Sender: TObject);
    procedure sButton8Click(Sender: TObject);
    procedure sButton2Click(Sender: TObject);
    procedure sButton1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses Unit2;

{$R *.dfm}

procedure TForm1.sButton4Click(Sender: TObject);
begin
 Form2.ShowModal;
end;

procedure TForm1.sButton5Click(Sender: TObject);
begin
close;
end;

procedure TForm1.sButton7Click(Sender: TObject);
begin
 sMemo1.Lines.Clear;
end;

procedure TForm1.sButton6Click(Sender: TObject);
begin
  sMemo1.Lines.LoadFromFile('1.txt');
end;

procedure TForm1.sButton3Click(Sender: TObject);
begin
  sMemo2.Lines.SaveToFile('1.txt');
end;

procedure TForm1.sButton8Click(Sender: TObject);
begin
 sMemo2.Lines.Clear;
end;
const
  n = 8;
type
  sType = string[n];
  matrix = array[1 .. n] of sType;

var
  encoded: matrix;
  masked: matrix;
f : TextFile;
  Mask : matrix;
  s : string;
  i : integer;
begin
   AssignFile(f, 'someone.txt');
   Reset(f);
   for i:=1 to n do 
   begin
     Readln(f,s);
     Mask[i] := s; 
   end;
   CloseFile(f);
procedure T(var res: matrix);
var
  i, j: integer;
  mx: matrix;
begin
  mx := res;
  for i := 1 to n do
    for j := 1 to n do
      res[j, n - i + 1] := mx[i, j];
end;
{ Зашифровка текста }
procedure EncodeText(const s: string; const mask: matrix; var mx: matrix);
var
  i, j, count: integer;
  masked: matrix;
begin
  { Заполнение матрицы mx строками по N пробелов }
  for i := 1 to n do
    for j := 1 to n do mx[i] := mx[i] + #32;

  masked := mask;
  count := 1;
  while count <= length(s) do begin

    for i := 1 to n do
      for j := 1 to n do
        if masked[i, j] = 'x' then begin
          mx[i][j] := s[count];
          inc(count)
        end;
    T(masked);

  end;
end;
{ Расшифровка текста }
function DecodeText(s: string;const mask, encoded: matrix): string;
var
  i, j, count: integer;
  masked: matrix;
begin
  masked := mask;
  count := 0; s := '';
  while length(s) < n*n do begin
    for i := 1 to n do
      for j := 1 to n do
        if masked[i, j] = 'x' then s := s + encoded[i, j];
    T(masked);
  end;
  DecodeText := s;
end;


procedure TForm1.sButton2Click(Sender: TObject); {кнопка расшифровки текста}
begin
 form1.sMemo2.Lines.Add(DecodeText(sMemo1.Text,mask, encoded));
end;


procedure TForm1.sButton1Click(Sender: TObject);  {кнопка зашифровки текста}
var
  i: integer;
begin
EncodeText(sMemo1.Text, mask, encoded);
 for i := 1 to n do
begin
form1.sMemo2.Lines.Add(encoded[i]);
end;
end;

end.

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

Terran · 19.01.2009, 18:28

Вот, держите исходничёк с текстовым файлом: Шифровка.rar

19.01.2009, 16:24	#4
Serge_Bliznykov Старожил Регистрация: 09.01.2008 Сообщений: 26,229	приблизительно так: вместо Const Mask... пишем: Код: `var f : TextFile; Mask : matrix; s : string; i : integer; ... begin AssignFile(f, 'someone.txt'); Reset(f); for i:=1 to n do begin Readln(f,s); Mask[i] := s; end; CloseFile(f);` Последний раз редактировалось Serge_Bliznykov; 19.01.2009 в 16:27.

19.01.2009, 18:28	#6
Terran Участник клуба Регистрация: 28.11.2007 Сообщений: 1,521	Вот, держите исходничёк с текстовым файлом: Шифровка.rar Всегда рад помочь!

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
ADPCM кодирование	Eugene881118	Помощь студентам	1	08.07.2008 14:36
Манчестерское кодирование	Боня	Помощь студентам	1	17.05.2007 17:07
Кодирование	Mss_Smith	Помощь студентам	3	17.04.2007 14:46
Кодирование информации!!!!!	Girl	Безопасность, Шифрование	0	04.03.2007 14:40
кодирование информации.	Alar	Общие вопросы Delphi	1	11.02.2007 19:26

18.01.2009, 12:46	#3
Blizzz Регистрация: 09.11.2008 Сообщений: 6	спасибо большое. щас все работает. А подскажите еще пожалуста как сделать так чтобы значение маски хранилось в текстовом файле. Код: `const mask: matrix = ( 'x...x...', '.x...x..', '..x...x.', '...x...x', '..x...x.', '...x....', 'x...x..x', '..x..x..');` чтобы это значение было не константой а загружалось из файла. Последний раз редактировалось Stilet; 19.01.2009 в 16:37.