Карта сайта Kansoftware
НОВОСТИУСЛУГИРЕШЕНИЯКОНТАКТЫ
KANSoftWare

Кодирование с помощью решетки

Delphi , Синтаксис , Шифрование

Кодирование с помощью решетки


Автор: ___Nikolay
WEB-сайт: http://delphiworld.narod.ru

unit uMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Grids, StdCtrls, Gauges, ExtCtrls;

type
  TfmMain = class(TForm)
    sgGrid: TStringGrid;
    Label1: TLabel;
    sgText: TStringGrid;
    Label2: TLabel;
    Label3: TLabel;
    edNormal: TEdit;
    Label4: TLabel;
    edEncoded: TEdit;
    btEncode: TButton;
    btDecode: TButton;
    chAnimation: TCheckBox;
    Timer1: TTimer;
    procedure btEncodeClick(Sender: TObject);
    procedure btDecodeClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
    procedure SetGrid(iState: integer); // Выставить решетку
    function EncodeStr(s: string): string; // Шифрование строки
    function DecodeStr(s: string): string; // Расшифрование строки
  public
    { Public declarations }
  end;

var
  fmMain: TfmMain;

implementation

{$R *.DFM}

{ TfmMain }

// Выставить решетку
procedure TfmMain.SetGrid(iState: integer);
var
  c, r, iColMin, iColMax, iRowMin, iRowMax: integer;
  x, y, iHalfCell: integer;
  pStart: TPoint;
begin
  Timer1.Enabled := false;
  GetCursorPos(pStart);
  iHalfCell := sgGrid.DefaultColWidth div 2; // Половина ширины ячейки

  case iState of
    1: begin
         iColMin := 5;
         iColMax := 9;
         iRowMin := 0;
         iRowMax := 4;
       end;
    2: begin
         iColMin := 5;
         iColMax := 9;
         iRowMin := 5;
         iRowMax := 9;
       end;
    3: begin
         iColMin := 0;
         iColMax := 4;
         iRowMin := 5;
         iRowMax := 9;
       end;
    4: begin
         iColMin := 0;
         iColMax := 4;
         iRowMin := 0;
         iRowMax := 4;
       end;
  end;

  for c := 0 to sgGrid.ColCount - 1 do
    for r := 0 to sgGrid.RowCount - 1 do
    begin
      if (c >= iColMin) and (c <= iColMax) and (r >= iRowMin) and (r <= iRowMax) then
        sgGrid.Cells[c, r] := '0'
      else
        sgGrid.Cells[c, r] := '1';

      // Визуализировать
      if chAnimation.Checked then
      begin
        Application.ProcessMessages;
        x := fmMain.Left + sgGrid.Left + sgGrid.CellRect(c, r).Left + iHalfCell;
        y := fmMain.Top + sgGrid.Top + sgGrid.CellRect(c, r).Top + iHalfCell + GetSystemMetrics(SM_CYCAPTION);
        SetCursorPos(x, y);
        sgGrid.Repaint;
        Sleep(10);
      end;
    end;

  SetCursorPos(pStart.x, pStart.y);
end;

procedure TfmMain.btEncodeClick(Sender: TObject);
const
  sMsgLengthCheck = 'Длина текста должна быть равна 100';
var
  s: string;
begin
  s := Trim(edNormal.Text);

  if Length(s) <> 100 then
  begin
    MessageDlg(sMsgLengthCheck, mtInformation, [mbOk], 0);
    Exit;
  end;

  edEncoded.Text := '';
  edEncoded.Text := EncodeStr(s);
end;

// Шифрование строки
function TfmMain.EncodeStr(s: string): string;
label
  start;
var
  c, r, i, iGridState: integer;
  sResult: string;
  x, y, iHalfCell: integer;
  pStart: TPoint;
