Листинг 2.

Кодирование стего перестановкой маркеров концов строк.

program StegoCR_LF;

(***************************************************************)
(*     Простая  стеганографическая   программа,   использующая *)
(* замену порядка следования CR/LF в маркерах концов строк для *)
(* встраивания стего в произвольные тексты. мспользует от 1 до *)
(* 3 параметров, которые и определяют  выполняемую  программой *)
(* функцию. При этом первый из параметров всегда  представляет *)
(* файл-контейнер.                                             *)
(*     Если  этот  параметр   единственный,   то   проверяется *)
(* наличие  стеганограммы   в   файле-контейнере   с   выводом *)
(* результата на экран. По сути это режим стеганодетектора.    *)
(*     Если таких параметров два, стеганограмма извлекается из *)
(* контейнера, а  результат  записывается  в  заданный  вторым *)
(* параметром файл.                                            *)
(*     Наконец,  если  используются  все  три  параметра,   то *)
(* стеганографический  текст   из   файла   заданного   вторым *)
(* параметром, упрятывается в файл-контейнер, заданный  первым *)
(* параметром, а результат стеганографического  преобразования *)
(* записывается   в   файл,   заданный   третьим   параметром. *)
(* Совпадение двух имён файлов допускается (трёх - абсурд).    *)
(***************************************************************)

type
      StringType = string [$FF];

const
      TempName = '$$$$$$$$.$$$';
      Key1     = $1234;
      Key2     = $4567;
      CR       = #$0D;
      LF       = #$0A;

var
      F, G, H   : text;
      X         : StringType;
      I         : integer;
      K, L      : byte;
      C, CC     : char;
      Count     : real;

begin
      LowVideo;

      if not (ParamCount in [1..3])
      then
           begin
                 WriteLn ('Ожидается от  1 до 3  параметров:');
                 WriteLn ('1 - вывод стеганограммы на экран;');
                 WriteLn ('2 - вывод стеганограммы  в  файл;');
                 WriteLn ('3 - запись стеганограммы в  файл.');
                 Exit
           end;

      Assign (F, ParamStr (1));
      Reset (F);
      Count := 0;

      MemW [Dseg : $01FE] := Key1;
      MemW [Dseg : $01FC] := Key2;

(*---------------------ВЫВОД СТЕГАНОГРАММЫ НА ЭКРАН--------------------*)
      if ParamCount = 1
      then
           begin
                 C  := #00;
                 K  :=   0;
                 L  :=   0;

                 while not Eof (F)
                 do
                    begin
                          Read (F, CC);

                          if C = CR
                          then
                               if CC = LF
                               then
                                    begin
                                          L := Succ (L) mod 8;
                                          K := K shr 1;
                                          C := #00;

                                          if L = 0
                                          then
                                               begin
                                                     Write (Chr (K));
                                                     K := 0;
                                                     L := 0
                                               end
                                    end
                               else C := CC
                          else
                               if C = LF
                               then
                                    if CC = CR
                                    then
                                         begin
                                               L := Succ (L) mod 8;
                                               K := K shr 1 or $80;
                                               C := #00;

                                               if L = 0
                                               then
                                                    begin
                                                          Write (Chr (K));
                                                          K := 0;
                                                          L := 0
                                                    end
                                         end
                                    else C := CC
                               else C := CC
                    end;

                 Close (F);

                 if WhereX <> 1
                 then WriteLn;

                 WriteLn ('Ok!');
                 Exit
           end;

(*----------------------ВЫВОД СТЕГАНОГРАММЫ В ФАЙЛ---------------------*)
      if ParamCount = 2
      then
           begin
                 if Pos (':', ParamStr (2)) <> 2
                 then Assign (G, TempName)
                 else Assign (G, Copy (ParamStr (2), 1, 2) + TempName);

                 C  := #00;
                 K  :=   0;
                 L  :=   0;
                 Assign (G, TempName);
                 Rewrite (G);

                 while not Eof (F)
                 do
                    begin
                          Read (F, CC);

                          if C = CR
                          then
                               if CC = LF
                               then
                                    begin
                                          L := Succ (L) mod 8;
                                          K := K shr 1;
                                          C := #00;

                                          if L = 0
                                          then
                                               begin
                                                     K := K xor Random (256);
                                                     Count := Count + 1;
                                                     Write (G, Chr (K));
                                                     Write (Chr (K));
                                                     K := 0;
                                                     L := 0
                                               end
                                    end
                               else C := CC
                          else
                               if C = LF
                               then
                                    if CC = CR
                                    then
                                         begin
                                               L := Succ (L) mod 8;
                                               K := K shr 1 or $80;
                                               C := #00;

                                               if L = 0
                                               then
                                                    begin
                                                          K := K
                                                            xor Random (256);
                                                          Count := Count + 1;
                                                          Write (G, Chr (K));
                                                          Write (Chr (K));
                                                          K := 0;
                                                          L := 0
                                                    end
                                         end
                                    else C := CC
                               else C := CC
                    end;

                 Close (F);
                 Close (G);
                 Assign (F, ParamStr (2));
(*$I-*)
                 Erase (F);
(*$I+*)
                 I := IoResult;
                 Rename (G, ParamStr (2));

                 if WhereX <> 1
                 then WriteLn;

                 WriteLn ('Прочитано ', Count : 0 : 0, ' байт стего...');
                 Exit
           end;

(*----------------------ЗАПмСЬ СТЕГАНОГРАММЫ В ФАЙЛ--------------------*)
      Assign (G, ParamStr (2));

      if Pos (':', ParamStr (3)) <> 2
      then Assign (H, TempName)
      else Assign (H, Copy (ParamStr (3), 1, 2) + TempName);

      Reset   (G);
      Rewrite (H);
      L := 0;

      while not Eof (F)
      do
         begin
               ReadLn (F, X);
               Write  (H, X);

               if L = 0
               then
                    begin
                          Read (G, C);
                          Count := Count + 1;
                          Write (C);
                          K := Ord (C) xor Random (256)
                    end;

               if K and 1 = 0
               then Write (H, CR + LF)
               else Write (H, LF + CR);

               K := K shr 1;
               L := Succ (L) mod 8
         end;

      Close (F);
      Close (G);
      Close (H);
      Assign (F, ParamStr (3));
(*$I-*)
      Erase (F);
(*$I+*)
      I := IoResult;
      Rename (H, ParamStr (3));

      if WhereX <> 1
      then WriteLn;

      if (Count <> 0) and (L <> 0)
      then Count := Count - 1;

      WriteLn ('Записано ', Count : 0 : 0, ' байт стего...');
      Exit
end.