program catalist;

uses winprocs, wintypes, strings, dvcrt, dvwin, dvmacro, dvexec;

var
    minhaJan, janProg: hWnd;
    posic: trect;

procedure trocaJan (j: hWnd);
begin
    setActiveWindow (j);
    repeat
        calaboca;
        delay (100);
    until keypressed or (getActiveWindow = j);
end;

procedure carregaPrograma;
begin
    minhaJan := getFocus;

    if executaProg ('D:\Arquiv~1\TeleLi~1\TELELIST.EXE', 'D:\Arquiv~1\TeleLi~1', '') <= 32 then
        begin
            writeln ('Programa não encontrado');
            readln;
            doneWinCrt;
        end;

    repeat keypressed until getActiveWindow <> minhaJan;
    delay (3000);
    janProg := getActiveWindow;
end;

procedure selecionaBusca (nome: string);
var
    i, x, y: integer;
begin
    getWindowRect (janProg, posic);
    mouseClick (posic.left+30, posic.top+55);
    while playIsActive do;
    delay (12000);

    playInit (300);
    playkey(nome[1], 8000);
    playkey(nome[2], 3000);
    for i := 3 to length (nome) do
        playKey (nome[i], 2000);
    playStart;
    while playIsActive do;
    delay (2000);

    mouseClick (posic.left+30, posic.top+130);
end;

procedure pulaPaginas (npula: integer);
var i: integer;
begin
    for i := 1 to npula do
        begin
            mouseClick (posic.left+620, posic.top+395);
            delay (500);
        end;
end;

procedure imprimir (nomeArq: string);
var arq: file;
begin
     assign (arq, nomearq);
     {$I-} erase (arq);  {$I+}
     if ioresult <> 0 then;

     mouseClick (posic.left+560, posic.top+450);
     delay (2000);

     playInit (300);
     playString(nomeArq, 100);
     playVirtKey (VK_RETURN, false, false, false, 100);
     playStart;
     while playIsActive do;

     delay (2000);
end;

procedure fechaPrograma;
begin
    playInit (300);
    playVirtKey (VK_F4, false, false, true, 1);
    playStart;
    while playIsActive do;

    delay (2000);
end;

procedure juntaArquivos (nomeSai: string);
var arq, arqSai: text;
    c: char;
    i, l: integer;
    nome, s: string;
begin
    assign (arqSai, nomeSai);
    {$I-} append (arqSai);  {$I+}
    if ioresult <> 0 then
        rewrite (arqSai);

    for i := 1 to 5 do
        begin
            str (i, nome);
            nome := 'c:\' +nome + '.prn';

            assign (arq, nome);
            reset (arq);
            for l := 1 to 2 do
                readln (arq, s);
            read (arq, c);
            for l := 1 to 13 do
                begin
                     readln (arq, s);
                     writeln (arqsai, s)
                end;
            close (arq);
        end;

    close (arqSai);
end;

var i, r, nrod, nPula: integer;
    nome, nomeSai, nomeCat: string;
begin
    screenSize.y := 10;
    writeln ('Capturador de nomes das Telelistas');
    write ('Qual a categoria (advogado, administradora, etc)... ');
    readln (nomeCat);
    write ('Quantos nomes pego (aproximadamente) ? ');
    readln (nrod);
    nrod := nrod div (13*5) + 1;
    write ('Quantos nomes pulo ? ');
    readln (npula);
    npula := npula div 13;
    write ('Nome do arquivo de saída: ');
    readln (nomeSai);

    for r := 1 to nrod do
        begin
            writeln ('Processando rodada ', r);
            carregaPrograma;
            selecionaBusca (nomeCat);
            pulaPaginas (npula);
            npula := npula + 5;

            for i := 1 to 5 do
                begin
                    str (i, nome);
                    imprimir ('c:\' +nome + '.prn');
                    pulaPaginas (1);
                end;

           fechaPrograma;
           juntaArquivos (nomeSai);
        end;

   writeln ('Arquivo gerado, aperte Enter');
   readln;
   doneWinCrt;
end.