begin
  Timer1.Enabled := false;
  GetCursorPos(pStart);
  iHalfCell := sgGrid.DefaultColWidth div 2; // Половина ширины ячейки

  iGridState := 1;
  SetGrid(iGridState);
  i := 1;
  sResult := '';

  start:
  for r := 0 to sgText.RowCount - 1 do
    for c := 0 to sgText.ColCount - 1 do
      if not boolean(StrToInt(sgGrid.Cells[c, r])) then
        if sgText.Cells[c, r] = '' then
        begin
          sgText.Cells[c, r] := s[i];
          inc(i);

          // Визуализировать
          if chAnimation.Checked then
          begin
            Application.ProcessMessages;
            x := fmMain.Left + sgText.Left + sgText.CellRect(c, r).Left + iHalfCell;
            y := fmMain.Top + sgText.Top + sgText.CellRect(c, r).Top + iHalfCell + GetSystemMetrics(SM_CYCAPTION);
            SetCursorPos(x, y);
            sgText.Repaint;
            Sleep(10);
          end;
        end;

  dec(i);
  if i < 100 then
    if i mod 25 = 0 then
    begin
      inc(iGridState);
      SetGrid(iGridState);
      inc(i);
      goto start;
    end;

  // Считываем по строкам
  for r := 0 to sgText.RowCount - 1 do
    for c := 0 to sgText.ColCount - 1 do
    begin
      sResult := sResult + sgText.Cells[c, r];
      sgText.Cells[c, r] := '';

      // Визуализировать
      if chAnimation.Checked then
      begin
        Application.ProcessMessages;
        x := fmMain.Left + sgText.Left + sgText.CellRect(c, r).Left + iHalfCell;
        y := fmMain.Top + sgText.Top + sgText.CellRect(c, r).Top + iHalfCell + GetSystemMetrics(SM_CYCAPTION);
        SetCursorPos(x, y);
        sgText.Repaint;
        Sleep(10);
      end;
    end;
  Result := sResult;

  SetCursorPos(pStart.x, pStart.y);
end;

procedure TfmMain.btDecodeClick(Sender: TObject);
const
  sMsgLengthCheck = 'Длина текста должна быть равна 100';
var
  s: string;
begin
  s := Trim(edEncoded.Text);

  if Length(s) <> 100 then
  begin
    MessageDlg(sMsgLengthCheck, mtInformation, [mbOk], 0);
    Exit;
  end;

  edNormal.Text := '';
  edNormal.Text := DecodeStr(s);
end;

// Расшифрование строки
function TfmMain.DecodeStr(s: string): string;
label
  start;
var
  c, r, i, iGridState: integer;
  sResult: string;
  x, y, iHalfCell: integer;
  pStart: TPoint;
begin
  Timer1.Enabled := false;
  GetCursorPos(pStart);
  iHalfCell := sgGrid.DefaultColWidth div 2; // Половина ширины ячейки

  iGridState := 1;
  SetGrid(iGridState);
  i := 1;
  sResult := '';

  // Заносим по строкам
  for r := 0 to sgText.RowCount - 1 do
    for c := 0 to sgText.ColCount - 1 do
    begin
      sgText.Cells[c, r] := s[i];
      inc(i);

      // Визуализировать
      if chAnimation.Checked then
      begin
        Application.ProcessMessages;
        x := fmMain.Left + sgText.Left + sgText.CellRect(c, r).Left + iHalfCell;
        y := fmMain.Top + sgText.Top + sgText.CellRect(c, r).Top + iHalfCell + GetSystemMetrics(SM_CYCAPTION);
        SetCursorPos(x, y);
        sgText.Repaint;
        Sleep(10);
      end;
    end;

  i := 1;
  start:
  for r := 0 to sgText.RowCount - 1 do
    for c := 0 to sgText.ColCount - 1 do
      if not boolean(StrToInt(sgGrid.Cells[c, r])) then
      begin
        sResult := sResult + sgText.Cells[c, r];
        sgText.Cells[c, r] := '';
        inc(i);

        // Визуализировать
        if chAnimation.Checked then
        begin
          Application.ProcessMessages;
          x := fmMain.Left + sgText.Left + sgText.CellRect(c, r).Left + iHalfCell;
          y := fmMain.Top + sgText.Top + sgText.CellRect(c, r).Top + iHalfCell + GetSystemMetrics(SM_CYCAPTION);
          SetCursorPos(x, y);
          sgText.Repaint;
          Sleep(10);
        end;
      end;

    dec(i);
  if i < 100 then
    if i mod 25 = 0 then
    begin
      inc(iGridState);
      SetGrid(iGridState);
      inc(i);
      goto start;
    end;

  Result := sResult;

  SetCursorPos(pStart.x, pStart.y);
