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

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

Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

Восстановить пароль
Повторная активизация e-mail

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

Ответ
 
Опции темы Поиск в этой теме
Старый 18.02.2012, 01:45   #1
Katus
Форумчанин
 
Регистрация: 30.11.2011
Сообщений: 161
По умолчанию Кодер-Декодер

Пишу код... кодера... в ручную долго... поэтому припахать комп решил... пусть строит файт сам... вот возникла проблема... выдает ошибку в коде.... пишет что чтото пропустил, но я не ви жу что именно

Код:
program coder;
{$apptype console}
uses
	sysutils;
type
	TArr = array [#0..#255,1..200, 1..4] of char;
	TCode = record
		Arr: TArr;

	end;
const
	MAXNUM = 99999999;
  IL = 16;
var
	DataString: TArr;// TCode;
	f1,f2: text;
	s1,s2: string;
	max,min,n: byte;
	maxlength: byte;
	i,j: longint;
	ch,c: char;
	k: integer;
	m: byte;
  p: byte;
  c1,c2,c3,c4: char;
begin
min:=33;
max:=255;
maxlength:=4;
s1:='codding.txt';
s2:='de'+s1;
assignfile(f1, s1);
assignfile(f2, s2);
rewrite(f1);
rewrite(f2);
randomize;
j:=random(MAXNUM);
i:=j-258000;
if i<0 then begin
	i:=j;
	j:=j+258000;
end;
p:=1;
ch:=#1;
for i:=i to j do begin
	if (ord(ch)<255)and(k=il) then begin
		k:=0;
		ch:=succ(ch);
	end else if k=il then
		break;
	n:=(abs(abs(random(MAXNUM)*(i-j)) mod 255 - 31)+31);
	c:=chr(n);
	s1:=s1+c;
	while (length(s1)>maxlength) do
		delete(s1, 1, 1);
	if p<maxlength then
		p:=p+1
	else begin
		p:=0;


{HERE IS ERROR}
		if (s1[1]<>#0)and(s1[2]<>#0)and(s1[3]<>#0)and(s1[4]<>#0) then begin
{HERE IS ERROR}

			for m:=1 to 4 do
				DataString[ch, k, m]:=s1[m];
			k:=k+1;
		end;
	end;
end;
{
for ch:=#0 to #255 do begin
	for i:=1 to il-1 do begin
		write(f1, '''');
		for m:=1 to 4 do begin
			write(f1, DataString[ch, i, m]);
		write(f1, '''');
		if i < il-1 then
			write(f1, ',')
		else
			writeln(f1, ':');
		end;
	writeln(f1, '    c:=#',ord(ch),';');
	end;
writeln(f1, 'end;');
}

writeln(f2, '  case s[1] of');
for c1:=#32 to #255 do begin
	writeln(f1, '    #',ord(c1),':');
	writeln(f1, '      case s[2] of');
	for c2:=#32 to #255 do begin
		writeln(f1, '      #',ord(c2),':');
		writeln(f1, '        case s[3] of');
		for c3:=#32 to #255 do begin
			writeln(f1, '        #',ord(c3),':');
			writeln(f1, '          case s[4] of');
			for c4:=#32 to #255 do begin
				writeln('        #',ord(c4),':');
				for c:=#32 to #255 do
					for i:=1 to il do

//ERRRORRRRRRRRRRRRR next str
						if (c1=DataString(c, i, 1))and(c1=DataString(c, i, 2))and(c1=DataString(c, i, 3))and(c1=DataString(c, i, 4)) then
							writeln('            c:=#',ord(c),';');
				end;
			writeln(f1, '        end;');
			end;
		writeln(f1, '      end;');
		end;
	writeln(f1, '    end;');
	end;
writeln(f1, '  end;');

for ch:=#32 to #255 do begin
	writeln(f2, '#',ord(ch),':');
	writeln(f2, '    begin');
	for i:=32 to 255 do begin
		writeln(f2, '    n:=random(200)+1;');
		writeln(f2, '    case n of');
    for j:=1 to il-1 do begin
		  writeln(f2, '      ',j,': ');
		  s1:='';
		  for m:=1 to 4 do
			  s1:=s1+DataString[ch, i, m];
		  writeln(f2, 's:=''',s1,''';');
		  end;
	  writeln(f2, '  end;');
	  end;
  end;
writeln(f2, 'end;');
closefile(f1);
closefile(f2);
end.
Если лень что-то делать, заставь это делать машину ... =,

Последний раз редактировалось Katus; 18.02.2012 в 01:47.
Katus вне форума Ответить с цитированием
Старый 18.02.2012, 02:01   #2
Katus
Форумчанин
 
Регистрация: 30.11.2011
Сообщений: 161
По умолчанию

Нашел ошибку (Массив не так записал...) Тема не актуальна
Если лень что-то делать, заставь это делать машину ... =,
Katus вне форума Ответить с цитированием
Старый 18.02.2012, 03:21   #3
Katus
Форумчанин
 
Регистрация: 30.11.2011
Сообщений: 161
По умолчанию

новая ошибка.... пролетает без рез-та...


Код:
program coder;
{$apptype console}
uses
	sysutils;
type
	TArr = array [#0..#255,1..200, 1..4] of char;
	TCode = record
		Arr: TArr;

	end;
const
  MINC = #90;
  MAXC = #190;
	MAXNUM = 99999999;
  IL = 16;
var
  bool: array [1..4] of boolean;
	DataString: TArr;// TCode;
	f1,f2: text;
	s1,s2: string;
	max,min,n: byte;
	maxlength: byte;
	i,j: longint;
  i1,i2,i3,i4: byte;
	ch,c: char;
	k: integer;
	m: byte;
  p: byte;
  c1,c2,c3,c4: char;
begin
min:=33;
max:=255;
maxlength:=4;
s1:='codding.txt';
s2:='de'+s1;
assignfile(f1, s1);
assignfile(f2, s2);
rewrite(f1);
rewrite(f2);
randomize;
j:=random(MAXNUM);
i:=j-258000;
if i<0 then begin
	i:=j;
	j:=j+258000;
end;
p:=1;
ch:=#1;
for i:=i to j do begin
	if (ord(ch)<255)and(k=il) then begin
		k:=0;
		ch:=succ(ch);
	end else if k=il then
		break;
	n:=(abs(abs(random(MAXNUM)*(i-j)) mod 255 - ord(MINC)+1)+ord(MINC));
	c:=chr(n);
	s1:=s1+c;
	while (length(s1)>maxlength) do
		delete(s1, 1, 1);
	if p<maxlength then
		p:=p+1
	else begin
		p:=0;
		if (s1[1]<>#0)and(s1[2]<>#0)and(s1[3]<>#0)and(s1[4]<>#0) then begin
      k:=k+1;
			for m:=1 to 4 do
				DataString[ch, k, m]:=s1[m];
		end;
	end;
end;
{
for ch:=#0 to #255 do begin
	for i:=1 to il-1 do begin
		write(f1, '''');
		for m:=1 to 4 do begin
			write(f1, DataString[ch, i, m]);
		write(f1, '''');
		if i < il-1 then
			write(f1, ',')
		else
			writeln(f1, ':');
		end;
	writeln(f1, '    c:=#',ord(ch),';');
	end;
writeln(f1, 'end;');
}

writeln(f2, '  case s[1] of');

for c1:=MINC to MAXC do
	for c2:=MINC to MAXC do
    for c3:=MINC to MAXC do
      for c4:=MINC to MAXC do
        for c:=#32 to #255 do
					for i1:=1 to il do
            if (c1=DataString[c, i, 1]) then begin
	            writeln(f1, '    #',ord(c1),':');
          	  writeln(f1, '      case s[2] of');
              for i2:=32 to 255  do
                if (c1=chr(i2))and(c2=DataString[chr(i2), i, 2]) then begin
	  	            writeln(f1, '      #',ord(c2),':');
  	  	          writeln(f1, '        case s[3] of');
                  for i3:=32 to 255 do
                    if (c1=chr(i3))and(c2=chr(i3))and(c3=chr(i3)) then begin
	  	  	            writeln(f1, '        #',ord(c3),':');
		  	              writeln(f1, '          case s[4] of');
                        for i4:=32 to 255 do
                          if (c1=chr(i4))and(c2=chr(i4))and(c3=chr(i4))and(c4=chr(i4)) then begin
	  			                  writeln(f1, '        #',ord(c4),':');
                            writeln(f1, '            c:=#',ord(c),';');
                            writeln(f1, '        end;');
                            break;
                            if c3=MAXC then begin
                      	      writeln(f1, '      end;');
                              if c2=MAXC then begin
                                writeln(f1, '    end;');
                                end;
                              end;
                            end;
                      end;
                  end;
              end;
writeln(f1, '  end;');

for ch:=#32 to #255 do begin
	writeln(f2, '#',ord(ch),':');
	writeln(f2, '    begin');
	for i:=32 to 255 do begin
		writeln(f2, '    n:=random(200)+1;');
		writeln(f2, '    case n of');
    for j:=1 to il-1 do begin
		  writeln(f2, '      ',j,': ');
		  s1:='';
		  for m:=1 to 4 do
			  s1:=s1+DataString[ch, i, m];
		  writeln(f2, 's:=''',s1,''';');
		  end;
	  writeln(f2, '  end;');
	  end;
  end;
writeln(f2, 'end;');
closefile(f1);
closefile(f2);
end.
Если лень что-то делать, заставь это делать машину ... =,
Katus вне форума Ответить с цитированием
Ответ


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



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Создание кодер и декодер для кода Хемминга на delphi ali213b Фриланс 2 24.12.2011 11:29
Декодер base64 не раскодирует картинки dollemika Помощь студентам 0 24.10.2011 00:19
Нужен кодер!!!! Tofy Фриланс 3 20.11.2010 13:50
Морзе декодер(с++) jambas92 Помощь студентам 3 14.11.2010 11:32