Stone Lib ASCII v0.7.2

//////////////////////////////
//     Stone Lib ASCII+     //
//       by 100lar          //
//                   v0.7.2 //
//////////////////////////////

/////////////////тупа степень///////////////////
function step(x,j:integer):integer;
var
  i,st : integer;
begin
  if x = 0 then step := 1 else begin
    st := 1;
    for i := 1 to x do begin
      st := st * j;
      step := st;
      end;
    end;
end;
/////////////стандартное ASCII кодирование//////////////////////
function code(kod:integer;slovo:string):string;
var
i,j,g:integer;
slovofinal:string;
begin
        for g := 1 to kod do begin
        slovofinal:='';
          for i := 1 to length(slovo) do
            begin
              j:=0;
              while true do
                begin
                  j := j + 1;
                  if copy(slovo, i, 1) = chr(j) then
                    begin
                      slovofinal:=slovofinal + j+'/';
                      break;
                    end;
                end;
             end;
             slovo:=slovofinal;
            end;
           code:=slovofinal;
end;

function decode(kod:integer;slovo:string):string;
var
  i,g,j:integer;
  slovofinal,buf:string;
begin
        for g := 1 to kod do begin
        slovofinal:='';
          for i := 1 to length(slovo) do
            begin
              if copy(slovo, i, 1 ) <> '/' then
                buf := buf + copy(slovo, i, 1)
               else
              while true do
                begin
                  j:=j+1;
                  if buf = j+'' then begin
                      slovofinal:= slovofinal + chr(j);
                      buf:='';
                      j:=0;
                      break;
                    end;
                end;
                end;
                slovo:=slovofinal;
                decode:=slovofinal;
            end;
          //writeln('  стало: ', slovofinal);
end;
////////////модифицированное ASCII кодирование//////////////
function code_simv(kod:integer;slovo,simv:string):string;
var
i,j,g:integer;
slovofinal:string;
begin
        for g := 1 to kod do begin
        slovofinal:='';
          for i := 1 to length(slovo) do
            begin
              j:=0;
              while true do
                begin
                  j := j + 1;
                  if copy(slovo, i, 1) = chr(j) then
                    begin
                      slovofinal:=slovofinal + j+simv;
                      break;
                    end;
                end;
             end;
             slovo:=slovofinal;
            end;
           code_simv:=slovofinal;
end;

function decode_simv(kod:integer;slovo,simv:string):string;
var
  i,g,j:integer;
  slovofinal,buf:string;
begin
        for g := 1 to kod do begin
        slovofinal:='';
          for i := 1 to length(slovo) do
            begin
              if copy(slovo, i, 1 ) <> simv then
                buf := buf + copy(slovo, i, 1)
               else
              while true do
                begin
                  j:=j+1;
                  if buf = j+'' then begin
                      slovofinal:= slovofinal + chr(j);
                      buf:='';
                      j:=0;
                      break;
                    end;
                end;

                end;
                slovo:=slovofinal;
                decode_simv:=slovofinal;
            end;
end;
//////////////кодирование файлов///////////
function codefile(i:integer;filename,filename2:string):string;
var
  textt,textt2:textfile;
  buf:string;
begin
  assign(textt,filename);
  reset(textt);
  assign(textt2,filename2);
  rewrite(textt2);
  while true do
    begin
      readln(textt,buf);
      if buf = 'end()' then begin writeln(textt2,'end()'); break; end;
      buf := code(i,buf);
      writeln(textt2,buf);
    end;
  close(textt);
  close(textt2);
end;
function decodefile(i:integer;filename,filename2:string):string;
var
  textt,textt2:textfile;
  buf:string;
begin
  assign(textt,filename);
  reset(textt);
  assign(textt2,filename2);
  rewrite(textt2);
  while true do
    begin
      readln(textt,buf);
      if buf = 'end()' then begin writeln(textt2,'end()'); break; end;
      buf := decode(i,buf);
      writeln(textt2,buf);
    end;
  close(textt);
  close(textt2);
end;
///////////////система сч 2 и 10//////////////
function scdes(a:integer):string;
var
  k,b,d,s:integer;
begin
  repeat
    b := a mod 10;
    d := a div 10;
    s := s +b *step(k,2);
    k := k + 1;
    a := d;
  until d = 0;
  scdes := inttostr(s);
end;

function scdv(n:integer):string;
var
  i: integer;
  s, final: string;
begin
  while n > 0 do
    begin
      if n mod 2 = 0 then
        s := s + '0'
      else
        begin
          s := s + '1';
          n := n - 1;
        end;
      n := n div 2;
    end;
  for i := length(s) downto 1 do
    final := final +s[i];
    scdv := final;
end;

///////////////система сч 2 и 10 + кодировка////////////////////
function sccode(kod:integer;x:string):string;
var
  i,bufi,j:integer;
  buf,s,final:string;
begin
  s := code(kod,x);
  for i := 1 to length(s) do
    if s[i] = '/' then
      begin
        final := final + scdv(strtoint(buf)) + '/';
        buf := '';
      end else
        buf := buf + s[i];
     sccode := final;
end;

function scdecode(kod:integer;x:string):string;
var
  i,bufi:integer;
  buf,s,final:string;
begin
  s := x;
  for i := 1 to length(s) do
    if s[i] = '/' then
      begin
        final := final + scdes(strtoint(buf))+'/';
        buf := '';
      end else
        buf := buf + s[i];
        //writeln(final);
        final := decode(kod,final);
     scdecode := final;
end;
/////////////////система сч 2 и 10 + кодировка + символы между шифровками//////////////////
function sccode_simv(kod:integer;x,j:string):string;
var
  i,bufi:integer;
  buf,s,final:string;
begin
  s := code_simv(kod,x,j);
  for i := 1 to length(s) do
    if s[i] = j then
      begin
        final := final + scdv(strtoint(buf)) + j;
        buf := '';
      end else
        buf := buf + s[i];
     sccode_simv := final;
end;

function scdecode_simv(kod:integer;x,j:string):string;
var
  i,bufi:integer;
  buf,s,final:string;
begin
  s := x;
  for i := 1 to length(s) do
    if s[i] = j then
      begin
        final := final + scdes(strtoint(buf))+j;
        buf := '';
      end else
        buf := buf + s[i];
        //writeln(final);
        final := decode_simv(kod,final,j);
     scdecode_simv := final;
end;
///////////////////////////////////пример
begin
  writeln(code(1,'hello'));                   //стандартное кодирование
  writeln(decode(1,code(1,'hello')));         //стандартное раскодирование
   writeln;
  writeln(code_simv(1,'hello',' '));    //стандартное кодирование + можно изменить символ между числами(по стандарту '/')
  writeln(decode_simv(1,code_simv(1,'hello',' '),' '));    //стандартное раскодирование + можно изменить символ между числами(по стандарту '/')
   writeln;
  writeln(scdes(101));                        //перевод из 2 в 10 сч
  writeln(scdv(strtoint(scdes(101))));        //перевод из 10 в 2 сч
   writeln;
  writeln(sccode(2,'hello'));                 //стандартное кодирование + двоичная шифровка
  writeln(scdecode(2,sccode(2,'hello')));     //раскодирование стандартной кодировки с двоичной шифровкой
   writeln;
  writeln(sccode_simv(2,'hello',' '));                        //стандартное кодирование + двоичная шифровка + можно изменить символ между числами(по стандарту '/')
  writeln(scdecode_simv(2,sccode_simv(2,'hello',' '),' '));   //раскодирование стандартной кодировки с двоичной шифровкой + можно изменить символ между числами(по стандарту '/')

end.