Журнал «Мир ПК», #05/2001
Вернуться к статье

Листинг 1

program DemoTest_1;
(***********************************)
(*Программа демонстрирует использование управляющих символов.*)
(* #07-^G — звонок (BEL);	*)
(* #08-^H —  (BS); *)
(* #10-^J — перевод строки (LF); *)
(* #13-^M — возврат каретки (CR). *)
(***********************************)
const
CR = #$0D;
LF = #$0A;
TempName = ?$$$$$$$$.$$$?;
type
StringType = string [80];
RegPack = record
case boolean of
False : (AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags : integer);
True : (AL,AH,BL,BH,CL,CH,DL,DH : byte)
end;
var
C : char;
F : text;
L : StringType;
(*—————————————————————————————————————-*)
procedure PutLine (Line : StringType);
(**********************)
(* Печать с задержкой *)
(**********************)
const
Time = 150;
var
I : byte;
Regs : RegPack;
begin
for I := 1 to Length (Line) do begin
Regs.AH := $02; (* печать символа *)
Regs.DL := Ord (Line [I]);
MsDos (Regs);
Delay (Time) end;
WriteLn;
Exit
end; (* PutLine *)
(*—————————————————————————————————————-*)
begin
TextBackGround (Black);
TextColor (LightGray);
ClrScr;
for C := #00 to #31 do begin
Str (Ord (C) : 3, L);
L := L + ? —>? + C + ?<—?;
if C > #15 then GotoXY (40, WhereY);
PutLine (L);
if C = #15 then GotoXY (1, 1)
end;
GotoXY (1, 18);
Assign (F, TempName);
Rewrite (F);
WriteLn (F, ?Разорванная? + CR + LF + ?строка?);
WriteLn (F, ?Разорванная? + LF + CR + ?строка?);
WriteLn (F, ?Разорванная? + CR + ?строка?);
Close (F);
Reset (F);
while not Eof (F) do begin
ReadLn (F, L);
PutLine (L) end;
Close (F);
Erase (F);
Halt
end. (* DemoTest_1 *)

Вернуться к статье


Листинг 2

program CryptDemo_2;
(*********************************)
(*Шифрование строки текста случайной перестановкой символов.*)
(* Turbo Pascal 3.xx *)
(*********************************)
const
TestTxt1 = ?Мама мыла Машу мылом. Маша мыло не любила. ?#10;
TestTxt2 = ?Шифрование перестановкой символов.?;
FileName = ?DEMO.TXT?;
var
I : byte;
C : char;
Line : string [$FF];
CryptTab : array [1..255] of byte;
F : text;
begin
TextBackGround (Black);
(* шифруемый текст *)
Line := TestTxt1 + TestTxt2;
TextColor (Yellow);
WriteLn (Line);
(* ввод-вывод строки через файл *)
TextColor (LightGreen);
Assign (F, FileName);
Rewrite (F);
WriteLn (F, Line);
Close (F);
Reset (F);
ReadLn (F, Line);
Close (F);
Erase (F);
WriteLn (Line);
(* восстановление строки *)
Line := TestTxt1 + TestTxt2;
(* рандомизация ключа шифрования *)
Randomize;
(* подготовка таблицы перестановок *)
for I := 1 to Length (Line) do
CryptTab [I] := Succ (Random (Length (Line)));
(* шифрование перестановкой символов *)
for I := 1 to Length (Line) do begin
C := Line [I];
Line [I] := Line [CryptTab [I]];
Line [CryptTab [I]] := C end;
TextColor (LightCyan);
WriteLn (Line);
(* дешифрирование перестановки символов *)
for I := Length (Line) downto 1 do begin
C := Line [I];
Line [I] := Line [CryptTab [I]];
Line [CryptTab [I]] := C end;
TextColor (White);
Write (Line);
TextColor (LightGray);
Writeln;
Halt
end. (* CryptDemo_2 *)

Вернуться к статье


Листинг 3

program CryptDemo_3;
(****************************)
(*Шифрование строки текста заменой символов 32..255.*)
(* Turbo Pascal 3.xx *)
(****************************)
const
TestTxt1 = ?Мама мыла Машу мылом. Маша мыло не любила. ?#10;
TestTxt2 = ?Шифрование заменой символов.?;
var
I : byte;
C : char;
Line : string [$FF];
Shift : byte;
begin
TextBackGround (Black);
(* шифруемый текст *)
Line := TestTxt1 + TestTxt2;
TextColor (Yellow);
WriteLn (Line);
(* рандомизация ключа шифрования *)
Randomize;
Shift := 1 + Random (223);
(* шифрование заменой символов *)
for I := 1 to Length (Line) do
if Line [I] >= #32 then
Line [I] := Chr ((Ord (Line [I]) + 192 - Shift) mod 224 + 
32);
TextColor (LightCyan);
WriteLn (Line);
(* дешифрирование замены символов *)
for I := 1 to Length (Line) do
if Line [I] >= #32 then
Line [I] := Chr ((Ord (Line [I]) - 32 + Shift) mod 224 + 
32);
TextColor (White);
Write (Line);
TextColor (LightGray);
WriteLn;
Halt
end. (* CryptDemo_3 *)

Вернуться к статье


Листинг 4

program CryptDemo_4;
(**************************************)
(*Шифрование строк текста случайными сдвигами символов с кодами 32..255.*)
(* Turbo Pascal 3.xx *)
(**************************************)
const
TestTxt1 = ?Мама мыла Машу мылом. Маша мыло не любила. ?#10;
TestTxt2 = ?Шифрование заменой символов.?;
var
I : byte;
C : char;
Line : string [$FF];
ShiftTab : array [1..255] of byte;
begin
TextBackGround (Black);
(* шифруемый текст *)
Line := TestTxt1 + TestTxt2;
TextColor (Yellow);
WriteLn (Line);
(* рандомизация ключа шифрования *)
Randomize;
(* подготовка таблицы сдвигов *)
for I := 1 to Length (Line) do
ShiftTab [I] := Random (224);
(* шифрование заменой символов *)
for I := 1 to Length (Line) do
if Line [I] >= #32 then
Line [I] := Chr ((Ord (Line [I]) + 192
- ShiftTab [I]) mod 224 + 32);
TextColor (LightCyan);
WriteLn (Line);
(* дешифрирование замены символов *)
for I := 1 to Length (Line) do
if Line [I] >= #32 then
Line [I] := Chr ((Ord (Line [I]) - 32 + ShiftTab [I]) mod 
224 + 32);
TextColor (White);
Write (Line);
TextColor (LightGray);
WriteLn;
Halt
end. (* CryptDemo_4 *)

Вернуться к статье


Листинг 5

function RndWord (var Y : integer) : integer;
(********************************************)
(*Конгруэнтный генератор случайного слова.*)
(*Перед первым вызовом надо присвоить переменной Y целое и в дальнейшем его не изменять.*)
(********************************************)
begin
Y := 12869 * Y + 6925;
RndWord := Y;
Exit
end; (* RndWord *)

Вернуться к статье


Листинг 6

program CryptDemo_6;
(***************************************)
(*Шифрование строк текста сдвигами по паролю символов с кодами 32..255.*)
(* Turbo Pascal 3.xx *)
(***************************************)
const
TestTxt1 = ?Мама мыла Машу мылом. Маша мыло не любила. ?#10;
TestTxt2 = ?Шифрование заменой символов.?;
PassWord : array [0..12] of char = ?Сов. секретно?;
var
I, J, K : byte;
Line : string [$FF];
begin
TextBackGround (Black);
(* шифруемый текст *)
Line := TestTxt1 + TestTxt2;
TextColor (Yellow);
WriteLn (Line);
(* шифрование заменой символов *)
for I := 1 to Length (Line) do
if Line [I] >= #32 then begin
J := Ord (Line [I]) - 32;
K := Ord (PassWord [I mod 13]) - 32;
Line [I] := Chr ((J + 224 - K) mod 224 + 32) end;
TextColor (LightCyan);
WriteLn (Line);
(* дешифрирование замены символов *)
for I := 1 to Length (Line) do
if Line [I] >= #32 then begin
J := Ord (Line [I]) - 32;
K := Ord (PassWord [I mod 13]) - 32;
Line [I] := Chr ((J + K) mod 224 + 32) end;
TextColor (White);
Write (Line);
TextColor (LightGray);
WriteLn;
Halt
end. (* CryptDemo_6 *)

Вернуться к статье


Листинг 7

program CryptDemo_7;
(****************************)
(*Шифрование строки текста заменой части символов.*)
(* Turbo Pascal 3.xx	*)
(****************************)
const
TestTxt1 = ?Мама мыла Машу мылом. Маша мыло не любила. ?#10;
TestTxt2 = ?Шифрование заменой символов.?;
var
I : byte;
C : char;
Line : string [$FF];
ShiftTab : array [1..255] of byte;
(*—————————————————————————————————————-*)
procedure ChangeCharNum (var C : char);
(************************)
(* Смена номера символа *)
(************************)
begin
case C of
#007..#010:	C	:=	Chr (Ord (C) + 243);
#013 :	C	:=	#254;
#026 :	C	:=	#255;
#250..#253:	C	:=	Chr (Ord (C) - 243);
#254 :	C	:=	#013;
#255 :	C	:=	#026
end;
Exit
end; (* ChangeCharNum *)
(*—————————————————————————————————————-*)
begin
TextBackGround (Black);
(* шифруемый текст *)
Line := TestTxt1 + TestTxt2;
TextColor (Yellow);
WriteLn (Line);
(* рандомизация ключа шифрования *)
Randomize;
(* подготовка таблицы сдвигов *)
for I := 1 to Length (Line) do
ShiftTab [I] := Random (250);
(* шифрование заменой символов *)
for I := 1 to Length (Line) do begin
ChangeCharNum (Line [I]);
if Line [I] < #250 then
Line [I] := Chr ((Ord (Line [I]) + 250 - ShiftTab [I]) mod 
250);
ChangeCharNum (Line [I]) end;
TextColor (LightCyan);
WriteLn (Line);
(* дешифрирование замены символов *)
for I := 1 to Length (Line) do begin
ChangeCharNum (Line [I]);
if Line [I] < #250 then
Line [I] := Chr ((Ord (Line [I]) + ShiftTab [I]) mod 250);
ChangeCharNum (Line [I]) end;
TextColor (White);
Write (Line);
TextColor (LightGray);
WriteLn;
Halt
end. (* CryptDemo_7 *)

Вернуться к статье
558