unit dosarq;
interface
uses winprocs, wintypes, windos, dvcrt, dvfunc, dvwin, strings, dvlenum,
     dosgeral, dosmsg, doscopia, dosimpr, dosed, dosProc, wow16;

procedure trataArquivos;

implementation

{--------------------------------------------------------}
{                  opcao de arquivos
{--------------------------------------------------------}

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

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

    procedure dadosArquivo;
    var arq: file of byte;
        tam: longint;
        ano, mes, dia, hora, min: string[4];
        s: string;
        ftime: longint;
        dt: TdateTime;

            function LeadingZero(w : Word) : String;
            var
              s : String;
            begin
                Str(w:0, s);
                if Length(s) = 1 then
                    s := '0' + s;
                LeadingZero := s;
            end;

    begin
        if (numArqAtual <= 0) or (numArqAtual > numArqs) then
            begin
                mensagem (DVNAOSEL, 1);
                exit;
            end;

        assign (arq, listarq^[numArqAtual]);
        {$I-} reset (arq);  {$I-}
        if ioresult <> 0 then
            begin
                problemaDisco;
                exit;
            end;

        mensagem (DVTAMBYT, 0);
        writeln (filesize (arq));
        falaNumeroConv (numeroParaString (filesize(arq)), 0);

        GetFTime(arq, ftime);
        unpackTime (ftime, dt);
        str (dt.day, dia);    str (dt.month, mes);  str (dt.year, ano);
        str (dt.hour, hora);
        min := leadingZero(dt.min);

        mensagem (DVDATCRI, 0);
        writeln (dia+'/'+mes+'/'+ano);
        sintetiza (dia+'/'+mes+'/'+ano);

        mensagem (DVHORCRI, 0);
        writeln (hora+':'+min);
        sintetiza (hora+':'+min);

        close (arq);
    end;

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

    procedure apagaArquivo;
    var salva: integer;
        c, c2: char;
        arq: file;
    begin
        if (numArqAtual <= 0) or (numArqAtual > numArqs) then
            begin
                mensagem (DVNAOSEL, 1);
                exit;
            end;

        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;

apaga (listarq^[numArqAtual]);
        if ioresult <> 0 then
            begin
                mensagem (DVPRO, 1);
                exit;
            end;

        mensagem (DVFOIAPA, 1);

        salva := numArqAtual - 1;
        if montaDirList (faArchive) then;
        numArqAtual := salva;
    end;

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

    procedure protegeArquivo;
    var arq: file;
        atrib: word;
    begin
        if (numArqAtual <= 0) or (numArqAtual > numArqs) then
            begin
                mensagem (DVNAOSEL, 1);
                exit;
            end;

        assign (arq, listarq^[numArqAtual]);
        getFAttr (arq, atrib);
        if dosError <> 0 then
            begin
                problemaDisco;
                exit;
            end;

    atrib := atrib xor faReadOnly;
    setFattr (arq, atrib);
    getFattr (arq, atrib);
    if (atrib and faReadOnly) <> 0 then
         mensagem (DVPRO, 1)
    else
         mensagem (DVDESPRO, 1)
    end;

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

    procedure trocaNomeArquivo;
    var novoNome: string;
        arq: file;
    begin
        if (numArqAtual <= 0) or (numArqAtual > numArqs) then
            begin
                mensagem (DVNAOSEL, 1);
                exit;
            end;

        mensagem (DVTROCA, 0);
        soletra (listarq^[numArqAtual], 1);
        sintReadln (novoNome);
        if novoNome = '' then
            exit;

        assign (arq, listarq^[numArqAtual]);
        {$I-} rename (arq, novoNome);  {$I+}
        if ioresult <> 0 then
            begin
                mensagem (DVPRO, 1);
                exit;
            end;

        listarq^[numArqAtual] := novoNome;
        mensagem (DVTROCAD, 0);
        soletra (novoNome, 1);
    end;

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

    procedure copiaArquivo;
    var nomearq: string;
    begin
        if (numArqAtual > 0) and (numArqatual <= numArqs) then
            nomearq := listarq^[numArqAtual]
        else
            nomearq := '';
        fazCopias (nomearq);
    end;

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

    procedure imprimeArquivo;
    var nomearq: string;
    begin
        if (numArqAtual <= 0) or (numArqAtual > numArqs) then
            begin
                mensagem (DVNAOSEL, 1);
                exit;
            end;

        nomearq := listarq^[numArqAtual];
        fazImpressao (nomearq);
    end;

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

    procedure editaLeArquivo (opcao: integer);
    var nomearq: string;
        tam: integer;
        ext: string [3];
    begin
        if (numArqAtual <= 0) or (numArqAtual > numArqs) then
            begin
                mensagem (DVNAOSEL, 1);
                exit;
            end;

        nomearq := listarq^[numArqAtual];
        tam := length (nomeArq);
        ext := copy (nomeArq, tam-2, 3);
        if (ext = 'DLL') or (ext = 'EXE') or (ext = 'MID') or
           (ext = 'WAV') or (ext = 'MP3') or (ext = 'BIN') then
            mensagem (DVERRESC, 1)
        else
            editarLerArquivo (nomearq, opcao);
    end;

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

    procedure executaArquivo;
    var extensao: string[3];
        nomeProg, nomearq, nomeDir: string;
        p: integer;
    begin
        if (numArqAtual <= 0) or (numArqAtual > numArqs) then
            begin
                mensagem (DVNAOSEL, 1);
                exit;
            end;

        nomearq := listarq^[numArqAtual];

        getdir (0, nomeDir);

        p := pos ('.', nomeArq);
        extensao := copy (nomeArq, p+1, 3);
        if (extensao = '') then
            editaLeArquivo (1)
        else
        if (extensao = 'EXE') or (extensao = 'COM') then
            begin
                if nomeDir [length (nomeDir)] = '\' then
                    nomeProg := nomedir + nomeArq
                else
                    nomeProg := nomedir + '\' + nomeArq;
                nomeArq := '';
            end
        else
            begin
                nomeProg := sintAmbiente ('DOSVOX', 'PROG.' + extensao);
                if nomeProg = '' then
                    begin
                        nomeProg := nomeArq;
                        nomeArq := '';
                    end;
        end;

        while sintFalando do;
        if executaProg (nomeProg, nomeDir, nomeArq, SW_SHOWMAXIMIZED) then
            esperaProgVoltar;

        while sintFalando do;
    end;

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

    procedure selecaoPorMascara;
    begin
        mensagem (DVMASC, 1);
        sintReadln (masc);
        if (masc = '') or (masc[1] = ' ') then
            masc := '*.*';

        if not montaDirList (faArchive) then
            begin
                writeln ('-*-');
                sintClek;
            end
        else
            begin
                mensagem (DVNMASC, 0);
                soletra (masc, 1);
            end;
    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;
sintCleck;
end;
                    end;
end;
            BAIX:   begin

if numarqs = 0 then
begin
end
else
begin
                       numArqAtual := numArqAtual + 1;
                       if numArqAtual > numArqs then begin
                            numArqAtual := numArqs;
sintCleck;
                    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 trataArquivos;
var
    tratandoArquivos: boolean;
    c, c2: char;
begin
    masc := '*.*';
    new (listarq);

    if not montaDirList (faArchive) then
        begin
            textBackground (RED);
            mensagem (DVVAZIO, 1);
            textBackground (BLACK); clreol;
            dispose (listarq);
            exit;
        end;

    alocaDosvox32;

    mensagem (DVNUMARQ, 0);
    falaNum (numArqs, 1);

    textBackground (RED);
    mensagem (DVARQ1, 0);
    textBackground (BLACK); clreol;
    writeln;
    if not keypressed then
        begin
            mensagem (DVARQ2, 1);
        end;

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

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

            if (c = #0) then
                 if (c2 = F1) then
                     ajudaArquivos
                 else
                 if (c2 = F5) then begin

    mensagem (DVNUMARQ, 0);
    falaNum (numArqs, 1);

end
else
                 if (c2 = F6) then
clrscr
else
                     selNovoArquivo (c2)
            else
                 begin
                     limpabuf;
                     if c <> GOTFOCUS then
                         begin
                             mensagem (DVOPCAO, 0);
                             soletra (c, 1);
                         end;
                     case upcase(c) of
                         'E': editaLeArquivo (0);
                         'C': copiaArquivo;
                         'L': editaLeArquivo (1);
                         'I': imprimeArquivo;
                         'X': executaArquivo;
                         'A': apagaArquivo;
                         'D': dadosArquivo;
                         'P': protegeArquivo;
                         'N': trocaNomeArquivo;
                         'G': selecaoPorMascara;
                         GOTFOCUS: ;
                     else
                         begin
                             mensagem (DVOPINV, 1);
                             if not keypressed then
                                 mensagem (DVSEF1, 1);
                             limpabuf;
                         end;
                     end;
                     limpabuf;
                     mensagem (DVCNTSEL, 1);
                 end;
        end;

    dispose (listarq);

    desalocaDosvox32;
end;

end.
