unit udownload;

interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, WinSock, uinternet;

function download (url: string; sl: TStringList): boolean;
// a StringList já deve ter sido criada

implementation

const
    CRLF = #$0d + #$0a;
var
    statusUltIO: longint;

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

function traduzURL (url: string; out protocolo, nomeComput: string;
                                 out porta: integer;
                                 out recurso: string): boolean;
var
    i: integer;
begin
    protocolo := 'HTTP';
    porta := 80;

    url := trim(url);
    i := pos('://' , url);
    if i <> 0 then
        delete (url, 1, i+2);

    i := pos('/', url);
    if i = 0 then
        begin
            nomeComput := url;
            recurso := '/';
        end
    else
        begin
            nomeComput := copy(url, 1, (i-1));
            recurso := copy(url, i, 9999);
        end;

    traduzURL := true;
end;

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

function pegaHeader (protocolo, nomeComput: string; porta: integer; recurso: string;
                     out codRetorno: integer;
                     out novaUrl: string;
                     out pbuf: PbufRede;
                     out soquete: integer): boolean;

var s: string;
    i: integer;
    header: TStringList;
    aEnviar: string;

begin
    pegaHeader := false;
    codRetorno := 500;
    novaUrl := '';

    soquete := abreConexao (nomeComput, porta);
    if soquete < 0 then
        begin
            showMessage ('Erro de conexao');
            exit;
        end;

    aEnviar :=
        'GET ' + recurso + ' HTTP/1.0' + CRLF +
        'UA-CPU: x86' + CRLF +
        'Connection: Close' + CRLF +
        'Accept-Language: pt-br' + CRLF +
        'User-Agent: Intercap' + CRLF +
        'Host: ' + nomeComput + CRLF +
        CRLF;

    statusUltIO := ord (writeRede(soquete, aEnviar));

    pBuf := inicBufRede (soquete);

    header := TStringList.Create;
    repeat
        statusUltIO := ord (not readlnBufRede (pbuf, s, 30));
        header.add(s);
    until (statusUltIO <> 0) or (s = '');

    if copy(header[0], 1,4) <> 'HTTP' then   // erro no servidor
        begin
            showMessage ('Erro no servidor');
            header.Free;
            fechaConexao(soquete);
            fimBufRede(pbuf);
            pbuf := NIL;
            exit;
        end;

    s := header[0];
    i := pos(' ', s);
    codRetorno := StrToInt(copy(s, i+1, 3));

    if (codRetorno div 100) = 3  then  // relocators
        begin
            // pega o location
            for i := 0 to (header.Count-1) do
                begin
                    if pos('LOCATION:', upperCase(header[i])) = 1 then
                        novaUrl := trim(copy(header[i], 10 , 999));
                end;
            fimBufRede (pbuf);
            fechaConexao(soquete);
        end
    else
        if (codRetorno div 100) = 2 then
            pegaHeader := true;

    header.Free;
end;

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

function abreUrl(url: string; out pBuf: pbufrede; out soquete: integer): boolean;
var
    protocolo, nomeComput, recurso: string;
    porta: integer;
    novaUrl: string;
    codRetorno: integer;

begin
    abreUrl := false;
    novaUrl := url;

    codRetorno := 300;
    while (codRetorno div 100) = 3  do
        begin
            if not traduzURL (novaUrl, protocolo, nomeComput, porta, recurso) then
                exit;

             if not pegaHeader (protocolo, nomeComput, porta, recurso,
                               codRetorno, novaUrl, pbuf, soquete) then
                exit;
       end;

    abreUrl := true;
 end;

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

function copiaURLparaStringList (pbuf: PbufRede; soquete: integer;
                              slBaixar: TStringList): boolean;
const
    TAMBUF = 256000;
var
    lidoOk: boolean;
    buf: packed array [0..TAMBUF-1] of char;
    ncbuf: integer;
    c: char;
begin
     ncbuf := 0;

     repeat
        lidoOk := leCaracBufRede(pbuf, c);
        if lidoOk then
            begin
                buf[ncbuf] := c;
                ncbuf := ncbuf + 1;
            end;
    until not lidoOk;
    buf[ncbuf] := #0;
    slBaixar.Text := buf;

    copiaURLparaStringList := true;
end;

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

function download (url: string; sl: TStringList): boolean;
// a StringList já deve ter sido criada

var
    pbuf: PbufRede;
    soquete: integer;

label erro;
begin
    download := false;

    if abreUrl(url, pbuf, soquete) then
        begin
            if copiaURLparaStringList (pbuf, soquete, sl) then
                download := true;
            fimBufRede(pbuf);
            fechaConexao(soquete);
        end;
end;

begin
    abreWinsock;
end.