unit dosdir;
interface
uses windos, dvcrt, dvwin, winprocs, wintypes,
     dosgeral, doscopia, dosmsg, wow16;

procedure trataSubDiretorio;

implementation

var
    vetDir: array [1..30] of integer;
    nivelDir: integer;

{--------------------------------------------------------}
{                  opcao de diretorio
{--------------------------------------------------------}

procedure ajudaSubDirs;
var i: integer;
    c: char;
begin
    writeln;
    for i := AJUDADIR_1 to AJUDADIR_99 do
        begin
            mensagem (i, 1);
            if keypressed then
                begin
                    while keypressed do c := readkey;
                    sintBip;
                    exit;
                end;
        end;
end;

{--------------------------------------------------------}

procedure criarSubDir;
var novoDir: string;
    c, c2: char;
begin
     mensagem (DVDIRCRI, 0);
     writeln;
     novoDir := '';
     c := sintEdita (novoDir, wherex, wherey, 79, true);
     novoDir := compacta (novoDir);
     writeln;
     if (c = #$1b) or (novoDir = '') then exit;

     {$I-} mkdir (novoDir); {$i+}
     if ioresult <> 0 then
          mensagem (DVERRCRI, 1)
     else
         begin
              mensagem (DVOKCRI, 1);
              mensagem (DVQUERD, 0);
              mensagem (DVSIMNAO, 0);
              pegaTeclado (c, c2);
              if c <> #0 then
                  soletra (c, 1)
              else
                  soletra (' ', 1);

              if upcase(c) = 'S' then
                   begin
                       {$I-} chdir (novoDir); {$i+}
                       if ioresult <> 0 then
                            mensagem (DVERRCRI, 1)
                       else
                           begin
                           if (novoDir[1] = '\') or
                               ( (length (novoDir) >= 3) and
                               (novoDir[2] = ':') and (novoDir[3] = '\')  ) then
                               nivelDir := 0    { evita voltas invalidas }
                           else
                               if nivelDir <= 30 then
                                   begin
                                       nivelDir := nivelDir + 1;
                                       vetDir [nivelDir] := numArqAtual ;
                                   end;
                           numArqAtual := 0;
                           end;
                   end;
         end;
end;

{--------------------------------------------------------}

procedure apagaSubDir;
var nomedir: string;
    c, c2: char;
begin
    if (numArqAtual <= 0) or (numArqAtual > numArqs) then
        begin
            mensagem (DVDIRNSL, 1);
            exit;
        end;

     nomedir := listarq^[numArqAtual];

     mensagem (DVCNFAPA, 0);
     soletra (listarq^[numArqAtual], 0);
     mensagem (DVSIMNAO, 0);

     pegaTeclado (c, c2);
     if c <> #0 then
         soletra (c, 1)
     else
         soletra (' ', 1);

     if upcase (c) <> 'S' then
         exit;

     {$I-} rmdir (nomedir); {$i+}
     if ioresult <> 0 then
          mensagem (DVERRAPA, 1)
     else
         begin
              mensagem (DVOKAPA, 1);
              numArqAtual := numArqAtual - 1;
         end;
end;


{--------------------------------------------------------}

procedure selecSubDir;
var nomedir: string;
begin
   if (numArqAtual <= 0) or (numArqAtual > numArqs) then
       begin
           mensagem (DVDIRNSL, 1);
           exit;
       end;

    nomedir := listarq^[numArqAtual];
    {$I-} chdir (nomedir); {$i+}
    if ioresult <> 0 then
         mensagem (DVERRMUD, 1)
    else
        begin
             mensagem (DVOKMUD, 1);
             if nivelDir <= 30 then
                 begin
                     nivelDir := nivelDir + 1;
                     vetDir [nivelDir] := numArqAtual;
                 end;
             numArqAtual := 0;
        end;
end;

{--------------------------------------------------------}

procedure selecDirPai;
begin
    {$I-} chdir ('..');  {$I+}
    if ioresult <> 0 then
         mensagem (DVERRMUD, 1)
    else
        begin
             mensagem (DVOKMUD, 1);
             if nivelDir > 0 then
                 begin
                     numArqAtual := vetDir [nivelDir];
                     nivelDir := nivelDir - 1;
                 end
             else
                 numArqAtual := 0;
        end;
end;

{--------------------------------------------------------}

procedure dadosDirecTrab;
var dir: string;
    c, c2: char;
begin
    getdir (0, Dir);
    mensagem (DVDIRATU, 0);
    soletra (copy (Dir, 1, 2), 0);
    sintetFala (copy (Dir, 3, length(Dir)-2) , 1);

    mensagem (DVQSOLET, 0);
    mensagem (DVSIMNAO, 0);
    pegaTeclado (c, c2);
    if c <> #0 then
        soletra (c, 1)
    else
        soletra (' ', 1);

    if upcase (c) = 'S' then
        sintSoletra (dir);
end;

{--------------------------------------------------------}

procedure selNovoArquivo (c: char);
var nome, ext: string;
    fonemas: string;
    posic: integer;
begin

        case c of
            HOME: begin

if numarqs=0 then
begin
end
else
begin
  numArqAtual := 1;
                sintClek;
end;
end;
            TEND: begin

if numarqs = 0 then
begin
end
else
begin
  numArqAtual := numArqs;
                sintClek;
end;
end;

            PGUP:   begin
if numarqs=0 then
begin
end
else
begin
                        numArqAtual := numArqAtual - 6;
                        if numArqAtual <= 0 then begin
                            numArqAtual := 1;
                sintClek;
end;
                    end;
end;
            PGDN:   begin

if numarqs = 0 then
begin
end
else
begin
                       numArqAtual := numArqAtual + 6;
                       if numArqAtual > numArqs then begin
                            numArqAtual := numArqs;
                sintClek;
end;
                    end;
end;
            CIMA:   begin

if numarqs = 0 then
begin
end
else
begin
                        numArqAtual := numArqAtual - 1;
                        if numArqAtual <= 0 then begin
                            numArqAtual := 1;
                sintClek;
end;
                    end;
end;
            BAIX:   begin

if numarqs = 0 then
begin
end
else
begin
                       numArqAtual := numArqAtual + 1;
                       if numArqAtual > numArqs then begin
                            numArqAtual := numArqs;
                sintClek;
                    end;
end;
end;
        end;

    writeln;

    if (numArqAtual<1) or (numArqAtual>numArqs) then
        begin
            write ('-*-');
            sintClek;
        end
    else
        if (c = DIR) then
            soletra (listarq^[numArqAtual], 0)
else
            if ((getKeyState (vk_control) and $8000) <> 0)  then
            begin
                nome := listarq^[numArqAtual];
                falaNomeExtenso (nome);
            end
        else
            begin
                nome := listarq^[numArqAtual];
                ext := '';
                posic := pos ('.', nome);
                if posic > 0 then
                    begin
                        ext := copy (nome, posic, length (nome)-posic+1);
                        nome := copy (nome, 1, posic-1);
                    end;

                write (nome);
                if ext <> '' then write (ext);
                if not keypressed then
                    begin
                        sintetiza (nome);
                        if ext <> '' then
                            sintSoletra (ext)
                    end
                else
                    begin
                        sintclek;
                        sintcarac (nome[1]);
                    end;

            end;
end;

{--------------------------------------------------------}

procedure trataSubDiretorio;
var
    tratandoSubDirs: boolean;
    c, c2: char;
    salva: integer;
begin
    masc := '*.*';
    new (listarq);
    nivelDir := 0;

    if not montaDirList (FaDirectory) then
        begin
            textBackground (RED);
            mensagem (DVSEMSUB, 1);
            textBackground (BLACK); clreol;
        end;

    alocaDosvox32;

    if numArqs <> 0 then
         begin
             textBackground (RED);
             mensagem (DVSUBDI1, 1);
             textBackground (BLACK); clreol;
             if not keypressed then
                 mensagem (DVSUBDI2, 1);
         end;

    limpabuf;
    tratandoSubDirs := true;
    while tratandoSubDirs do
        begin
            pegaTeclado (c, c2);

            if c = #$1b then
                begin
                    writeln;
                    mensagem (DVOK, 1);
                    tratandoSubDirs := false;
                end
            else

            if (c = #0) then
                 if (c2 = F1) then
                     ajudaSubDirs
                 else
                     selNovoArquivo (c2)
            else
                 begin
                     limpabuf;
                     if c <> GOTFOCUS then
                         begin
                             mensagem (DVOPCAO, 0);
                             soletra (c, 1);
                         end;
                     case upcase(c) of
                         'C': criarSubDir;
                         'A': apagaSubDir;
                         'T': selecSubDir;
                         'I': dadosDirecTrab;
                         'S': selecDirPai;
                         GOTFOCUS: ;
                     else
                         begin
                             mensagem (DVOPINV, 1);
                             if not keypressed then
                                 mensagem (DVSEF1, 1);
                         end;
                     end;

                     limpabuf;

                     salva := numArqAtual;
                     if not montaDirList (FaDirectory) then
                         begin
                             textBackground (RED);
                             mensagem (DVSEMSUB, 1);
                             textBackground (black); clreol;
                         end;
                     numArqAtual := salva;

                     if numArqs <> 0 then
                         mensagem (DVCNTSEL, 1);

                     if numArqAtual <= 0 then
                         numArqAtual := 0;
                     if numArqAtual > numArqs then
                         numArqAtual := numArqs + 1;
                 end;
        end;

    dispose (listarq);

    desalocaDosvox32;
end;

end.
