{-------------------------------------------------------------}
{
{    Programa de navegação básica na WEB (HTTP)
{
{    Autores: Jose' Antonio Borges e Bernard Condorcet Porto
{
{    Em 11/04/98
{
{-------------------------------------------------------------}

{$M 24000,8192}

uses winProcs, winDos, winTypes, shellApi,
     dvcrt, strings, dvWin, winsock, dvinet, dvdde,
     webVars, webUrl, webConf, webGrArq, webleit, webMsg, webTraz, webBMark;

{-------------------------------------------------------------}
{                     rotina de inicializacao
{-------------------------------------------------------------}

procedure inicializa;
var s: string;
    erro: integer;
    i: integer;
begin
    debug := false;
    sintInic (0, sintambiente ('WEBVOX', 'DIRWEBVOX'));

    clrscr;
    setWindowText (crtWindow, 'WEBVOX');
    delay (200);

    mensagem ('WBINIC', 0);   {'Leitor de páginas WEB - NCE/UFRJ - v'}
    write (VERSAO);
    sintSoletra (VERSAO);
    sintWriteln (ALFABETA);
    writeln;

    if not abreWinSock then
        mensagem ('WBERRCOM', 1);  {'Não consegui ativar o sistema de comunicação do micro'}

    portaHTTP := 80;
    nomeTemp := '';
    nomePagAtual := '';
    topoPilhaPag := 0;
    nlinCabecHTTP := 0;
    ntags := 0;
    linhaAtual := 1;
    nomeBase := '';
    emPortug := true;
    rotuloInicial := '';
    textoBuscado := '';
    nSomTags := 0;
    falandoPontuacao := false;
    portaLocalFTP := 1050;
    modoFala := 'N';

    ultMsgAutent := '@#$%@';
    ultAutent := '@#$%@';

    new (tagsPagina);
    getMem (dadosPost, 10000);

    nTagsForms := 0;
    new (tagsForms);

    for i := 1 to MAXLINCABHTTP do
        new (cabecHTTP[i]);
    carregaBookMarks;

    s := sintAmbiente ('WEBVOX', 'COMPROXY');
    comProxy := (s <> '') and (upcase (s[1]) = 'S');
    if comProxy then
        begin
            s := sintAmbiente ('WEBVOX', 'ENDERPROXY');
            if s <> '' then
                hostProxy := s
            else
                hostProxy := PROXY_NCE;

            s := sintAmbiente ('WEBVOX', 'PORTAPROXY');
            if s <> '' then
                val (s, portaProxy, erro)
            else
                portaProxy := PORTAPROXY_NCE;
        end;

    dirTags := sintAmbiente ('WEBVOX', 'DIRSOMTAGS');
    if dirTags = '' then dirTags := 'c:\winvox\som\somtags';

    s := sintAmbiente ('WEBVOX', 'AMBWEBTAGS');
    if s = '' then s := 'c:\winvox\webtags.ini';
    prepSonsTags (s);
end;

{-------------------------------------------------------------}
{                 grava Pagina em Texto
{-------------------------------------------------------------}

procedure gravarPagina;
var nomeArq: string;
    c, c2: char;
    geraRef: boolean;
    arq: file;
begin
    if nomeTemp = '' then
        begin
            mensagem ('WBNAOCAR', 1);  {'Não existe página carregada'}
            exit;
        end;

    textBackGround (RED);
    mensagem ('WBARQTXT', 0);  {'Arquivando pagina em formato texto'}
    textBackground (BLACK);
    writeln;
    mensagem ('WBNOMGRV', 1);  {'Qual o nome do arquivo a gravar ? '}
    sintReadln (nomeArq);

    if nomeArq = '' then exit;

    assign (arq, nomeArq);
    {$I-}  reset (arq);  {$I+}
    if ioresult = 0 then
        begin
             close (arq);
             mensagem ('WBREGRAV', 0);  {'Arquivo existente.  Opções: limpar, adicionar ou desistir ? '}
             sintLeTecla (c, c2);
             writeln;
             c := upcase (c);

             if (c = ESC) or (c = 'D') then exit;

             if (c = 'L') then
                 begin
                     {$I-}  erase (arq);  {$I+}
                     if ioresult <> 0 then;
                 end;
        end;

    mensagem ('WBQUEREF', 0);  {'Deseja referências listadas no texto ? '}
    sintLeTecla (c, c2);
    writeln;
    geraRef := upcase (c) = 'S';

    if not geraArqTexto (nomeTemp, nomeArq, geraRef) then
        mensagem ('WBERRTXT', 1)  {'Erro ao gravar o arquivo texto'}
    else
        mensagem ('WBOK', 1);  {'OK'}
end;

{-------------------------------------------------------------}
{                 grava Pagina em Formato Original
{-------------------------------------------------------------}

procedure gravarOriginal;
var nomeArq: string;
    arq, arqSai: file;
    buf: array [0..4095] of byte;
    p, lidos: integer;

label erroDisco;
begin
    if nomeTemp = '' then
        begin
            mensagem ('WBNAOCAR', 1);  {'Não existe página carregada'}
            exit;
        end;

    textBackGround (RED);
    mensagem ('WBARQHTM', 0);  {'Arquivando pagina no formato original'}
    textBackground (BLACK);
    writeln;

    mensagem ('WBEDINOM', 1);   {'Editore o nome, tecle ENTER para confirmar
                                                   ou ESC para cancelar: '}
    nomeArq := nomePagAtual;
    repeat
         p := pos ('/', nomeArq);
         if p <> 0 then delete (nomeArq, 1, p);
    until p = 0;

    sintWrite (nomeArq);
    gotoxy (1, wherey);
    if sintEdita (nomeArq, wherex, wherey, 80, true) = ESC then
                exit;
    if (nomeArq = '') or (nomeArq[1] = ' ') then exit;
    writeln;

    assign (arq, nomeTemp);
    {$I-}  reset (arq, 1);  {$I+}
    if ioresult <> 0 then
        begin
            mensagem ('WBTRAAPA', 1);  {'Arquivo de trabalho foi apagado'}
            exit;
        end;

    assign (arqSai, nomeArq);
    {$I-}  rewrite (arqSai, 1);  {$I+}
    if ioresult <> 0 then
        begin
erroDisco:
            mensagem ('WBERRGRD', 1);  {'Problemas para gravar arquivo no disco'}
            {$I-}  close (arq);  {$I+}
            if ioresult <> 0 then;
            {$I-}  close (arqSai);  {$I+}
            if ioresult <> 0 then;
            exit;
        end;

    while not eof (arq) do
        begin
            {$I-} blockread (arq, buf, 4096, lidos);  {$I+}
            if lidos = 0 then goto erroDisco;
            if ioresult <> 0 then goto erroDisco;
            {$I-} blockwrite (arqSai, buf, lidos);  {$I+}
            if ioresult <> 0 then goto erroDisco;
        end;

    {$I-}  close (arq);  {$I+}
    if ioresult <> 0 then;
    {$I-}  close (arqSai);  {$I+}
    if ioresult <> 0 then goto erroDisco;
end;

{-------------------------------------------------------------}
{                 exportar texto para clipboard
{-------------------------------------------------------------}

procedure exportarPagina;
var i: integer;
    p: PChar;
    pos, tam: word;
    arq: text;
    nomeArq, texto: string;
    tempFileName: array [0..144] of char;
begin
    if nomeTemp = '' then
        begin
            mensagem ('WBNAOCAR', 1);  {'Não existe página carregada'}
            exit;
        end;

    getTempFileName(getTempDrive ('C'), 'web', 0, tempFileName);
    nomeArq := strPas (tempFileName);
    geraArqTexto (nomeTemp, nomeArq, false);

    assign (arq, nomeArq);
    {$I-}  reset (arq);  {$I+}
    if ioresult <> 0 then
        begin
            mensagem ('WBTRAAPA', 1);  {'Arquivo de trabalho foi apagado'}
            exit;
        end;

    getmem (p, 65000);
    pos := 0;
    while not eof (arq) do
        begin
            readln (arq, texto);
            tam := length (texto);
            if (longint (pos) + tam + 2) > 65000 then
                begin
                    mensagem ('WBCOPTRU', 1);  {'Não cabe na área de transferência'}
                    break;
                end;
            move (texto[1], p[pos], tam);
            pos := pos + tam;
            p[pos]   := #$0d;
            p[pos+1] := #$0a;
            pos := pos + 2;
        end;

    p[pos] := #$0;
    putClipboard (p);

    mensagem ('WBBLKCPY', 1);  {'Bloco copiado'}
    freemem (p, 65000);

    erase (arq);
end;

{-------------------------------------------------------------}
{                     finaliza o programa
{-------------------------------------------------------------}

procedure finaliza;
var arq: file;
    i: integer;
begin
    fechaWinSock;

    dispose (tagsPagina);
    for i := 1 to MAXLINCABHTTP do
        dispose (cabecHTTP [i]);

    freeMem (dadosPost, 10000);

    while topoPilhaPag > 0 do
        begin
            if pilhaPag [topoPilhaPag]^.podeApagarTemp then
                begin
                    assign (arq, pilhaPag [topoPilhaPag]^.nomeArqTemp);
                    {$I-}  erase (arq);  {$I+}
                    if ioresult <> 0 then;
                end;
            topoPilhaPag := topoPilhaPag - 1;
        end;

    mensagem ('WBFIM', 1);  {'Acesso à WEB terminado'}
    sintFim;

    doneWinCrt;
end;

{-------------------------------------------------------------}
{                          ajuda
{-------------------------------------------------------------}

procedure ajuda;
begin
   mensagem ('WBAJU01', 1);  {'As opções são:'}
   mensagem ('WBAJU02', 1);  {'  T    trazer página da rede'}
   mensagem ('WBAJU03', 1);  {'  L    ler página'}
   mensagem ('WBAJU04', 1);  {'  V    voltar à última lida'}
   mensagem ('WBAJU05', 1);  {'  S    páginas selecionadas'}
   mensagem ('WBAJU06', 1);  {'  A    trazer a página de um arquivo local'}
   mensagem ('WBAJU07', 1);  {'  G    gravar página'}
   mensagem ('WBAJU08', 1);  {'  H    gravar em formato HTML'}
   mensagem ('WBAJU09', 1);  {'  E    exportar texto da página para área de transferência'}
   mensagem ('WBAJU10', 1);  {'  I    falar em outra lingua'}
   mensagem ('WBAJU11', 1);  {'  C    configurar o programa'}
   mensagem ('WBAJU12', 1);  {'  N    trazer página sem ler'}
   mensagem ('WBAJU13', 1);  {'  R    recarregar esta página'}
   mensagem ('WBAJU19', 1);  {'  ESC  terminar o programa'}
   while keypressed do readkey;
end;

{-------------------------------------------------------------}
{                     testa se quer terminar
{-------------------------------------------------------------}

procedure fim;
var c: char;
begin
    mensagem ('WBCNFFIM', 0);  {'Confirma fim (s/n): '}
    c := sintReadkey;
    writeln (c);

    if upcase (c) = 'S' then
        processando := false;
end;

procedure trocaLingua;
begin
    servDDE := sintAmbiente ('WEBVOX', 'SERVIDOR');
    if servDDE = '' then
        servDDE := 'MONOLOG';
    topicoDDE := sintAmbiente ('EDIVOX', 'TOPICO');
    if topicoDDE = '' then
        topicoDDE := 'TALK';
    itemDDE := sintAmbiente ('EDIVOX', 'ITEM');

    emPortug := not emPortug;
    if emPortug then
        mensagem ('WBLEPORT',1)   {Lendo em português}
    else
        begin
            if not enviaStringDDE (servDDE, topicoDDE, itemDDE, 'Speaking english') then
                begin
                    mensagem ('WBERRDDE', 1);    {'Erro no servidor DDE'}
                    emPortug := not emPortug;
                end
        else
            begin
                delay (2000);
                mensagem ('WBLEING',1);    {lendo em Inglês}
            end;
        end;
end;

{-------------------------------------------------------------}
{                     programa principal
{-------------------------------------------------------------}

var c1, c2: char;
    nome: string;
    ok: boolean;

begin
    inicializa;

    if paramcount <> 0 then
        begin
            nome := paramStr (1);
            if not nomeComputValido (nome) then
                     ok := carregarArquivo (nome)
            else
                begin
                    completaEsquema (nome);
                    ok := trazerPagina (nome, 'G');
                end;

            if ok then
                lerPagina
            else
                mensagem ('WBPAGNAO', 1);  {'Página não achada'}
        end;

    processando := true;
    c1 := ' ';
    while (processando)  do
       begin
           textBackground (BLUE);
           if c1 <> NOFOCUS then mensagem ('WBQUALOP', 0);  {'Qual sua opção ? '}
           textBackground (BLACK);

           checkFocus := true;
           sintLeTecla (c1, c2);
           checkFocus := false;
           if c1 <> NOFOCUS then writeln;

           if c1 = #0 then
               case c2 of
                   F1:  ajuda;
                   F3:  if nomePagAtual = '' then
                            mensagem ('WBNAOCAR', 1)   {'Não existe página carregada'}
                        else
                            sintWriteln (nomePagAtual);
                   F4:  configura;
               end
           else
               case upcase(c1) of
                   NOFOCUS, GOTFOCUS: ;
                   'C':  configura;
                   'N':  trazerPagina ('', 'G');
                   'R':  recarregaPagina;
                   'L':  lerPagina;
                   'T':  if trazerPagina ('', 'G') then
                             lerPagina;
                   'A':  carregarArquivo ('');
                   'V':  voltarPagina;
                   'S':  paginasSeletas;
                   'O':  gravarOriginal;
                   'G':  gravarPagina;
                   'E':  exportarPagina;
                   'D':  debug := not debug;
                   'I':  trocaLingua;

                   ESC:  fim;
                   #$0d: ;
               else
                   mensagem ('WBOPERR', 1);  {'Opção inválida, aperte F1 para ajuda'}
               end;
       end;

    finaliza;
end.
