{-------------------------------------------------------------}
{
{    Programa de Transferência Remota de Arquivos
{
{    Rotina para ler diretorio remoto
{
{    Autor: Jose' Antonio Borges
{
{    Em 21/04/98
{
{-------------------------------------------------------------}

unit ftpDir;
interface

uses dvCrt, dvWin, strings, winsock, winprocs,
     ftpVars, ftpMsg, ftpDlg, ftpPort, ftpRede, ftpArq;

procedure processaDiretorio;
procedure trocaSubdiretorio;

implementation


{-------------------------------------------------------------}
{                    le o diretorio trazido
{-------------------------------------------------------------}

procedure leDiretorio;
type
     stringDir = string[150];
     diretorio = array [1..4000] of ^stringDir;
var
    n, nent: integer;
    p: ^stringDir;
    pdir: ^diretorio;
    arqDir: text;
    nome, s: string;
    c: char;

            procedure extraiNome (s: string; var nome: string);
            var i: integer;
            begin
                 nome := '';
                 while (s <> '') and
                       ((s [length(s)] = ' ') or (s [length(s)] = #$0)) do
                     delete (s, length(s), 1);

                 i := length (s);
                 while (i > 0) and (s[i] <> ' ') do
                     begin
                         nome := s[i] + nome;
                         i := i - 1;
                     end;
            end;

label proxLetra;

begin
    assign (arqDir, nomeArqDir);
    {$I-}  reset (arqDir);  {$I+}
    if ioresult <> 0 then
        begin
            mensagem ('FTERTEMP', 1);  {'Problemas com o arquivo temporário, não posso ler o diretório'}
            exit;
        end;

    new (pdir);
    nent := 0;
    while not eof (arqDir) do
        begin
            readln (arqDir, s);
            nent := nent + 1;
            new (pdir^[nent]);
            pdir^[nent]^ := s;
        end;

    mensagem ('FTUSESET', 1);  {'Use as setas para ler, F9 para informações , ESC para terminar'}

    n := 1;
    repeat
        if (n < 1) or (n > nent) then
            begin
                sintBip;
                repeat
                    c := readkey;
                until (c = #0) or (c = #$1b);
                if c = #$0 then c := readkey;
            end
        else
             begin
                 writeln;
                 extraiNome (pdir^[n]^, nome);
                 sintWrite (nome);
                 if pdir^[n]^[1] = 'd' then
                      begin
                          gotoxy (30, wherey);
                          sintWrite ('  diretório');
                      end;
             end;

proxLetra:
        c := readKey;
        if upcase (c) = 'R' then
            begin
                writeln;
                iniciaRecepcao (nome);
                c := #$1b;   { termina }
            end;

        if c = #$0 then
            begin
                c := readkey;
                case c of
                    CIMA:   begin
                                 n := n - 1;
                                 if n < 0 then n := 0;
                            end;
                    BAIX:   begin
                                 n := n + 1;
                                 if n > nent then n := nent + 1;
                            end;
                    PGUP:   begin
                                 n := n - 10;
                                 if n < 0 then n := 0;
                            end;
                    PGDN:   begin
                                 n := n + 10;
                                 if n > nent then n := nent + 1;
                            end;

                    ESQ:    ;
                    DIR:    begin
                                sintSoletra (nome);
                                goto proxLetra;
                            end;
                    F9:     begin
                                s := pdir^[n]^;
                                c := sintEdita (s, 1, wherey, length (s), false);
                            end;

                    CTLINS: begin
                                 s := nome + #$0;
                                 putClipboard (@s[1]);
                                 sintetiza ('Armazenado');
                             end;
                end;

        end;
    until c = #$1b;

    for n := 1 to nent do
       dispose (pdir^[n]);
    dispose (pdir);

    close (arqDir);

    writeln;
    exit;
end;

{-------------------------------------------------------------}
{                      processa diretório
{-------------------------------------------------------------}

procedure processaDiretorio;
var i, codigo, ev: integer;
    resp: char;
    tipoListagem: string [5];
begin
    if enviaComando ('TYPE A') then
        mostraRespostas (codigo)
    else
        exit;

    assign (arqLocal, nomeArqDir);
    {$I-}  rewrite (arqLocal, 1);  {$I+}
    if ioresult <> 0 then
        begin
            mensagem ('FTERRCRI', 1);  {'Não consegui criar o arquivo para receber o diretorio'}
            exit;
        end;

    trocaPortaLocal;

    mensagem ('FTDIRPED', 1);  {'Diretorio pedido, aguarde'}
    if abreConexaoArq then
        begin
            totalTransmitido := 0;
            if enviaComando ('LIST') then
                begin
                    mostraRespostas (codigo);
                    if (codigo <> 125) and (codigo <> 150) then
                        mensagem ('FTPEDREC', 1);  {'Pedido de informações de diretório foi recusado'}
                end;
        end;

    while processaTransf and (codigo <> 425) do
        begin
            if pins <> pret then
                mostraRespostas (codigo);

            if keypressed then
                case upcase (readkey) of
                   #$1b:  if enviaComando ('ABOR') then
                               begin
                                   mostraRespostas (codigo);
                                   exit;
                               end;
                else
                    begin
                         mostraTransmitidos;
                         while keypressed do readkey;
                    end;
                end;
        end;

    i := 0;
    repeat
         delay (500);
         processaTransf;
         i := i + 1;
         if pins <> pret then
             mostraRespostas (codigo);
    until (pins <> pret) or (i > 10) or (codigo = 226) or (codigo = 250) or (codigo = 425);

    if (codigo <> 226) and (codigo <> 250) then
        mensagem ('FTERRDIR', 1)  {'Erro na transferencia do diretorio'}
    else
        leDiretorio;
end;

{-------------------------------------------------------------}
{                 moda diretorio remoto atual
{-------------------------------------------------------------}

procedure trocaSubdiretorio;
var s, nome, salva: string;
    i, codigo: integer;
    erroFatal, continua: boolean;
begin
    erroFatal := false;
    mensagem ('FTVERDIR', 1);  {'Verificando diretório atual'}
    if enviaComando ('PWD') then
        begin
            pegaResposta (s, codigo, continua);
            if codigo <> 257 then
                mensagem ('FTNAODIR', 1)  {'Não consegui obter o diretório atual'}
            else
                begin
                    salva := s;
                    while (s <> '') and (s[1] <> '"') do delete (s, 1, 1);
                    delete (s, 1, 1);
                    i := pos ('"', s);
                    if i > 0 then
                        delete (s, i, length (s)-i+1);

                    sintWrite ('');  delay (1000);
                    if s <> '' then
                        sintetiza (s)
                    else
                        sintetiza (salva);
                end;
        end
    else
        exit;

    mensagem ('FTQUEDIR', 1);    {'Qual o nome do diretorio remoto desejado ? '}
    sintReadln (nome);
    if nome = ''   then
        begin
            mensagem ('FTDESIS', 1);  {'Desistiu'}
            exit;
        end;

    if      nome = '..' then   s := 'CDUP'
    else                       s := 'CWD '+ nome;

    if enviaComando (s) then
        begin
            mostraRespostas (codigo);
            if (codigo = 250) or (codigo = 200) then
                mensagem ('FTOK', 1)  {'OK'}
            else
                mensagem ('FTNAOTRO', 1);  {'Não consegui trocar'}
        end;
end;

end.
