program mst;
{$R-,X+,V-,Q-,M 32768,0,65536}
uses crt,screen4,desc,dos,diskio;

type
     _conf = record
              dpb: _dpb;   { Default Disk Parameter Block }
              spt: byte;   { Sectors per track }
              hd:  byte;   { Heads }
              trk: byte;   { Number of tracks }
             end;
     entry = record
              user: byte;                { Hомер пользователя }
              name: array[0..7] of char; { Имя файла }
              ext : array[0..2] of char; { Расширение }
              exn : byte;                { Hомер экстента }
              re0 : word;                { Зарезервировано DOS }
              recs: byte;                { Число блоков в экстенте }
              fat : array[0..7] of word; { Hомера занятых блоков }
             end;
     _dirrec = record
        nam : string[12];
               exn : byte;               { Hомер текущего экстента }
               rcn : word;               { Hомер текущей записи }
               rcp : word;               { Указатель на тек. запись }
               ctn : word;               { Hомер текущего входа в каталог }
               rcs : byte;               { Число блоков в экстенте }
               ok  : word;               { Реально байт прочитано }
              end;
     _catrec = record
  nam : string[12];
                mark: boolean;           { Флаг отмеченных файлов }
                size: word;              { Размер файла в записях }
                aux : word;              { Число байт в последней записи }
               end;
     _dpb = record
               laddr : word;             { Адрес загрузки }
               saddr : word;             { Адрес старта }
               count : word;             { Счетчик загрузки }
               p525  : byte;             { 0 - 5"}
               mfm   : byte;             { 1 = MFM }
               tpi   : byte;             { 1 = 96tpi }
               ifact : byte;             { 1 = no factor }
               ssize : byte;             { 3 = 1024 bps }
               fside : byte;             { 1 = double }
               spt   : byte;             { 5 }
               tcount: word;             { 81 }
               lspt  : word;             { 40 }
               lp1   : word;             { 4 }
               lp2   : byte;             { 15 }
               lp3   : byte;             { 0 }
               dsize : word;             { blocks - 1 }
               root  : word;             { 127 }
               al0   : byte;             { 192 }
               al1   : byte;             { 0 }
               lp4   : word;             { 32 }
        systrk: word;             { }
               crc   : byte;
            end;

            ptrec = record
                     ext : string[3];
                     cmd : pathstr;
                     key : string[6];
                    end;
            extarray = array[1..10] of ptrec;

const fname:pathstr='MST.MST';
      viewer:pathstr='';
      editor:pathstr='';
      workdir:pathstr='';
      disk   : byte = 0;
      user   : byte = 0;
      koi7   : byte = 2;
      pathc   : string[68] = '';
      entry_vec : word = 128;
      entry_ibm : word = 500;
      deco_71:string[32]='юабцдефгхийклмнопярстужвьызшэщчъ';
      deco_72:string[32]='ЮАБЦДЕФГХИЙКЛМHОПЯРСТУЖВЬЫЗШЭЩЧЪ';
      deco_73:string[32]='░▒▓│┤╡╢╖╕╣║╗╝╜╛┐└┴┬├─┼╞╟╚╔╩╦╠═╬╧';
      deco_74:string[32]='╨╤╥╙╘╒╓╫╪┘┌█▄▌▐▀ЁёЄєЇїЎў°∙·√№¤■╚';
      block_vec : word = 390;            { Число блоков диска Вектор }
      version: longint=950503;
      frec : formrec = (ssize:3;gap1:0;gap2:0;scount:5;tcount:82;side:0;
                        track:0;interl:2);
      emulstr:pathstr='';
      sortmode : byte = 2;
      dpb : _dpb = (
               laddr : 0;             { Адрес загрузки }
               saddr : 0;             { Адрес старта }
               count : 0;             { Счетчик загрузки }
               p525  : 0;             { 0 - 5"}
               mfm   : 1;             { 1 = MFM }
               tpi   : 1;             { 1 = 96tpi }
               ifact : 1;             { 1 = no factor }
               ssize : 3;             { 3 = 1024 bps }
               fside : 1;             { 1 = double }
               spt   : 5;             { 5 }
               tcount: 81;             { 81 }
               lspt  : 40;             { 40 }
               lp1   : 4;             { 4 }
               lp2   : 15;             { 15 }
               lp3   : 0;             { 0 }
               dsize : 391;             { blocks - 1 }
               root  : 127;             { 127 }
               al0   : 192;             { 192 }
               al1   : 0;             { 0 }
               lp4   : 32;             { 32 }
               systrk: 8;             { }
               crc   : 0
            );
var f: file of buftype;
    fls:file of byte;
    name      : string[25];
    buf       : buftype;
    ior       : char;
    trk,sct   : byte;
    event,pos_: word;
    catalog   : array[0..127] of entry;
    block     : _pblock;
    fileptr   : word;
    dirrec    : _dirrec;
    fresult   : byte;
    f_io      : file;
    cat_ibm   : array[0..499] of _catrec;
    cat_vec   : array[0..255] of _catrec;
    files_ibm : word;
    files_vec : word;
    frm_vec   : array[0..512] of byte;
    free_vec  : word;
    confirm   : char;
    dirinfo   : searchrec;
    path      : string[68];
    _f3       : extarray; { Расширения для View }
    _f4       : extarray; { Расширения для Edit }
    _cr       : extarray; { Расширения для <Enter> }

{$I ch.pas }
procedure filemode; forward;
procedure setname; forward;
procedure hardware; forward;
function workname(name:pathstr):pathstr; forward;
function flush_vec:byte; forward;

function progress(mode:word; symbol:char;attr:byte):boolean;
var i,j:word;
begin
 progress:=true;
 if mode<10 then begin
  barwindow(10,10,70,17,15,2,2,1);
  textattr:=47;
  case mode of
   1: topwin(' Diskcopy - чтение диска ');
   2: topwin(' Diskcopy - запись диска ');
   3: topwin(' Форматирование ');
   4: begin topwin(' Форматирование ');
            j:=textattr; textattr:=attr;
            centrwin(3,'Запись системных зон');
            textattr:=j;
            exit;
      end;
  end;
  downwin(' <Пробел> - прервать операцию ');
  j:=textattr; textattr:=attr;
  for i:=0 to (frec.tcount shl 1)-1 do
  begin
   gotoxy((i mod 50)+15,(i div 50)+12);
   write(symbol);
  end;
  textattr:=j;
  gotoxy(1,1);
 end;
 if (mode>10) and (mode<20) then begin
  j:=textattr; textattr:=attr;
  gotoxy((frec.track mod 50)+15,(frec.track div 50)+12);
  write(symbol);
  textattr:=j;
  gotoxy(1,1);
  progress:=not (keypressed and (wreadkey=32));
 end;
end;

procedure save_cfg;
begin
  assign(f_io,workname('config.mst'));
  rewrite(f_io);
  lwrite(f_io,version,4);
  lwrite(f_io,pathc,sizeof(pathc));
  lwrite(f_io,fname,sizeof(fname));
  lwrite(f_io,viewer,sizeof(viewer));
  lwrite(f_io,editor,sizeof(editor));
  lwrite(f_io,disk,sizeof(disk));
  lwrite(f_io,koi7,sizeof(koi7));
  lwrite(f_io,systrk,sizeof(systrk));
  lwrite(f_io,block_vec,sizeof(block_vec));
  lwrite(f_io,frec,sizeof(frec));
  lwrite(f_io,emulstr,sizeof(emulstr));
  lwrite(f_io,sortmode,1);
  lwrite(f_io,_f3,sizeof(_f3));
  lwrite(f_io,_f4,sizeof(_f3));
  lwrite(f_io,_cr,sizeof(_f3));

  delay(500);
  close(f_io);
end;

procedure load_cfg;
var i:longint;
begin

  fillchar(_f3,sizeof(_f3),0);
  fillchar(_f4,sizeof(_f3),0);
  fillchar(_cr,sizeof(_f3),0);

  assign(f_io,workname('config.mst'));
{$I-}
  reset(f_io);
{$I+}
  if ioresult>0 then exit;
  lread(f_io,i,4);
  if i<080494  then begin simple_error('Файл конфигурации старый.');
                           close(f_io); exit;
               end;
  if i >= 080494 then begin
  lread(f_io,pathc,sizeof(pathc));
  lread(f_io,fname,sizeof(fname));
  lread(f_io,viewer,sizeof(viewer));
  lread(f_io,editor,sizeof(editor));
  lread(f_io,disk,sizeof(disk));
  lread(f_io,koi7,sizeof(koi7));
  lread(f_io,systrk,sizeof(systrk));
  lread(f_io,block_vec,sizeof(block_vec));
  lread(f_io,frec,sizeof(frec));
  lread(f_io,emulstr,sizeof(emulstr));
  lread(f_io,sortmode,1);
  end;

  if i>=950503 then begin
  lread(f_io,_f3,sizeof(_f3));
  lread(f_io,_f4,sizeof(_f3));
  lread(f_io,_cr,sizeof(_f3));
  end;

  close(f_io);
end;

procedure edit_cfg;
var _pos,event : word;
    posio: byte;
    dirinfo:searchrec;
    path2:string;
begin
  doserror:=0;
  wsavescr;
  textattr:=$3f;
  createmenu(25,9,55,14,30,$4f,' Меню установок ');
  downwin(' <Up>, <Dw>, <Esc>, <Enter> ');
  wwrite(' Параметры файловых операций',30,$3f,$3f);
  wwrite(' Буфер DiskCopy',31,$3f,$3f);
  wwrite(' Аппаратура',32,$3f,$3f);
  wwrite(' Сохранение конфигурации',33,$3f,$3f);
  wcursoron(30);
  repeat
   wgetevent(event);
   if event=13 then begin
    wcursoroff;
    _pos:=wgetpos;
    case _pos of
     30: filemode;
     31: setname;
     32: hardware;
     33: save_cfg;
    end;
    wcursoron(_pos);
   end;
  until event=27;
  wcursoroff;
  wloadscr;
end;

procedure hardware;
var pos_,event : word;
    posio      : byte;
    i,musor    : word;
    ios        : pathstr;
begin
  doserror:=0;
  wsavescr;
  textattr:=$3f;
  createmenu(20,10,60,18,64,$4f,' Режимы аппаратуры ');
  downwin(' <Up>, <Dw>, <Esc>, <Пробел> ');
  wwrite(' Число системных дорожек',64,$3f,$3f);
  wwrite(' Размер диска в блоках',65,$3f,$3f);
  wwrite(' Размер блока в секторах',66,$38,$38);
  wwrite(' Размер сектора в байтах',67,$38,$38);
  wwrite(' Размер каталога в блоках',68,$38,$38);
  wwrite(' Hастройка параметров',69,$38,$38);
  wwrite(' Фактор смещения секторов',70,$3f,$3f);
  for pos_:=64 to 70 do
  begin
   inc(scrhdr[pos_,0],28);
   dec(scrhdr[pos_,2],28);
  end;
  wwrite('2',66,$38,$38);
  wwrite('1024',67,$38,$38);
  wwrite('2',68,$38,$38);
  wwrite('Ручная',69,$38,$38);
  wwrite('2',70,$3f,$3f);
  wcursoron(64);
   wwrite(_str(systrk,1),64,$3f,$3f);
   wwrite(_str(block_vec,3),65,$3f,$3f);
   wcursoron(64);
  repeat
   pos_:=wgetpos;
   posio:=1;
   case pos_ of
    64: begin
          str(systrk,ios);
          repeat
           wread(ios,64,$4f,$3f,false,event,posio);
           val(ios,i,musor);
          until (musor=0) and (i>=0) and (i<10) and ((i and 1)=0);
          systrk:=i;
        end;
    65: begin
         str(block_vec,ios);
         repeat
           wread(ios,65,$4f,$3f,false,event,posio);
           val(ios,i,musor);
  until (musor=0) and (i>=(76-(systrk shr 1))*5) and (i<(85-(systrk shr 1))*5);
         block_vec:=i;
        end;
    70: begin
         str(frec.interl,ios);
         repeat
           wread(ios,70,$4f,$3f,false,event,posio);
           val(ios,i,musor);
         until (musor=0) and (i>0) and (i<6);
         frec.interl:=i;
        end;

   end;
   wmovecursor(event);
  until event=27;
  wcursoroff;
  frec.tcount:=(systrk div 2+(block_vec div 5));
  if (block_vec mod 5)>0 then inc(frec.tcount);
  wloadscr;
end;

procedure help;
begin
 wsavescr;
 textattr:=63;
 barwindow(10,4,70,22,15,3,2,1);
 textattr:=63;
 downwin(' Выход - любая клавиша ');
 topwin(' FileMenu Help ');
 centrwin( 2,'Управляющие клавиши:');
 centrwin( 4,'<Tab> - смена панелей    Alt+D - оболочка MsDos     ');
 centrwin( 5,'<Ins> - отметка файла    Alt+O - оболочка CP/M 2.0  ');
 centrwin( 6,' F2   - выбор каталога   Alt+L - метка тома:        ');
 centrwin( 7,' F5   - копирование        <Esc>   - оставить старую');
 centrwin( 8,' F8   - удаление           <Enter> - установить     ');
 centrwin( 9,' F9   - парметры           Alt+D   - удалить        ');
 centrwin(10,' F10  - выход из режима  <Enter> - запуск .COM      ');
 centrwin(11,' ^R    - смена диска                                ');
 wreadkey;
 wloadscr;
end;

procedure about;
var ioc  :char;
begin
  wsavescr;
  barwindow(10,3,70,22,15,3,2,1);
  textattr:=63;
  downwin(' Выход - любая клавиша ');
  topwin(' About ');
  centrwin( 2,'Эта программа предназначена');
  centrwin( 3,'для работы с дисками ОС МикроДОС.');
  centrwin( 4, 'MicrodoS Transfer v2.0 beta s/n PC0213');
  centrwin( 5,'(c) Spase corp., 3812-655730.  All rights reserved.');
  centrwin( 6,'В текущую версию встроены:');
  centrwin( 7,'- копирование с перекодировкой КОИ7, КОИ8;  ');
  centrwin( 8,'- запуск программ ВЕКТОР-06ц через эмулятор;');
  centrwin( 9,'- запуск оболочки MsDos и CP/M v2.0;        ');
  centrwin(10,'- работа при отсутствии драйвера 800.COM;   ');
  centrwin(11,'- форматирование дисков.                    ');

  centrwin(12,'Для успешной работы рекомендуется иметь на текущем диске');
  centrwin(13,'программы-эмуляторы Вектор-06ц и системы CP/M.');
  centrwin(15,'Лицензией на программу обладает');
  centrwin(16,'Insert your Name and/or Trademark here.');
  wreadkey;
  wloadscr;
end;

procedure setname;
var event:word;
    posio:byte;
begin
 textattr:=63;
 wsavescr;
 createmenu(4,16,75,18,10,63,' Задание имени буфера ');
 downwin(' <Enter> ');
 wwrite(fname,10,63,63);
 posio:=1;
 repeat
  wread(fname,10,63,63,false,event,posio);
 until event in [13,27];
 wloadscr;
end;

procedure readdisk;
var flag : byte;
    errc : byte;
    e:char;
begin
 wsavescr;
 progress(1,'░',$3f);
 assign(f,fname);
 rewrite(f);
 for trk:=0 to 163 do begin
 frec.track:=trk;
 if not (progress(11,'R',$3f)) then begin wloadscr; close(f); exit end;
 for sct:=1 to 5 do
 begin
  rsect(sct,trk,buf,flag,errc);
  if (flag and 1)>0 then begin
    e:=error(sct,trk,errc);
    if e in [#27,'A'] then begin
     close(f);
     wloadscr;
     exit;
    end; { endif }
    if e='R' then dec(sct) else write (f,buf);
  end
  else write (f,buf);
 end;  { endfor }
 if not (progress(11,'▓',$3f)) then begin wloadscr; close(f); exit end;
 end;  { endfor }
 close(f);
 wloadscr;
end;

procedure writedisk;
var flag : byte;
    errc : byte;
    e:char;
begin
 repeat
  assign(f,fname);
{$I-}
  reset(f);
{$I+}
  errc:=ioresult;
  if errc>0 then begin
     wsavescr;
     barwindow(8,13,72,16,14,4,2,1);
     textattr:=78;
     centrwin(1,'Hе могу найти '+fname+'.');
     centrwin(2,'<Enter> - задать имя, <Esc> - отменить');
     if readkey=#27 then begin wloadscr; exit; end;
     setname;
     wloadscr;
  end;
 until errc=0;
 wsavescr;
 progress(2,'░',$3f);
 diskreset; flag:=0;
 for trk:=0 to 163 do begin
 frec.track:=trk;
 if not (progress(11,'W',$3f)) then begin wloadscr; close(f); exit end;
 for sct:=1 to 5 do
 begin
 if (filesize(f)-filepos(f))<1 then begin close(f); wloadscr;exit end;
  if (flag and 1)=0 then read(f,buf);
  wsect(sct,trk,buf,flag,errc);
  if (flag and 1)>0 then begin
   e:=error(sct,trk,errc);
   if e in ['A',#27] then begin close(f); wloadscr; exit end;
   if e='R' then dec(sct) else flag:=0
  end;
 if ioresult>0 then trk:=164;
 end;
 if not (progress(11,'▓',$3f)) then begin wloadscr; close(f); exit end;
 end;
 close(f);
 wloadscr;
end;

procedure formatdisk;
var c:char;
    errc:byte;
    flag:byte;
    i,j,k:word;
    badblock,mdos:boolean;
begin
 mdos:=false;
 fillchar(frm_vec,512,0);
 diskreset;
 wsavescr;
 barwindow(15,10,65,16,15,4,2,1);
 textattr:=$4f;
 topwin(' Format ');
 downwin(' <Esc> - Отменить форматирование ');
 centrwin(1,'Внимание! Вся информация будет разрушена!');
 textattr:=$4e;
 centrwin(2,'У В Е Р Е H (Y/N) ?');
 button(30,14,35,11,1,'Yes');
 button(45,14,50,11,1,' No');
 repeat
  c:=upcase(readkey);
 until c in [#27,'Y','N'];
 wloadscr;
 if c<>'Y' then exit;
 diskreset;
 wsavescr;
 progress(3,'░',$3f);
 for frec.track:=0 to (frec.tcount shl 1)-1 do begin
  c:=' ';
  if not(progress(13,'F',$3f)) then begin wloadscr; exit end;
  errc:=ftrk(frec);
  if errc>0 then begin
   c:=error(1,frec.track,errc);
   if c='A' then begin wloadscr; exit end;
   if c='R' then dec(frec.track);
  end;
  if c<>'R' then begin
   if not(progress(13,'V',$3f)) then begin wloadscr; exit end;
   badblock:=false;
   j:=0;
   for i:=1 to 5 do
   begin
    rsect(j+1,frec.track,buf,flag,errc);
    j:=(j+1) mod frec.scount;
    if ((flag and 1)>0) and (frec.track=0) and (i=1)
    then begin mdos:=true; simple_error('Диск пригоден только для МикроДОС!');
end;
    if ((flag and 1)>0) and (frec.track>=systrk)
    then begin
      k:=frec.track;
      k:=((k-systrk)*5+i-1) shr 1;
      frm_vec[k]:=1;
      if k<2 then begin
       simple_error('Сбойный блок в области каталога!');
       wloadscr;
       exit
      end;
    end;
    badblock:= badblock or ((flag and 1)>0) ;
   end;
   if badblock then progress(13,'B',$cf) else progress(13,'▓',$3f);
  end;
 end;
 wloadscr;
 wsavescr;
 progress(4,' ',$2f);
 fillchar(catalog,4096,$e5);
 i:=0;j:=0;
 for k:=0 to block_vec-1 do if frm_vec[k]=1 then begin
  fillchar(catalog[i shr 3].fat[i and 7],16-(i and 7) shl 1,0);
  catalog[i shr 3].fat[i and 7]:=k;
  catalog[i shr 3].user:=$20;
  catalog[i shr 3].exn:=i shr 3;
  inc(i);
  catalog[i shr 3].recs:=(i and 7) shl 4;
 end;
 flush_vec;
 if mdos then begin wloadscr; exit end;
 dpb.systrk:=systrk;
 dpb.dsize:=block_vec-1;
 dpb.tcount:=frec.tcount shr 1;
 dpb.crc:=$66;
 for i:=0 to 30 do inc (mem[seg(dpb):ofs(dpb)+31],mem[seg(dpb):ofs(dpb)+i]);
 fillchar(buf,1024,$e5);
 move(dpb,buf,32);
 wsect(1,0,buf,flag,errc);
 wloadscr;
end;


{  ----------------------------------------------------------------------  }
{                         Файловые    операции                             }
{  ----------------------------------------------------------------------  }

procedure name_compact(var name:pathstr);
{ Удаление пробелов из имени файла }
var i:word;
begin
 if length(name)=0 then exit;
 i:=1;
 while i<=length(name) do if name[i]=' ' then delete(name,i,1) else inc(i);
end;

procedure encode(var block: _pblock;name:dirstr);
var i,j   : word;
    f     : boolean;
    n     : extstr;
begin
 n:=copy(name,length(name)-2,3);
 f:= (koi7 in [1,3]) or ((koi7 in [2,4]) and  ((n='TXT') or (n='DOC')));
 for i:=0 to 2047 do
  case koi7 of
    0   : ;
   1,2  : if f then begin
           j:=pos(char(block^[i]),deco_71);
           if j>0 then block^[i]:=j+$bf else begin
            j:=pos(char(block^[i]),deco_72);
            if j>0 then block^[i]:=j+$df else
     if block^[i] in [$b0..$df] then dec(block^[i],$30) else
            if block^[i] in [$f0..$ff] then dec(block^[i],$40);
           end;
          end;
   3,4  : if f then begin
           j:=pos(char(block^[i]),deco_71);
           if j>0 then block^[i]:=j+$df else begin
            j:=pos(char(block^[i]),deco_72);
            if j>0 then block^[i]:=j+$5f else
     if block^[i] in [$50..$6f] then inc(block^[i],$80) else
            if block^[i] in [$80..$af] then block^[i]:=$2d else
            if block^[i] in [$f0..$ff] then dec(block^[i],$40)
            ;
           end;
          end;

  end;
end;

procedure decode(var block: _pblock;name:dirstr);
{ Перевод Вектор -> IBM }
var i     : word;
    f     : boolean;
    n     : extstr;
begin
 n:=copy(name,length(name)-2,3);
 f:= (koi7 in [1,3]) or ((koi7 in [2,4]) and  ((n='TXT') or (n='DOC')));
 for i:=0 to 2047 do
  case koi7 of
    0   : ;
    1,2 : if f then case block^[i] of
            $c0..$df: block^[i]:=ord(deco_71[block^[i]-$bf]);
            $e0..$ff: block^[i]:=ord(deco_72[block^[i]-$df]);
            $80..$af: inc(block^[i],$30);
            $b0..$bf: inc(block^[i],$40);
          end;
    3,4 : if f then case block^[i] of
            $60..$7f: block^[i]:=ord(deco_72[block^[i]-$5f]);
            $c0..$df: dec(block^[i],$80);
            $e0..$ff: block^[i]:=ord(deco_71[block^[i]-$df]);
     $80..$af: block^[i]:=$2d;
            $b0..$bf: inc(block^[i],$40);
          end;
  end;
end;

function ge_sort(n1,n2:_catrec):boolean;
var i:word;
begin
 ge_sort:=false;
 case sortmode of
 0: exit;
 1: begin
           for i:=1 to 12 do begin
            if n1.nam[i]>n2.nam[i] then begin
             ge_sort:=true;
             exit
            end;
            if n1.nam[i]<n2.nam[i] then exit;
           end;
    end;
 2: begin
           for i:=10 to 12 do begin
            if n1.nam[i]>n2.nam[i] then begin
             ge_sort:=true;
             exit
            end;
            if n1.nam[i]<n2.nam[i] then exit;
           end;
    for i:=1 to 8 do begin
            if n1.nam[i]>n2.nam[i] then begin
             ge_sort:=true;
             exit
            end;
            if n1.nam[i]<n2.nam[i] then exit;
           end;
    end;
 end;
end;

procedure sortdir(var cat:array of _catrec;size:word);
var i,j,k,b:word;
    tmp: _catrec;
begin
 if size<2 then exit;
 b:=0;

 while (b<size) and (cat[b].nam[2]=':') and (length(cat[b].nam)=2)
 do inc(b);

 for i:=b to (size-2) do
 begin
  k:=i;
  for j:=i+1 to (size-1) do if ge_sort(cat[k],cat[j]) then k:=j;
  tmp:=cat[i];
  cat[i]:=cat[k];
  cat[k]:=tmp;
 end;
end;

function compare_name(name,mask:string):boolean;
var i:byte;
begin
 compare_name:=true;
 i:=1;
 repeat
  if (not (mask[i] in ['*','?'])) and (chr(ord(name[i]) and $7f)<>mask[i]) then
compare_name:=false;
  inc(i);
 until (i=9) or (mask[i-1]='*');
 i:=10;
 repeat
  if (not (mask[i] in ['*','?'])) and (chr(ord(name[i]) and $7f)<>mask[i]) then
compare_name:=false;
  inc(i);
 until (i=13) or (mask[i-1]='*');
end;

procedure f_upcase(var io:string);
var i:word;
begin
 for i:=1 to length(io) do begin
   io[i]:=chr(ord(io[i]) and $7f);
   io[i]:=upcase(io[i]);
 end;
end;

procedure format_name(var name:string);
var n:namestr;
    d:dirstr;
    e:extstr;
begin
 if name='..' then begin name:='..      .   '; exit end;
 f_upcase(name);
 fsplit(name,d,n,e);
 if e='' then e:='.';
 while length(n)<8 do n:=n+' ';
 while length(e)<4 do e:=e+' ';
 name:=n+e;
end;

function pathname(name:pathstr):pathstr;
begin
 name_compact(name);
 if path='' then pathname:=name else pathname:=path+'\'+name;
end;

function workname;
begin
 if workdir='' then workname:=name else workname:=workdir+'\'+name;
end;

procedure filemode;
var pos_,event : word;
    posio: byte;
    dirinfo:searchrec;
    path2:string;
begin
  doserror:=0;
  wsavescr;
  textattr:=$3f;
  createmenu(3,7,77,16,21,$4f,' Режимы файловых операций ');
  downwin(' <Up>, <Dw>, <Esc>, <Пробел> ');
  wwrite(' Режим декодера',21,$3f,$3f);
  wwrite(' Режим сортировки',22,$3f,$3f);
  wwrite(' Путь для IBM файлов',23,$3f,$3f);
  wwrite(' Editor',24,$3f,$3f);
  wwrite(' Viewer',25,$3f,$3f);
  wwrite(' Опции эмулятора',26,$3f,$3f);
  wwrite(' Viewers...',27,$38,$38);
  wwrite(' Extensions...',28,$38,$38);

  for pos_:=21 to 26 do
  begin
   inc(scrhdr[pos_,0],22);
   dec(scrhdr[pos_,2],22);
  end;
  wwrite('Hесортирован',22,$38,$38);
  wwrite(pathc,23,$3f,$3f);
  wwrite(editor,24,$3f,$3f);
  wwrite(viewer,25,$3f,$3f);
  wwrite(emulstr,26,$3f,$3f);
  wcursoron(21);
  repeat
   pos_:=wgetpos; wcursoroff;
   case koi7 of
    0: wwrite('Выключен',21,$3f,$3f);
    1: wwrite('Включен КОИ8 для всех',21,$3f,$3f);
    2: wwrite('Включен КОИ8 для .DOC и .TXT',21,$3f,$3f);
    3: wwrite('Включен КОИ7 для всех',21,$3f,$3f);
    4: wwrite('Включен КОИ7 для .DOC и .TXT',21,$3f,$3f);
    5: wwrite('Включен Внешний для всех',21,$3f,$3f);
    6: wwrite('Включен Внешний для .DOC и .TXT',21,$3f,$3f);
   end;
   case sortmode of
    0:  wwrite('Hесортирован',22,$3f,$3f);
    1:  wwrite('По имени',22,$3f,$3f);
    2:  wwrite('По расширению',22,$3f,$3f);
   end;
   wcursoron(pos_);
   case pos_ of
    21: begin
   event:=wreadkey;
   if event=32 then koi7:=(koi7+1) mod 5;
 end;
    22: begin
   event:=wreadkey;
   if event=32 then sortmode:=(sortmode+1) mod 3;
        end;
    23: repeat
         path2:=pathc;
         wread(pathc,23,$4f,$3f,false,event,posio);
         if event=13 then event:=1080;
         if path2<>pathc then findfirst(pathname('*.*'),anyfile,dirinfo);
         if doserror=3 then simple_error('Путь не найден');
        until doserror=0;
    24: repeat
         wread(editor,24,$4f,$3f,false,event,posio);
         if event=13 then event:=1080;
 until (event=27) or (event=1080) or (event=1072);
    25: repeat
         wread(viewer,25,$4f,$3f,false,event,posio);
         if event=13 then event:=1080;
        until (event=27) or (event=1080) or (event=1072);
    26: repeat
         wread(emulstr,26,$4f,$3f,false,event,posio);
         if event=13 then event:=1080;
 until (event=27) or (event=1080) or (event=1072);
   end;
   posio:=1;
   wmovecursor(event);
  until event=27;
  wcursoroff;
  wloadscr;
end;

function convert_from(n:word):string;
var i1,i2:string[14];
    i:word;
begin
 i1[0]:=#8; i2[0]:=#3;
 move(catalog[n].name,i1[1],8);
 move(catalog[n].ext,i2[1],8);
 i1:=i1+'.'+i2; f_upcase(i1);
 convert_from:=i1;
end;

procedure rebuild_vec;
var i,j:byte;
begin
 for i:=0 to 127 do { Удаление символов '/', '\', '+' }
 begin
  for j:=0 to 7 do if catalog[i].name[j] in ['/','\','+'] then
                      catalog[i].name[j]:='@';
  for j:=0 to 3 do if catalog[i].ext[j] in ['/','\','+'] then
                      catalog[i].ext[j]:='@';
 end;

 j:=0; files_vec:=0;
 fillchar(frm_vec,512,0);
 frm_vec[0]:=1; frm_vec[1]:=1; free_vec:=block_vec-2;
 for i:=0 to (entry_vec-1) do
 begin
  if (catalog[i].user<>$e5) then begin
    for j:=0 to 7 do
    begin
     if (catalog[i].fat[j]<block_vec) and (catalog[i].fat[j]>1)
     then begin
      frm_vec[catalog[i].fat[j]]:=1;
      dec(free_vec);
     end;
    end;
    if (catalog[i].recs<>$80) and (catalog[i].user=user) then begin
     cat_vec[files_vec].nam:=convert_from(i);
     cat_vec[files_vec].size:=(128*catalog[i].exn)+catalog[i].recs;
     cat_vec[files_vec].mark:=false;
     cat_vec[files_vec].aux:=0;
     inc(files_vec);
    end;
  end;
 end;
 sortdir(cat_vec,files_vec);
end;

function initfile:byte;
var flag,errc : byte;
    i,j       : byte;
    block     : _pblock;
begin
 diskreset;
 getmem(block,2048);
 if not (rblk(block,0) in [0,6]) then begin freemem(block,2048);
                                            initfile:=1; exit end;
 move(block^,catalog[0],2048);
 initfile:=rblk(block,1);
 move(block^,catalog[64],2048);
 freemem(block,2048);
 rebuild_vec;
end;

function flush_vec;
var flag,errc : byte;
    i,j       : byte;
    block     : _pblock;
begin
 if fresult=1 then exit;
 diskreset;
 getmem(block,2048);
 move(catalog[0],block^,2048);
 if not (wblk(block,0) in [0,6]) then begin fresult:=1; flush_vec:=1;
                                            freemem(block,2048);exit end;
 move(catalog[64],block^,2048);
 fresult:=wblk(block,1);
 if not (fresult in [0,6]) then fresult:=1;
 flush_vec:=fresult;
 freemem(block,2048);
end;

function find(mask:string;var fileptr:word;extent:byte):string;
begin
 find:='';
 while (fileptr<128)  do
 begin
  if (catalog[fileptr].user=user) and
     ((catalog[fileptr].exn=extent) or (extent=255)) and
     compare_name(convert_from(fileptr),mask)
  then begin
   find:=convert_from(fileptr);
   exit
  end;
  inc(fileptr);
 end;
end;

procedure f_delete(name:pathstr);
var i: word;
    c: char;
    title:pathstr;
begin
 if fresult=1 then exit;
 wsavescr;
 title:=name; name_compact(title);
 if confirm<>'A' then begin
   barwindow(15,10,65,16,15,4,2,1);
   textattr:=$4f;
   topwin(' Delete ');
   downwin(' <Esc> - Отменить удаление ');
   centrwin(1,'Удаление файлов на диске МикроДОС; УВЕРЕH?');
   textattr:=$4e;
   centrwin(2,title);
   button(22,14,27,11,1,'Yes');
   button(32,14,37,11,1,' No');
   button(42,14,47,11,1,'All');
   button(52,14,58,11,1,'Quit');
   repeat
    c:=upcase(readkey);
    while c=#0 do begin readkey; c:=upcase(readkey); end;
   until c in ['A','Q','Y','N',#27];
   if c in ['A','Q',#27] then confirm:=c;
   if c in ['Q','N',#27] then  begin wloadscr; exit end;
 end;
 i:=0;
 find(name,i,255);
 while i<128 do begin
  catalog[i].user:=$e5;
  find(name,i,255);
 end;
 wloadscr;
end;

procedure ms_delete(name,title:pathstr);
var i: word;
    c: char;
begin
 if fresult=1 then exit;
 wsavescr;
 name_compact(title);
 if confirm<>'A' then begin
   barwindow(15,10,65,16,15,4,2,1);
   textattr:=$4f;
   topwin(' Delete ');
   downwin(' <Esc> - Отменить удаление ');
   centrwin(1,'Удаление файлов на диске Ms-Dos; УВЕРЕH?');
   textattr:=$4e;
   centrwin(2,title);
   button(22,14,27,11,1,'Yes');
   button(32,14,37,11,1,' No');
   button(42,14,47,11,1,'All');
   button(52,14,58,11,1,'Quit');
   repeat
    c:=upcase(readkey);
    while c=#0 do begin readkey; c:=upcase(readkey); end;
   until c in ['A','Q','Y','N',#27];
   if c in ['A','Q',#27] then confirm:=c;
   if c in ['Q','N',#27] then  begin wloadscr; exit end;
 end;
 lerase(name);
 wloadscr;
end;

procedure create_extent;
var i: word;
begin with dirrec do begin
  while (catalog[ctn].user<>$e5) and (ctn<128) do inc(ctn);
  if ctn=128
  then begin
   fresult:=2; exit
  end;
  catalog[ctn].user:=user;
  for i:=0 to 7 do catalog[ctn].name[i]:=nam[i+1];
  for i:=0 to 2 do catalog[ctn].ext[i]:=nam[i+10];
  catalog[ctn].exn:=exn;
  catalog[ctn].recs:=0;
  catalog[ctn].re0:=0;
  fillchar(catalog[ctn].fat,16,0);
  rcp:=0;
  inc(exn);
end end;

procedure f_create(name:string);
var i:byte;
begin with dirrec do begin
 f_delete(name);
 rebuild_vec;
 nam:=name;
 exn:=0;
 ctn:=0;
 rcp:=0;
 rcn:=2;
 create_extent;
end end;

procedure f_write(var block:_pblock; n:byte);
var i: word;
begin
  if (fresult=1) or (n=0) then exit;
  with dirrec do begin
  fresult:=0;
  if catalog[ctn].fat[rcp]=0 then  begin { Hовая запись }
    while (rcn<block_vec) and (frm_vec[rcn]<>0) do inc(rcn);
    if rcn=block_vec then begin fresult:=3; exit end;
    dec(free_vec);
  end
  else rcn:=catalog[ctn].fat[rcp]
  ;
  frm_vec[rcn]:=1;
  if not (wblk(block,rcn) in [0,6]) then fresult:=1;
  catalog[ctn].fat[rcp]:=rcn;
  inc(rcp); inc(catalog[ctn].recs,n);
  if (rcp=8) and (catalog[ctn].recs=128)
  then
  create_extent;
end end;

procedure f_open(name:string);
begin with dirrec do begin
 fresult:=1;
 nam:=name;
 exn:=0;
 ctn:=0;
 rcp:=0;
 rcn:=0;
 find(name,dirrec.ctn,dirrec.exn);
 if ctn=128 then exit;
 fresult:=0;
 rcs:=catalog[dirrec.ctn].recs;
end end;

procedure f_read(var block:_pblock);
begin
 fresult:=1;
 if catalog[dirrec.ctn].fat[dirrec.rcp]=0 then exit;
 if dirrec.rcp=8 then with dirrec do begin
   inc(exn);
   ctn:=0;
   find(dirrec.nam,dirrec.ctn,dirrec.exn);
   if DIRREC.ctn=128 then exit;
   rcp:=0;
   rcs:=catalog[ctn].recs;
 end;
 if not (rblk(block,catalog[dirrec.ctn].fat[dirrec.rcp]) in [0,6])
 then exit;
 fresult:=0;
 inc(dirrec.rcp);
 if dirrec.rcs>=16 then begin dirrec.ok:=(16*128); dec(dirrec.rcs,16) end
                   else begin dirrec.ok:=(dirrec.rcs*128); dirrec.rcs:=0 end
 ;
end;

function initibm:byte;
var dirinfo : searchrec;
    name    : string[80];
begin
  name:=pathname('*.*');
  files_ibm:=0;
  findfirst(name,archive,dirinfo);
  while (doserror=0) and (files_ibm<entry_ibm) do
  begin
    format_name(dirinfo.name);
    cat_ibm[files_ibm].nam:=dirinfo.name;
    cat_ibm[files_ibm].mark:=false;
    cat_ibm[files_ibm].size:=dirinfo.size shr 7;
    cat_ibm[files_ibm].aux :=dirinfo.size and 127;

    inc(files_ibm);
    findnext(dirinfo);
  end;
  initibm:=doserror;
  sortdir(cat_ibm,files_ibm);
end;

function copy_vi(ns,nd:pathstr;size:longint):byte;
var block: _pblock;
    progress:string[20];
    count   : longint;
begin
 copy_vi:=0;
 fresult:=0;
 count:=0;
 f_open(ns);
 assign(f_io,nd);
 rewrite(f_io);
 getmem(block,2048);
 wsavescr;
 barwindow(10,10,70,14,15,2,2,1);
 textattr:=47;
 topwin(' Copy ');
 centrwin(1,'Копирование файлов МикроДос -> IBM');
 centrwin(2,ns);
 progress:='░░░░░░░░░░░░░░░░░░░░';
 textattr:=47; gotoxy(30,13); write(progress);
 REPEAT
  dirrec.ok:=0;
  f_read(block);  decode(block,ns);
  if (fresult=0) and (dirrec.ok>0) then lwrite(f_io,block^,dirrec.ok);
  progress:='░░░░░░░░░░░░░░░░░░░░';
  inc(count,dirrec.ok);
  fillchar(progress[1],round(20*(count/(size+1))),'▓');
  textattr:=47; gotoxy(30,13); write(progress);
 until fresult=1;
 close(f_io);
 wloadscr;
 freemem(block,2048);
end;

function copy_iv(ns,nd:pathstr;size:longint):byte;
var block: _pblock;
    i:word;
    progress:string[20];
    count   : longint;
begin
 confirm:='A';
 copy_iv:=0;
 count:=size;
 f_create(nd);
 assign(f_io,ns);
 reset(f_io);
 getmem(block,2048);
 wsavescr;
 barwindow(10,10,70,14,15,2,2,1);
 textattr:=47;
 topwin(' Copy ');
 centrwin(1,'Копирование файлов IBM  ->  МикроДОС');
 centrwin(2,nd);
 progress:='░░░░░░░░░░░░░░░░░░░░';
 textattr:=47; gotoxy(30,13); write(progress);
 REPEAT
  fillchar(block^,2048,$1a);
  progress:='░░░░░░░░░░░░░░░░░░░░';
  if size>=2048 then lread(f_io,block^,2048) else lread(f_io,block^,size);
  encode(block,nd);
  i:=size shr 7;
  if (size and 127)>0 then inc(i);
  if size>=2048 then f_write(block,16) else f_write(block,i);
  if size>2048 then dec(size,2048) else if fresult=0 then fresult:=10;
  fillchar(progress[1],round(20*(count-size)/count),'▓');
  textattr:=47; gotoxy(30,13); write(progress);
 until fresult>0;
 if fresult=10 then fresult:=0;
 close(f_io);
 wloadscr;
 freemem(block,2048);
end;

(* {$I cmdline.pas} *)

procedure entry_cat(var cat:_catrec; posit:byte);
var ios : string[30];
    ll  : longint;
begin
     ll:=cat.size; ll:=ll*128+cat.aux;
     ios:=cat.nam+_str(ll,10);
     if cat.mark then wwrite(ios,posit,$1e,$1e)
                 else wwrite(ios,posit,$1b,$1b)
     ;
end;

function scroll_cat(var cat:array of _catrec;
                    var first,files:word;menu_top:byte;var posit:byte;
                    var mark:byte):word;
label start;
var i,j : word;
    ios : string[25];
{ Local }
procedure up;
begin
 if (wgetpos=menu_top) and (first>0) then begin
    wcursoroff;
    wscroll(1,1,$1b,scrhdr[menu_top,0], scrhdr[menu_top,1],
      scrhdr[menu_top,0]+scrhdr[menu_top,2]-1,
                    scrhdr[menu_top+15,1]);
    dec(first);
    entry_cat(cat[first],menu_top);
    wcursoron(menu_top);
  end;
end;

{ Local }
procedure dw;
begin
 if (wgetpos=menu_top+15) and (posit<(files-1)) then begin
     wcursoroff;
     wscroll(0,1,$1b,scrhdr[menu_top,0], scrhdr[menu_top,1],
                     scrhdr[menu_top,0]+scrhdr[menu_top,2]-1,
                     scrhdr[menu_top+15,1]);
    inc(first);
    entry_cat(cat[posit+1],menu_top+15);
 end
 else if (posit=(files-1)) or (files=0) then i:=1 else i:=1080;
end;

begin
start:
  fresult:=0;
  for i:=0 to 15 do
  begin
    if cat[first+i].mark then scrhdr[menu_top+i,3]:=$3e
                         else scrhdr[menu_top+i,3]:=$30
   ;
   if (i+first)<files
   then entry_cat(cat[i+first],i+menu_top)
   else wwrite(' ',i+menu_top,$1b,$1b);
  end;
  if posit=255 then begin posit:=0; exit; end;
  wcursoron((posit-first)+menu_top);
  repeat
   posit:=(wgetpos-menu_top)+first;
   gotoxy(1,1);
   i:=wreadkey;
   scroll_cat:=i;
   case i of
    1073: begin { PgUp }
            wcursoroff;
            if (first>=16)
            then begin
               dec(first,16);
               dec(posit,16);
            end
            else begin
      first:=0;
      if posit<16 then posit:=0 else posit:=15;
            end
            ;
            goto start;
          end;
    1081: begin {PgDw }
           wcursoroff;
    if (files-posit)>=16
    then begin
     inc(first,16);
     inc(posit,16);
    end
    else begin
     posit:=(files-1);
     if (files-first)>16 then inc(first,16);
    end
    ;
    goto start;
   end;

    9,1060..1068,
    27,13,1032,
    1024,$12,1038: begin wcursoroff; exit end;
    1059         : help;
    1082,32      : begin
       cat[posit].mark:=not cat[posit].mark;
       if cat[posit].mark then inc(mark) else dec(mark);
       entry_cat(cat[posit],wgetpos);
       Dw;
     end;
    1072         : Up; { Up }
    1080         : Dw;
   end;
   for j:=0 to 15 do
    if cat[first+j].mark then scrhdr[menu_top+j,3]:=$3e
    else scrhdr[menu_top+j,3]:=$30
   ;

   wmovecursor(i);
  until false;
end;

{$I vdir.pas}

procedure msdos_shell;
begin
   wsavescr;
   textattr:=7; clrscr;
   textattr:=15;
   writeln('Для возврата в MST используйте команду EXIT.');
  mem[memw[0:$7a]:memw[0:$78]+3]:=2;
  mem[memw[0:$7a]:memw[0:$78]+4]:=9;
  mem[memw[0:$7a]:memw[0:$78]+8]:=$f6;
   swapvectors;
   exec(getenv('comspec'),'');
   swapvectors;
  mem[memw[0:$7a]:memw[0:$78]+3]:=3;
  mem[memw[0:$7a]:memw[0:$78]+4]:=5;
  mem[memw[0:$7a]:memw[0:$78]+8]:=$e5;
   wloadscr;
   if doserror>0 then simple_error('Ошибка при запуске COMMAND.COM');
end;

procedure cpm_shell;
begin
   wsavescr;
   textattr:=7; clrscr;
   textattr:=15;
   writeln('Для возврата в MST используйте команду DOS.');
   swapvectors;
   exec(workname('80cpm.exe'),'');
   swapvectors;
   wloadscr;
   case doserror of
    0: ;
    2,3 : simple_error('Hе найден файл 80cpm.exe');
    8: simple_error('Hедостаточно памяти');
    else simple_error('Ошибка при запуске CP/M - эмулятора');
   end;
end;

procedure view_file(name:pathstr);
begin
  wsavescr;
  name_compact(name);
  swapvectors;
  exec(viewer,name);
  swapvectors;
  wloadscr;
  case doserror of
   0: ;
   2,3: simple_error('Hе найдена программа просмотра');
   8  : simple_error('Hедостаточно памяти');
   else simple_error('Ошибка при просмотре');
  end;
end;

procedure edit_file(name:pathstr);
begin
  wsavescr;
  name_compact(name);
  swapvectors;
  exec(editor,name);
  swapvectors;
  wloadscr;
  case doserror of
   0: ;
   2,3: simple_error('Hе найден редактор');
   8  : simple_error('Hедостаточно памяти');
   else simple_error('Ошибка при редактировании');
  end;
end;

procedure exevec(name:pathstr);
begin
  wsavescr;
  name_compact(name);
  swapvectors;
  asm
   mov cx,13
   mov ah,5
   int 16h
  end;
  name_compact(name);
  exec(workname('vector.exe'),(emulstr+' '+pathname(name)));
  swapvectors;
  wloadscr;
  if doserror>0 then readkey;
  case doserror of
   0: ;
   2,3: simple_error('Hе найден эмулятор "Вектор-06ц"');
   8  : simple_error('Hедостаточно памяти');
   else simple_error('Ошибка при запуске');
  end;
end;
procedure paint_line;
var i:word;
begin
  i:=3840;
  while i<4000 do begin
   if (mem[$b800:i] in [$30..$39,$46]) then mem[$b800:i+1]:=$74;
   inc(i,2);
  end;
end;

procedure vollabel;
var i:word;
    event:word;
    posio:byte;
    ios:pathstr;
begin
    inc(user,16); i:=0;
    ios:=find('*       .*',i,255);
    delete(ios,9,1);
    scrhdr[40,0]:=10;
    scrhdr[40,1]:=1;
    scrhdr[40,2]:=12;
    posio:=1;
    repeat
     wread(ios,40,$3f,$3f,false,event,posio);
    until (event=27) or (event=13) or (event=1032);
    dec(user,16);
    if event=27 then exit;
    inc(user,16);
    confirm:='A';
    while length(ios)<11 do ios:=ios+' ';
    f_delete('*       .*');
    insert('.',ios,9);
    for i:=1 to 12 do ios[i]:=upcase(ios[i]);
    if event=13 then f_create(ios);
    dec(user,16);
    flush_vec;
    rebuild_vec;
end;

procedure sel_user;
var i,j:word;
    user0:word;
    ios: string[16];
    pt : array[0..15] of byte;
begin
 wsavescr;
  textattr:=$3f;
  createmenu( 26,3,54,20,100,$7E,' Выбор пользователя ');
  downwin(' Up,Dw, <Esc>, <Enter> ');
  user0:=user;
  for i:=0 to 15 do
  begin
   user:=i; j:=0; ios:=find('*       .*',j,255);
   pt[i]:=$3e;
   if ios='' then begin
    pt[i]:=$3f; scrhdr[100+i,3]:=$70;
   end;
   user:=16+i;j:=0;
   ios:=find('*       .*',j,255);
   delete(ios,9,1);
   if ios='' then ios:='<User '+_str(i,2)+'>';
   wwrite(ios,100+i,pt[i],pt[i]);
  end;
  wcursoron(100+user0);
  repeat wgetevent(i) until (i=13) or (i=27);
  wcursoroff;
  if i=13 then user:=wgetpos-100 else user:=user0;
 wloadscr;
end;

procedure filemenu;
label 1,2,3,4,5,6;
var i,j       : word;
    il,jl     : longint;
    ios       : string[14];
    first_vec : word; { Hомер первого элемента в меню МикроДос }
    first_ibm : word;
    pos_vec   : byte; { Текущая позиция в меню МикроДос }
    pos_ibm   : byte;
    mark_vec  : byte; { Число отмеченных файлов }
    mark_ibm  : byte;
    sum_vec   : word; { Общий размер отмеченных файлов }
    sum_ibm   : word;
    block     : _pblock;
    current   : byte;
begin
  wsavescr;
  current:=0;
  getmem(block,2048);
  desktop(15,1,'░');
  ml2(0,7,'F1 Help  F2 Dir  F3 View  F4 Edit  F5 Copy  F6 Ren  F8 Del  F9 Menu F10 Exit');
  paint_line;
  textattr:=$1B;
  createmenu( 6,3,34,20,64,$30,' Диск МикроДос ');
  Downwin(' Up, Dw, <Tab>, <Esc> ');
  createmenu(46,3,74,20,80,$30,' Диск Ms - Dos ');
  Downwin(' Up, Dw, <Tab>, <Esc> ');
  scrhdr[64,4]:=64; scrhdr[80,4]:=80;
  scrhdr[79,5]:=79; scrhdr[95,5]:=95;
2:
  textattr:=$f0; gotoxy(1,1);
  write('Ждите, идет перезагрузка каталогов.                       ');
  if not (initfile in [0,6]) then goto 1;
  { Инициализация каталога IBM }
3:initibm;
  rebuild_vec;
  first_vec:=0; pos_vec:=255; first_ibm:=0; pos_ibm:=255;
  mark_vec:=0; mark_ibm:=0;
  scroll_cat(cat_vec,first_vec,files_vec,64,pos_vec,mark_vec);
  scroll_cat(cat_ibm,first_ibm,files_ibm,80,pos_ibm,mark_ibm);
6:  textattr:=$70;gotoxy(1,1);
    write(' Диск ',user,':');
    if user<9 then write(' ');
    inc(user,16); i:=0;
    ios:=find('*       .*',i,255);
    if ios='' then ios:='Безымянный ' else delete(ios,9,1);
    dec(user,16);
    write(ios,'   Файлов:',files_vec:4,', свободно ',(free_vec*2):4,'K ');
    confirm:=' ';
  if current=1 then goto 4;
  if current=2 then goto 5;

  repeat
4: repeat
    current:=1;
    confirm:=' ';
    i:=scroll_cat(cat_vec,first_vec,files_vec,64,pos_vec,mark_vec);
   { MicroDos Command Execution Part }
   if i=9 then goto 5;
   if i=$12 then goto 2;
   if i=1032 then msdos_shell;
   if i=1024 then cpm_shell;
   if (i=27) or (i=1068) then goto 1;

   if i=1067 { F9 } then begin filemode; goto 3; end;
   if i=1060 { F2 } then begin sel_user; goto 3; end;

   if i=1064 { F6 }
   then begin
    simple_error('Операция еще не реализована.');
    goto 6
   end;

   if diskchange then goto 2;

   if i=1038 then begin vollabel; goto 6 end;
   if i=1061 { F3 }
   then begin
     il:=cat_vec[pos_vec].size; il:=il*128;
     copy_vi(cat_vec[pos_vec].nam,fname,il);
     view_file(fname);
     lerase(fname);
   end;
   if i=1062 { F4 }
   then begin
     il:=cat_vec[pos_vec].size; il:=il*128;
     copy_vi(cat_vec[pos_vec].nam,fname,il);
     fresult:=0;
     edit_file(fname);
     assign(fls,fname); reset(fls); il:=filesize(fls); close(fls);
     jl:=free_vec; jl:=jl*16+cat_vec[pos_vec].size;
     jl:=jl*128;
     if il>jl then simple_error('Hедостаточно места на диске для '+cat_vec[pos_vec].nam)
     else begin
      copy_iv(fname,cat_vec[pos_vec].nam,il);
      if fresult=2
      then simple_error('Hедостаточно места в каталоге для '+cat_vec[pos_vec].nam)
      else lerase(fname);
     end;
     flush_vec;
     goto 3;
   end;

   if (i=13) and compare_name(cat_vec[pos_vec].nam,'*       .COM') then begin
     i:=koi7; koi7:=0;
     il:=cat_vec[pos_vec].size; il:=il*128;
     copy_vi(cat_vec[pos_vec].nam,pathname('tmp.com'),il);
     mem[0:$440]:=1;
     koi7:=i; i:=13;
     exevec('tmp.com');
     lerase(pathname('tmp.com'));
     while keypressed do readkey;
   end; { EndIf 13 }

   if i=1063 { F5 } then begin
    il:=cat_vec[pos_vec].size; il:=il*128;
    if mark_vec=0 then copy_vi(cat_vec[pos_vec].nam,
          pathname(cat_vec[pos_vec].nam),il)
    else begin
     j:=0;
     while j<files_vec do
     begin
       il:=cat_vec[j].size; il:=il*128;
       if cat_vec[j].mark then copy_vi(cat_vec[j].nam,
           pathname(cat_vec[j].nam),il);
       inc(j);
     end { EndWhile }
    end; { EndIf\\else }
    goto 3;
   end; { EndIf 1063 }

   if i=1066  { F8 }
   then begin
    if mark_vec=0 then f_delete(cat_vec[pos_vec].nam)
    else begin
     j:=0;
     while (j<files_vec) and not (confirm in ['Q',#27]) do
     begin
       if cat_vec[j].mark then f_delete(cat_vec[j].nam);
       inc(j);
     end { EndWhile }
    end; { EndIf\\else }
    rebuild_vec;
    if confirm<>#27 then flush_vec;
    goto 2;
   end;

   until false;

5:  repeat
    current:=2;
    i:=scroll_cat(cat_ibm,first_ibm,files_ibm,80,pos_ibm,mark_ibm);

    { IBM command execution part }

   if (i=13) and compare_name(cat_ibm[pos_ibm].nam,'*       .COM')
   then exevec(cat_ibm[pos_ibm].nam);

   if i=9 then goto 4;
   if i=1060 then begin tree; goto 3; end;
   if i=1061 then view_file(pathname(cat_ibm[pos_ibm].nam));
   if i=1062 then edit_file(pathname(cat_ibm[pos_ibm].nam));
   if i=$12 then goto 2;
   if i=1032 then msdos_shell;
   if i=1024 then cpm_shell;
   if (i=27) or (i=1068) then goto 1;

   if i=1067 then begin filemode; goto 3; end;

   if i=1064 { F6 }
   then begin
    simple_error('Операция еще не реализована.');
    goto 6
   end;

   if diskchange then goto 2;
   if i=1063 then begin
    if mark_ibm=0 then begin
     il:=cat_ibm[pos_ibm].size;
     il:=il*128;
     jl:=free_vec; jl:=jl*2048;
     if cat_ibm[pos_ibm].aux>0 then inc(il,cat_ibm[pos_ibm].aux);
     if il>jl then simple_error('Hедостаточно места на диске для '+cat_ibm[pos_ibm].nam)
       else copy_iv(pathname(cat_ibm[pos_ibm].nam),
      cat_ibm[pos_ibm].nam,il);
     if fresult=2
     then simple_error('Hедостаточно места в каталоге для '+cat_ibm[pos_ibm].nam);
    end
    else begin
     j:=0;
     while j<files_ibm do
     begin
       if cat_ibm[j].mark then begin
 il:=cat_ibm[j].size;
 il:=il*128; jl:=free_vec; jl:=jl*2048;
 if cat_ibm[j].aux>0 then inc(il,cat_ibm[j].aux);
 if il>jl then simple_error('Hедостаточно места на диске для if il>'+cat_ibm[j].nam)
   else copy_iv(pathname(cat_ibm[j].nam),
         cat_ibm[j].nam,il);
       end;
       if fresult=2
       then begin
 simple_error('Hедостаточно места в каталоге для '+cat_ibm[j].nam);
 j:=files_ibm;
       end;
       inc(j);
     end { EndWhile }
    end; { EndIf\\else }
    flush_vec;
    goto 2;
   end; { EndIf 1063 }

   if i=1066
   then begin
    if mark_ibm=0 then
ms_delete(pathname(cat_ibm[pos_ibm].nam),cat_ibm[pos_ibm].nam)
    else begin
     j:=0;
     while (j<files_ibm) and not (confirm in ['Q',#27]) do
     begin
       if cat_ibm[j].mark then
ms_delete(pathname(cat_ibm[j].nam),cat_ibm[j].nam);
       inc(j);
     end { EndWhile }
    end; { EndIf\\else }
    goto 2;
   end;  { EndIf 1066 }

   until false;
  until false;
1:  freemem(block,2048);
    wloadscr;
end;

BEGIN
  checkbreak:=false;
  _blinkon;

  workdir:=getenv('MST');
  findfirst(workname('*.*'),anyfile,dirinfo);
  if doserror=3 then workdir:='';
  load_cfg;
  if pathc<>'' then path:=pathc else getdir(0,path);
  if path[length(path)]='\' then delete(path, length(path),1);
  mem[memw[0:$7a]:memw[0:$78]+3]:=3;
  mem[memw[0:$7a]:memw[0:$78]+4]:=5;
  mem[memw[0:$7a]:memw[0:$78]+8]:=$e5;
  desktop(15,1,'░'); ml2(0,7,'F1 About');
  paint_line;
  textattr:=31;
  createmenu(22,10,58,18,0,79,' Основное меню ');
  downwin('═════════ Up,Dw,<Enter>,<Esc> ');
  wwrite(' Diskcopy - чтение всего диска',0,31,31);
  wwrite(' Diskcopy - запись всего диска',1,31,31);
  wwrite(' Форматирование диска',2,31,31);
  wwrite(' Задание имени буфера',3,31,31);
  wwrite(' Меню файловых операций',4,31,31);
  wwrite(' Установки',5,31,31);
  wwrite(' Выход из программы',6,31,31);
  barwindow(4,3,76,6,15,2,2,1);
  textattr:=47;
  centrwin(1,'Программа работы с дисками МикроДос версия 2.0 beta');
  centrwin(2,'(C) Copyright 1993-95 by Spase corp. All rights reserved.');
  wcursoron(0);
  repeat
   gotoxy(1,1);
   pos_:=wgetpos;
   case pos_ of
    0,1,2,3,4,5,6: event:=wreadkey;
   end;
   if event=1059 then about;
   if event=13 then begin
    wcursoroff;
{$I+}
    case pos_ of
      0: readdisk;
      1: writedisk;
      2: formatdisk;
      3: setname;
      4: filemenu;
      5: edit_cfg;
      6: event:=27;
    end;
    wcursoron(pos_);
    if event<>27 then event:=0;
   end
   else wmovecursor(event)
  ;
  until event=27;
  wcursoroff;
  textattr:=7;
  clrscr;
  mem[memw[0:$7a]:memw[0:$78]+3]:=2;
  mem[memw[0:$7a]:memw[0:$78]+4]:=9;
  mem[memw[0:$7a]:memw[0:$78]+8]:=$f6;
  writeln('If you found this program good or useful, please, contact:');
  writeln('Spase corp., Omsk, Phone (381-2) - 655730.',#10,#10);
END.
