IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code].
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

> Перевод из Ascii в двоичную и архивация чисел
Анастасия
сообщение 8.10.2006 22:26
Сообщение #1


Новичок
*

Группа: Пользователи
Сообщений: 41
Пол: Женский
Реальное имя: Анастасия

Репутация: -  0  +


На языке Паскаль создайте программу, которая позволяет закодировать слово с использованием кодовой таблицы ASCII (один символ – восемь двоичных цифр) и проведите ручное «архивирование» закодированной информации по принципу; создается строка из наборов вида

Например: ABBA - 01000001010000100100001001000001 –>

(архивация - один ноль, одна единица и т.д.) 10 11 50 11 10 11 40 11 20 11 40 11 20 11 50 11

Код

program fff;
uses crt;
var  a :array[1..20] of byte;s:array[1..10] of string[8];
y:string[100]; sis :byte;  {systema schisleniya}
i,j,l,o,k :integer;  {schetchik zifr}
z:string[10];
begin
clrscr;
sis:=2;y:='';
writeln('vvedi z');readln(z);
WRITELN('-------------------------------');
for i:=1 to length(z) do
begin
write(' V ASCII z ='); writeln( ord(z[i]),' ');
l:= ord(z[i]); k:=ord(z[i]);j:=0;
repeat
    inc(j);
   a[j]:=k mod sis;
    k:=k div sis;
  until k<sis;
  if k<>0 then begin
    inc(j);
    a[j]:=k;
  end;
Write(l,'(10) -> ');
for o:=8 downto 1 do
begin
  Write(a[o]);
str(a[o],s[o]);
  y:=y+s[o];end;
Writeln('(',sis,').');writeln;
   writeln( 'y= ',y);
end;
writeln;writeln('----------------------------------');
o:=0;j:=0;k:=0;
for i:=1 to length(y) do
begin
if y[i]='0' then begin
o:=o+1;
if copy(y,i+1,1)<>'0' then begin k:=k+1; writeln('N ',k,' ' ,o,'0 ');o:=0; end;
end;
if y[i]='1' then begin
  j:=j+1;if copy(y,i+1,1)<>'1'then  begin k:=k+1;
  writeln('N ',k,' ',j,'1');j:=0;end;
  end;
end;
readkey;
end.

Может кто знает, как сделать короче?
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме


 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 



- Текстовая версия 21.06.2025 15:56
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"