unit dosdisco;
interface
uses windos, dvcrt, dvwin, wow16,
     dosgeral, dosmsg, dosform;

procedure trataDiscos;

implementation

{--------------------------------------------------------}
{             ajuda do processamento de arquivos
{--------------------------------------------------------}

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

{--------------------------------------------------------}
{                    verifica o espaco em disco
{--------------------------------------------------------}

procedure verifEspaco;
var
    H: THandle32;
    pDiskFree, pDiskSize: Longint;
    dfree, dsize: longint;
    ldsize64, hdsize64: longint;
    ldfree64, hdfree64: longint;
    medida: char;
    drive: integer;
    dir: string;
    longVect: array [0..2] of longint;
begin
    medida := 'K';
    getDir (0, dir);
    drive := ord (dir[1]) - ord ('A') + 1;
    dsize := disksize (drive) div 1024;
    ldsize64 := 0;
    hdsize64 := 0;
    H := 0;

    if dsize > 2047000 then
        begin
            H := LoadLibraryEx32W('dosvox32', 0, 0);
            if H > 0 then
                begin
                    medida := 'M';
                    pointer(pDiskSize) := GetProcAddress32W(H, 'disksize32');
                    longVect[0] := drive;
                    longVect[1] := longint(@ldsize64);
                    longVect[2] := longint(@hdsize64);
                    Call32BitProc (pDiskSize, longVect, $6);
                               { $6 = binario 110: longVect[1] e [2] sao pointers }
                    dsize := ((ldsize64 div (1024*1024))) or (hdsize64 * (1024*1024));
                end;
        end;

    if medida = 'K' then
        mensagem (DVTAMDSK, 0)      {Tamanho do disco em K}
    else
        mensagem (DVTAMMEG, 0);     {Tamanho do disco em Mb}
    if dsize > 2047000 then
         mensagem (DV2GIGA, 1)      {Mais do que 2 giga}
    else
         falaNum (dsize, 1);

    medida := 'K';
    dfree := diskfree (drive) div 1024;
    if (dfree > 2047000) and (H <> 0) then
        begin
            { com certeza ja alocou dosvox32.dll, pois disco > 2 giga }
            medida := 'M';
            pointer(pDiskFree) := GetProcAddress32W(H, 'diskfree32');
            longVect[0] := drive;
            longVect[1] := longint(@ldfree64);
            longVect[2] := longint(@hdfree64);
            Call32BitProc (pDiskFree, longVect, $6);
                               { $6 = binario 110: longVect[1] e [2] sao pointers }
            dfree := ((ldfree64 div (1024*1024))) or (hdfree64 * (1024*1024));
        end;

    if H <> 0 then
        FreeLibrary32W(H);

    if medida = 'K' then
        mensagem (DVLIVDSK, 0)     {Espaço livre em K}
    else
        mensagem (DVLIVMEG, 0);    {Espaço livre em Mb}
    if dfree > 2047000 then
         mensagem (DV2GIGA, 1)     {Mais do que 2 giga}
    else
         falaNum (dfree, 1);

    mensagem (DVPDOS, 1);         {'Use o comando P DOS CHKDSK para mais informações'}
end;

{--------------------------------------------------------}
{                escolhe o disco de trabalho
{--------------------------------------------------------}

procedure escolheDisco;
var
    dirAtual: string;
    c, c2: char;
begin
    mensagem (DVINFDIS, 0);
    pegaTeclado (c, c2);
        if upcase(c) in ['A'..'Z'] then
        begin
            soletra (c, 1);
            {$i-} chdir (c+':'); {$i+}
            if ioresult <> 0 then
                mensagem (DVERRUND, 1);
        end
    else
        mensagem (DVERRUND, 1);
end;

{--------------------------------------------------------}
{            informa diretorio de trabalho
{--------------------------------------------------------}

procedure informaDirTrab;
var dir: string;
begin
    getdir (0, Dir);
    mensagem (DVDIRATU, 0);
    soletra (copy (Dir, 1, 2), 0);
    sintetFala (copy (Dir, 3, length(Dir)-2) , 1);
end;

{--------------------------------------------------------}
{        seleciona diretorio de trabalho
{--------------------------------------------------------}

procedure selecDirTrab;
var novoDir: string;
    c: char;
begin
    mensagem (DVINFDIR, 1);
    novoDir := '';
    c := sintEdita (novoDir, wherex, wherey, 79, true);
    writeln;
    if c = #$1b then
        exit;

    novoDir := compacta (novoDir);
    if novoDir = '' then exit;

    {$I-} chdir (novoDir); {$i+}
    if ioresult <> 0 then
         mensagem (DVERRMUD, 1)
    else
         mensagem (DVOKMUD, 1);
end;

{--------------------------------------------------------}
{                         cria diretorio
{--------------------------------------------------------}

procedure criaDir;
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);
                   end;
         end;
end;

{--------------------------------------------------------}
{             funcoes de tratamento de discos
{--------------------------------------------------------}

procedure trataDiscos;
var
    tratandoDiscos: boolean;
    dirAtual: string;
    c, c2: char;
begin
    tratandoDiscos := true;
    while tratandoDiscos do
        begin
            getdir (0, diratual);

            textBackground (RED);
            mensagem (DVDISCOS, 0);
            mensagem (DVOQUE, 0);
            textBackground (BLACK);

            pegaTeclado (c, c2);

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

            if (c = #0) and (c2 = F1) then
                 ajudaDiscos
            else
                 begin
                     soletra (c, 1);
                     tratandoDiscos := false;

                     case upcase(c) of

                         'E': verifEspaco;
                         'D': escolheDisco;
                         'C': criaDir;
                         'I': informaDirTrab;
                         'T': selecDirTrab;
                         'F': formataDisquete;
                     else
                         begin
                             mensagem (DVOPINV, 1);
                             tratandoDiscos := true;
                         end;
                     end;
                 end;
        end;
end;

end.

