Program UnicodeFileDecrypt;
Uses CRT;
var
  FSz : Longint;
  i, k : Longint;
  Ar : array [1..30000] of Word;
  Ar_ : array [1..60000] of Char Absolute Ar;
  f : file;
  Ed : Word;
  x, y : Byte;
  Cnt : Word;
Function Decode( w : Word) : Char ;
var
  C : Char;
begin
  C := #0;
  if (Hi(w) = 0) and (Lo(w) in [$20..$7F]) then C := Char(Lo(w));
  if (Hi(w) = 4) and (Lo(w) in [$10..$3F]) then C := Char(Lo(w)+$70);
  if (Hi(w) = 4) and (Lo(w) in [$40..$4F]) then C := Char(Lo(w)+$A0);
  if (Hi(w) = 4) and (Lo(w) = 1 ) then C := 'Ё';
  if (Hi(w) = 4) and (Lo(w) = $51) then C := 'ё';
  Decode := C;
end;
Procedure ViewAr;
var
  j : Word;
  c : Char;
begin
  for j := 1 to 30000 do
  begin
    c := Decode(Ar[j]);
    if c <> #0 then
     begin
      Write(c);
      inc(x);
      end;
    if x>79 then
    begin
     x := 1;
     inc(y);
     if y>24 then
     begin
      y := 1;
      if ReadKey = #27 then
        begin
          Close(f);
          Halt($BEA4);
        end;
     end;
    end;
  end;
end;
Procedure ReViewAr;
var
  j : Word;
  c : Char;
begin
  for j := 1 to 30000 do
  begin
    c := Decode(Ar[j]);
    if c <> #0 then
     begin
      inc(Cnt);
{      Write(c);}
      Ar_[Cnt] := c;
{      inc(x);}
     end;
{    if x>79 then
    begin
     x := 1;
     inc(y);
     if y>24 then
     begin
      y := 1;
     end;
    end;}
  end;
end;
Procedure TextView;
begin
  WriteLn;
  x := 1;
  y := 1;
  Assign(f, ParamStr(1));
  Reset(f, 1);
  FSz := FileSize(f);
  FSz := (FSz shr 1) shl 1;
  k := FSz div 60000;
  Ed := FSz - k*60000;
  Seek(f, 0);
  for i := k downto 1 do
  begin
    BlockRead(f, Ar, 60000);
    ViewAr;
  end;
  BlockRead(f, Ar, Ed);
  ViewAr;
  Close(f);
  ReadKey;
  WriteLn;
end;
Procedure FileView;
var
  ft : file;
begin
  Assign(f, ParamStr(1));
  Reset(f, 1);
  if ParamCount >= 3 then
  begin
    Assign(ft, ParamStr(3));
    ReWrite(ft, 1);
  end
  else
  begin
    Assign(ft, 'undef.ufd');
    ReWrite(ft, 1);
  end;
  FSz := FileSize(f);
  FSz := (FSz shr 1) shl 1;
  k := FSz div 60000;
  Ed := FSz - k*60000;
  Seek(f, 0);
  for i := k downto 1 do
  begin
    BlockRead(f, Ar, 60000);
    Cnt := 0;
    ReViewAr;
    BlockWrite(ft, Ar_, Cnt);
  end;
  BlockRead(f, Ar, Ed);
  Cnt := 0;
  ReViewAr;
  BlockWrite(ft, Ar_, Cnt);
  Close(f);
  Close(ft);
  WriteLn;
end;
begin
  if ParamCount=0 then
  begin
   WriteLn('Отсутствует имя файла в командной строке! (/@-вывод в файл)');
   Halt($FFFF);
  end;
  if (ParamCount >= 2) and (ParamStr(2)='/@') then FileView else TextView;
end.

Назад