{---------------------------------------------------------------------}
{
{   Interface com Processador Dial Up
{   Autor: José Antonio Borges
{   Em 28/11/1999
{
{---------------------------------------------------------------------}

uses dvwin, dvcrt, winprocs, wintypes, shellApi, strings, dvmacro, dvexec;
var
    nomeConec: string;
    minhaJan, janDial, janOrig: hwnd;
    monitorAtivo: boolean;
    abrev: array [1..10] of char;
    conta, senha, telefone: string;
    jaConectado: boolean;
    jans: array [1..100] of hwnd;
    ncon, nj, nab: integer;
    conec: array [1..20] of string;

{--------------------------------------------------------}
{                 fala uma mensagem
{--------------------------------------------------------}

procedure mensagem (nomeArq: string; apular: integer);
var i: integer;
    s: string;
begin
    if nomearq = 'DUNINST' then
        s := 'Sua rede dialup não está instalada'
    else
    if nomearq = 'DUNUMCOM' then
        s := 'Escolha o número da conexão desejada'
    else
    if nomearq = 'DUDESIST' then
        s := 'Desistiu'
    else
    if nomearq = 'DUINFCON' then
        s := 'Informações sobre a conexão'
    else
    if nomearq = 'DUINFDAD' then
        s := 'Informe os dados pedidos ou tecle ENTER para assumir valores padrão'
    else
    if nomearq = 'DUCONTA' then
        s := 'Conta do usuário no provedor   '
    else
    if nomearq = 'DUSENHA' then
        s := 'Senha (não ecoada)  '
    else
    if nomearq = 'DUTELEF' then
        s := 'Telefone do provedor   '
    else
    if nomearq = 'DUAPTENT' then
        s := 'Aperte enter para discar, esc para desistir'
    else
    if nomearq = 'DUDISC' then
        s := 'Discando...'
    else
    if nomearq = 'DUTRMPOS' then
        s := 'Não sei processar terminais de pós discagem'
    else
    if nomearq = 'DUDISCSO' then
        s := 'Você terá que digitar sem minha ajuda.'
    else
    if nomearq = 'DUPROCON' then
        s := 'Problema na conexão'
    else
    if nomearq = 'DUINIC' then
        s := 'Acesso dialup ao provedor de Internet'
    else
    if nomearq = 'DUDSPARA' then
        s := 'Discando para '
    else
    if nomearq = 'DUNAOCON' then
        s := 'Não consegui ativar esta conexão'
    else
    if nomearq = 'DUPROCAN' then
        s := 'Programa cancelado'
    else
    if nomearq = 'DUDESEJD' then
        s := 'Deseja desconexão ? '
    else
    if nomearq = 'DUDESCON' then
        s := 'Desconectado'
    else
    if nomearq = 'DUCONMAN' then
        s := 'Conexão mantida'
    else
    if nomearq = 'DUCONEST' then
        s := 'Conexão com provedor foi estabelecida'
    else
    if nomearq = 'DUMAISUM' then
        s := 'Quer tentar mais uma vez ? '

    else
        begin
            writeln;
            writeln ('-------------------------------');
            writeln ('--- mensagem errada: ', s, '---');
            writeln ('-------------------------------');
            writeln;
        end;

    write (s);
    for i := 1 to apular do writeln;

    if existeArqSom (nomeArq) then
        sintsom (nomeArq)
    else
        sintetiza (s);
end;

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

function descobreConexoes: boolean;
var lChave: longint;
    c: char;
    i: integer;
    tam: word;
    pNome: array [0..80] of char;
begin
    descobreConexoes := false;

    { Pesquisando HKEY_CURRENT_USER }
    if RegOpenKey ($80000001, 'RemoteAccess\Profile', lChave) = ERROR_SUCCESS then
        begin
            ncon := 0;
            tam := 80;
            while RegEnumKey (lChave, ncon, pNome, tam) = ERROR_SUCCESS do
                begin
                    ncon := ncon + 1;
                    conec [ncon] := strPas (pNome);
                end;
        end;
    RegCloseKey(lChave);

    if ncon = 0 then
        begin
            mensagem ('DUNINST', 1);  {'Sua rede dialup não está instalada'}
            exit;
        end;

    if ncon = 1 then
         i := 1
    else
         repeat
             mensagem ('DUNUMCOM', 1);  {'Escolha o número da conexão desejada'}
             while sintFalando do;

             for i := 1 to ncon do
                 begin
                     sintWriteInt (i);
                     sintWriteln ('  ' + conec[i]);
                 end;
             c := sintReadkey;
             writeln (c);
             if c = ESC then
                  begin
                      mensagem ('DUDESIST', 1);  {'Desistiu'}
                      exit;
                  end;

             i := ord (c) - ord ('0');
         until (i > 0) and (i <= ncon);

    nomeConec := conec[i];
    descobreConexoes := true;
end;

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

procedure trocaJan (j: hWnd);
var vezes: integer;
begin
    if not isWindow (j) then exit;

    calaboca;
    setActiveWindow (j);
    vezes := 1;
    while (vezes < 20) and (getActiveWindow <> j) and (isWindow (j)) do
        begin
            delay (100);
            vezes := vezes + 1;
        end;
end;

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

procedure cancelaMonitor;
var janMonitor, janAtual: hWnd;
begin
    janMonitor := findWindow (NIL, 'MONITVOX');
    monitorAtivo := janMonitor <> 0;
    if monitorAtivo then
        begin
            showWindow (janMonitor, sw_maximize);
            playInit (300);
            playVirtKey (VK_F4, false, false, true, 1);
            playStart;
            while  playIsActive do;
        end;
end;

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

procedure recuperaMonitor;
var i: integer;
    janProg: hWnd;
begin
    janProg := getActiveWindow;
    if monitorAtivo then
        begin
            executaProg (sintAmbiente ('DOSVOX', 'MONITOR'), '', '');
            setActiveWindow (minhaJan);   { para evitar problemas }

            for i := 1 to 20 do
                begin
                   keypressed;
                   setActiveWindow (janProg);
                   keypressed;
                   if getActiveWindow = janProg then
                       exit;
                   delay (100);
                end;
        end;
end;

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

procedure pegaJanelasFilhas (j: hwnd);
begin
    j := getWindow (j, GW_CHILD);
    nj := 0;

    while j <> 0 do
        begin
            nj := nj + 1;
            jans [nj] := j;
            j := getWindow (j, GW_HWNDNEXT);
        end;
end;

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

procedure pegaAbrevs (j: hwnd);
var classe, texto: array [0..100] of char;
    i: integer;
begin
    pegaJanelasFilhas (j);

    nab := 0;
    for i := 1 to nj do
        begin
            getClassName (jans[i], classe, 80);
            if strComp (classe, 'Edit') = 0 then
                 begin
                     nab := nab + 1;
                     getWindowText (jans[i-1], texto, 80);
                     abrev [nab] := texto [pos ('&', strPas (texto))];
                 end;
        end;
end;

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

procedure pegaInfoConec (j: hwnd);
var classe, texto: array [0..100] of char;
    i: integer;
begin
    pegaJanelasFilhas (j);

    writeln;
    mensagem ('DUINFCON', 1);  {'Informações sobre a conexão'}

    getWindowText (jans[2], texto, 80);
    sintWriteln (strPas(texto));
    getWindowText (jans[3], texto, 80);
    sintWriteln (strPas(texto));
    getWindowText (jans[4], texto, 80);
    sintWriteln (strPas(texto));

    for i := 1 to nj do
        begin
            getClassName (jans[i], classe, 80);
            if strComp (classe, 'Button') = 0 then
                 begin
                     getWindowText (jans[i], texto, 80);
                     abrev [1] := texto [pos ('&', strPas (texto))];
                     exit;
                 end;
        end;
end;

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

function tentaConectar (nomeConec: string): boolean;
var i: integer;
    s: string;
    txt, cmd: array [0..100] of char;
begin
    tentaConectar := true;

    strPCopy (cmd, 'rundll32.exe rnaui.dll,RnaDial ' + nomeConec);
    winExec (cmd, SW_NORMAL);
    for i := 1 to 10 do
        begin
            delay (500);
            if getActiveWindow <> minhaJan then
                begin
                    getWindowText (getActiveWindow, txt, 80);
                    s := strPas (txt);
                    if copy (s, 1, 5) = 'Conec' then
                         begin
                             janDial := getActiveWindow;
                             jaConectado := (copy (s, 1, 9) = 'Conectado') or
                                            (copy (s, 1, 9) = 'Connected');
                             exit;
                         end;
                end;
        end;

    tentaConectar := false;
end;

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

function pegaDados: boolean;
begin
    trocaJan (minhaJan);

    writeln;
    mensagem ('DUINFDAD', 1);  {'Informe os dados pedidos ou tecle ENTER para assumir valores padrão'}
    writeln;
    mensagem ('DUCONTA', 0);   {'Conta do usuário no provedor   '}
    sintReadln (conta);

    mensagem ('DUSENHA', 0);  {'Senha (não ecoada)  '}
    textcolor (black);
    Readln (senha);
    textcolor (lightGray);

    mensagem ('DUTELEF', 0);  {'Telefone do provedor   '}
    sintReadln (telefone);

    mensagem ('DUAPTENT', 1);  {'Aperte enter para discar, esc para desistir'}
    pegaDados := true;
    if readkey = #$1b then pegaDados := false;
end;

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

procedure enviaDados;
var s: string;
    texto: array [0..100] of char;
    j: hwnd;
    i: integer;
begin
    mensagem ('DUDISC', 1);  {'Discando...'}

    cancelaMonitor;
    trocaJan (janDial);

    playInit (300);
    if conta <> '' then
        begin
            playAltKey (upcase(abrev[2]), 100);
            playString (conta, 1);
        end;

    if senha <> '' then
        begin
            playAltKey (upcase(abrev[2]), 100);
            playString (senha, 1);
        end;

    if telefone <> '' then
        begin
            playAltKey (upcase(abrev[3]), 100);
            playString (telefone, 1);
        end;

    playVirtKey (VK_RETURN, false, false, false, 1);
    playStart;
    while  playIsActive do;

    recuperaMonitor;
end;

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

function conectou: boolean;
var s: string;
    texto: array [0..100] of char;
    j, jdisc: hwnd;
    i: integer;
label continua;

begin
    conectou := false;
    trocaJan (janDial);

continua:
    repeat
        delay (500);
        j := getActiveWindow;
        getWindowText (j, texto, 80);
        s := strPas (texto);
    until (copy (s, 1, 10) <> 'Conectando') and (copy (s, 1, 10) <> 'Connecting');

    delay (2000);

    j := getActiveWindow;
    getWindowText (j, texto, 80);
    s := strPas (texto);

    if (copy (s, 1, 9) = 'Conectado') or
       (copy (s, 1, 9) = 'Connected') or
       (copy (s, 1, 7) = 'Conexão') then
        begin
            janDial := getActiveWindow;
            if (copy (s, 1, 5) = 'Conex') or (copy (s, 1, 6) = 'Connex') then
                begin
                    playInit (300);
                    playVirtKey (VK_RETURN, false, false, false, 1);
                    playStart;
                    while  playIsActive do;
                    delay (2000);
                end;
            pegaInfoConec (j);
            conectou := true;
            exit;
        end;

    if (copy (s, 1, 4) = 'Tela') or (copy (s, 1, 4) = 'Term') then
        begin
            j := getActiveWindow;
            trocaJan (minhaJan);
            mensagem ('DUTRMPOS', 1);  {'Não sei processar terminais de pós discagem'}
            mensagem ('DUDISCSO', 1);  {'Você terá que digitar sem minha ajuda.'}
            delay (1000);
            trocaJan (j);

            repeat
                delay (1000);
                getWindowText (getActiveWindow, texto, 80);
                s := strPas (texto);
            until (copy (s, 1, 4) <> 'Tela') and (copy (s, 1, 4) <> 'Term');

            delay (3000);
            goto continua;
        end;

    pegaJanelasFilhas (getActiveWindow);
    writeln;
    textBackGround (RED);
    mensagem ('DUPROCON', 1);  {'Problema na conexão'}
    textBackGround (BLACK);
    getWindowText (jans[3], texto, 80);
    s := strPas (texto);
    for i := length(s) downto 1 do
        if s[i] = #$0a then insert (#$0d, s, i);
    sintWriteln (s);

    for i := 1 to 4 do
        begin
            delay (1000);
            playInit (300);
            playVirtKey (VK_ESCAPE, false, false, false, 1);
            playStart;
            while  playIsActive do;

            j := getActiveWindow;
            getWindowText (j, texto, 80);
            s := strPas (texto);
        end;
end;

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

label deNovo, fim;
var resp: char;

begin
    janOrig := getActiveWindow;
    sintInic (0, sintAmbiente ('DIALUP', 'DIRDIALUP'));

    textBackGround (BLUE);
    mensagem ('DUINIC', 1);  {'Acesso dialup ao provedor'}
    textBackGround (BLACK);
    writeln;
    minhaJan := getActiveWindow;
    janDial := 0;

    if not descobreConexoes then
        goto fim;

    mensagem ('DUDSPARA', 0);
    sintWriteln (nomeConec);

deNovo:
    if not tentaConectar (nomeConec) then
        begin
            mensagem ('DUNAOCON', 1);  {'Não consegui ativar esta conexão'}
            mensagem ('DUPROCAN', 1);  {'Programa cancelado'}
            goto fim;
        end;

    if jaConectado then
         begin
             trocaJan (minhaJan);
             pegaInfoConec (janDial);

             writeln;
             textBackGround (RED);
             mensagem ('DUDESEJD', 0);  {'Deseja desconexão ? '}
             textBackGround (BLACK);
             resp := readkey;
             sintWriteln (resp);
             if upcase(resp) = 'S' then
                 begin
                     postMessage (janDial, WM_QUIT, 0, 0);    { cancela dial up }
                     repeat
                         delay (500);
                     until keypressed or (not isWindow (janDial));
                 end;

             if not isWindow (janDial) then
                 mensagem ('DUDESCON', 1)   {'Desconectado'}
             else
                 mensagem ('DUCONMAN', 1);  {'Conexão mantida'}
         end
    else
        begin
            pegaAbrevs (janDial);
            if not pegaDados then
                begin
                    postMessage (janDial, WM_QUIT, 0, 0);    { cancela dial up }
                    goto fim;
                end;
            enviaDados;
            if conectou then
                begin
                    trocaJan (minhaJan);
                    mensagem ('DUCONEST', 1);  {'Conexão com provedor foi estabelecida'}
                end
            else
                begin
                    trocaJan (minhaJan);
                    writeln;
                    while keypressed do readkey;
                    mensagem ('DUMAISUM', 0);  {'Quer tentar mais uma vez ? '}
                    resp := readkey;
                    sintWriteln (resp);
                    if upcase (resp) = 'S' then
                        goto deNovo;

                    postMessage (janDial, WM_QUIT, 0, 0);    { cancela dial up }
                end;
        end;

fim:
    delay (1000);
    sintFim;
    trocaJan (janOrig);
    doneWinCrt;
end.