Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 20.02.2012, 20:02   #11
Dasha1610
Пользователь
 
Регистрация: 19.02.2012
Сообщений: 24
По умолчанию

Код:
program e1;
uses crt;
Label 1, 2;
var F:file of byte; b:byte; i:integer;
    C:Integer;B1:Integer;s:String;
    F1:text;sf1:string;
    FF:text;sf:string;
begin
clrscr;

Assign(F,'SECRET.txt');
Reset(F);
while not eof(F) do
  begin
  Read(F,b);
S:='';
B1:=b;
2: C:= b Div 2;
If b-C*2 = 0 Then S := '0'+S;
If b-C*2 = 1 Then S := '1'+S;
If C<1 Then Goto 1;
b:=C;
Goto 2;
1: Write ('0',s);write;
end;

Assign(F1,'CONT.txt');
Assign(FF,'POL.txt');
Reset(F1);
Rewrite(FF);

While not eof (F1) do
 begin;
 Readln(F1,sf1);
  s:='s';


{???????????????????????}




  Writeln(FF,sf1);
   end;

close(F);
Close(F1);
Close(FF);
Readln;

End.




Вот до чего я додумалась сама.
прога работает как надо только я записываю в 3 файл тот же стих. не соображу куда и как прибавить пробелы, какое условие нужно..
подскажите)
Dasha1610 вне форума Ответить с цитированием
Старый 20.02.2012, 20:10   #12
Dasha1610
Пользователь
 
Регистрация: 19.02.2012
Сообщений: 24
По умолчанию

Код:
program e1;
uses crt;
Label 1, 2;
var F:file of byte; b:byte; i:integer;
    C:Integer;B1:Integer;s:String;
    F1:text;sf1:string;
    FF:text;sf:string;
begin
clrscr;

Assign(F,'SECRET.txt');
Reset(F);
while not eof(F) do
  begin
  Read(F,b);
S:='';
B1:=b;
2: C:= b Div 2;
If b-C*2 = 0 Then S := '0'+S;
If b-C*2 = 1 Then S := '1'+S;
If C<1 Then Goto 1;
b:=C;
Goto 2;
1: Write ('0',s);write;
end;

Assign(F1,'CONT.txt');
Assign(FF,'POL.txt');
Reset(F1);
Rewrite(FF);

While not eof (F1) do
 begin;
 Readln(F1,sf1);
  s:='s';


{???????????????????????}




  Writeln(FF,sf1);
   end;

close(F);
Close(F1);
Close(FF);
Readln;

End.


