{--------------------------------------------------------}
{        Copia uma trilha do CD para um arquivo
{--------------------------------------------------------}

{$M 16384, 8192}
uses dvcrt, dvwin, strings, mmsystem;
var nomearq: string;

var retornoMci: array [0..255] of char;
    erroMci: longint;
    dirTrab, s: string;
    numTrilha: integer;
    qualidade: char;

procedure sendString (s: string);
var p: array [0..255] of char;
begin
    strPcopy (p, s);
    erroMci := mciSendString (p, retornoMci, 255, 0);
    writeln (p, '->',retornoMci);
end;

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

procedure normalizaNome (var nomeArq: string);
var dirTrab: string;
begin
    getDir (0, dirTrab);
    if dirTrab [length (dirTrab)] <> '\' then dirTrab := dirTrab + '\';

    if (pos ('\', nomeArq) = 0) and (pos (':', nomeArq) = 0) then
        nomeArq := dirTrab + nomeArq;
    if pos ('.', nomeArq) = 0 then
        nomeArq := nomeArq + '.WAV';
end;

label fim;
begin
    screensize.y := 10;
    sintInic (0, '');
    sintWriteln ('Transcritor de áudio de CD');
    writeln;
    sintWriteln ('Nome do arquivo a gravar');
    sintReadln (nomeArq);
    if nomeArq = '' then goto fim;

    normalizaNome (nomeArq);

    sintWrite ('Trilha inicial ');
    sintReadInt (numTrilha);

    repeat
        sintWrite ('Qualidade Estéreo, Rádio ou Telefone ?');
        qualidade := sintReadkey;
        writeln (qualidade);
    until upcase (qualidade) in ['S', 'E', 'R', 'T'];

    sintWriteln ('Coloque CD e aperte ENTER para iniciar e parar');
    readln;

    sendString ('set cdaudio door closed');
    repeat
         delay (1000);
         sendString ('status cdaudio ready');
    until (strPas (retornoMCI) = 'true') or keypressed;
    if keypressed then
        if readkey = ESC then goto fim;

    sendString ('open cdaudio');
    sendString ('set cdaudio time format tmsf');
    str (numTrilha, s);
    sendString ('seek cdaudio to '+ s + ' wait');

    sendString ('open new type waveaudio alias mysound');

    case upcase(qualidade) of
       'E', 'S':  sendString ('set mysound time format ms bitspersample 16 channels 2 samplespersec 22050');
       'R':       sendString ('set mysound time format ms bitspersample 16 channels 1 samplespersec 22050');
       'T':       sendString ('set mysound time format ms bitspersample 8 channels 1 samplespersec 11025');
    end;

    sendString ('record mysound');
    sendString ('play cdaudio');

    repeat until keypressed;
    while keypressed do readkey;

    sendString ('stop cdaudio');
    sendString ('close cdaudio');
    sendString ('stop mysound');
    sendString ('save mysound ' + nomeArq);
    sendString ('close mysound');

    sintWriteln ('ok');
    delay (1000);

fim:
    sintFim;
    doneWincrt;
end.