end;

procedure TfmMain.FormCreate(Sender: TObject);
begin
  Timer1.Enabled := true;
end;

procedure TfmMain.Timer1Timer(Sender: TObject);
begin
  SetGrid(1);
end;

end.
Скачать весь проект

Перевод контента на русский язык:

Основная форма Основная форма TfmMain содержит несколько компонентов: * sgGrid: строковая сетка для отображения зашифрованного/расшифровываемого текста * Label1 до Label4: метки для отображения ошибок и инструкций * edNormal и edEncoded: поля ввода для нормального и зашифрованного текста * btEncode и btDecode: кнопки для шифрования и расшифровки текста * chAnimation: чекбокс для включения/отключения анимации процесса шифрования/расшифровки

Процедура SetGrid Эта процедура используется для настройки сетки для шифрования или расшифровки. Она принимает целочисленный параметр iState, который определяет состояние сетки (1, 2, 3 или 4). Процедура устанавливает ячейки сетки в значение '0' или '1', в зависимости от состояния.

Функция EncodeStr Эта функция используется для шифрования строки с помощью сетки. Она принимает строковый параметр s и возвращает зашифрованный текст как строку. Функция проходит по ячейкам сетки, устанавливая каждую ячейку в символ из входной строки. Если ячейка не пуста, она пропускает к следующему циклу.

Функция DecodeStr Эта функция используется для расшифровки строки с помощью сетки. Она принимает строковый параметр s и возвращает расшифрованный текст как строку. Функция проходит по ячейкам сетки, устанавливая каждую ячейку в символ из входной строки. Если ячейка не пуста, она пропускает к следующему циклу.

Процедуры btEncodeClick и btDecodeClick Эти процедуры обрабатывают события кликов для кнопок шифрования и расшифровки. Они проверяют длину вводимого текста и затем вызывают либо EncodeStr, либо DecodeStr, в зависимости от нажатой кнопки.

Процедуры FormCreate и Timer1Timer Процедура FormCreate вызывается при создании формы, и она включает таймер. Процедура Timer1Timer вызывается каждые 100 миллисекунд (по умолчанию интервал таймера) и настраивает сетку для шифрования или расшифровки с помощью процедуры SetGrid.

Предложения по улучшению кода Вот несколько предложений по улучшению кода:

  • Рассмотрите использование более безопасного алгоритма шифрования, чем это простое grid-based-решение.
  • Используйте встроенные функции Delphi для строк, такие как Copy и Insert, вместо прохода по каждому символу входной строки.
  • Используйте более эффективную структуру данных,such as an array or list, для хранения зашифрованного/расшифровываемого текста вместо прямого изменения ячеек сетки.
  • Добавьте обработку ошибок для случаев, когда длина вводимого текста не равна 100 символам.
  • Рассмотрите добавление пароля или другого меры безопасности для защиты от несанкционированного доступа.

В целом, этот код предоставляет базовый пример реализации шифрования и расшифровки с помощью grid-based-решения в Delphi. Однако он может не быть пригоден для использования в производственной среде без дополнительных улучшений.

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


Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS




Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.


:: Главная :: Шифрование ::


реклама


©KANSoftWare (разработка программного обеспечения, создание программ, создание интерактивных сайтов), 2007
Top.Mail.Ru

Время компиляции файла: 2024-08-19 13:29:56
2024-11-21 13:21:33/0.0063340663909912/1