вот код работает все в принципе правильно. только вот где вопросы я отметила не соображу как и куда пробелы вставить..((
подскажите
Dasha1610 вне форума Ответить с цитированием
Старый 24.03.2016, 18:32   #13
Xchel
Пользователь
 
Регистрация: 24.03.2016
Сообщений: 13
По умолчанию

Цитата:
Сообщение от Serge_Bliznykov Посмотреть сообщение
ну, тогда и я свой пример кода кину...

чтобы был выбор...

полностью исходники + программа в архиве.

ну и исходники продублирую в тексте сообщения:
Код:
program co_dec;
const
  fNameIn = 'stihi.txt'; {имя файл из которого будет браться отвлекающая информация}
  fNameOut = 'stihi_co.txt'; {имя файл в который будет сохраняться закодированная информация}
var
  fIn, fOut : text;
  i, j, cnt : integer;
  OneSymbol : byte;
  sIn, s, sOne : string;
  choice : integer;
begin
  WriteLn('Стенография. Программа кодирования-декодирования. v1.0 (c) 2012');
  WriteLn;

  Assign(fIn, fNameIn);
  Assign(fOut, fNameOut);

  repeat
    WriteLn('Введите, что Вы хотите сделать (число): 0-выйти из программы, 1-кодировать сообщение, 2-декодировать.');
    Readln(choice);
  until (choice>=0) and (choice<=2);

  case choice of
    0: WriteLn('Окончание работы по запросу оператора.');
    1: begin
          WriteLn('Выбран режим кодирования');
          WriteLn('Введите строку для кодирования: ');
          Readln(sIn);
          WriteLn('Обработка файла ', fNameIn,
            ' результат будет помещён в файл ', fNameOut);

          Reset(fIn);
          {сначала проверим, что количество строк в исходном файле достаточно для кодирования}
          cnt:=0;
          while (cnt<=(Length(sIn)*8)) and (Not EOF(fIn)) do
          begin
            Readln(fIn);
            inc(cnt);
          end;
          Close(fIn);

          if cnt<=(Length(sIn)*8) then begin
            WriteLn('Недосточно строк в исходной файле!');
            WriteLn('Обнаружено ',cnt,' строк, а необходимо не менее ', 1+Length(sIn)*8);
          end
          else begin
            Reset(fIn);
            Rewrite(fOut);
            for i:=1 to Length(sIn) do begin
              OneSymbol := ord(sIn[i]);
              for j:=1 to 8 do begin
                ReadLn(fIn, s);

                {удалим все пробелы в конце строки}
                while ( Length(s)>0 ) and (s[Length(s)]=' ') do Delete(s,Length(s),1);

                {если крайний бить = 1 - то добавим в конец строки пробел}
                if (OneSymbol and 1) = 1 then s:= s+' ';

                WriteLn(fOut, s);

                {сдвинем байт символа вправо - чтобы в следующей итерации обработать следующий бит}
                OneSymbol := OneSymbol shr 1;

              end;
            end;
            ReadLn(fIn, s);
            {удалим все пробелы в конце строки}
            while ( Length(s)>0 ) and (s[Length(s)]=' ') do Delete(s,Length(s),1);

            {запишем в конец строки ДВА пробела - это признак окончания стеганотекста в обычном тексте}
            s:= s+'  ';
            WriteLn(fOut, s);

            {теперь просто скопируем всё, что осталось из первого файла во второй - допишем остаток файла}
            while Not EOF(FIn) do begin
              ReadLn(fIn, s);
              WriteLn(fOut, s);
            end;

            {закроем файлы}
            Close(fOut);
            Close(fIn);

            WriteLn('Процесс кодирования успешно завершён.');

          end;



       end;

    2: begin
        WriteLn('Выбран режим декодирования. Декодируется информация из файла ',fNameOut);

        sIn := '';  {строка, куда будем собирать декодированные байты. вначале пустая!}

        Reset(fOut);
        i:= 0;
        OneSymbol := 0;

        while Not EOF(FOut) do begin
           Readln(fOut, s);
           if Length(s)>=2 then
               {если в конце строки ДВА пробела - то всё, конец декодирования.
                обнаружен признак завершения стеганотекста}
             if copy(s,Length(s)-1,2)='  '
               then Break;
           inc(i);
           if (Length(s)>0) and (Copy(s, Length(s),1)=' ') then OneSymbol := OneSymbol or $80;
           if i=8 then begin
             sIn := sIn + chr(OneSymbol);
             i:=0;
             OneSymbol := 0;
           end
           else OneSymbol := OneSymbol shr 1;
        end;
        WriteLn('Обнаруженный скрытый текст: ', sIn);
        WriteLn;

        WriteLn('Процесс декодирования успешно завершён.');

       end;
  end;

  Readln; {ожидание нажатия Enter для закрытия окна программы...}
end.
А как сделать так, чтобы ту строку, что надо закодировать не с клавиатуры вводить, а из файла брать?
Xchel вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Поиск данных в текстовом файле (в самом файле! а не в Memo и не загружая всю инфу из файла в одну строку glagoff Помощь студентам 1 05.05.2010 13:00
изменение в текстовом файле nina_kh Общие вопросы Delphi 3 21.10.2009 16:33
Поиск в текстовом файле! Straiker Паскаль, Turbo Pascal, PascalABC.NET 2 18.01.2009 10:07
Поиск в текстовом файле KaimaS Общие вопросы C/C++ 0 12.11.2008 17:39