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

unit ftpArq;
interface

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

procedure iniciaEnvio;
procedure iniciaRecepcao (nomeDesejado: string);
procedure apagaArquivo;

implementation

{-------------------------------------------------------------}
{                   inicia envio de arquivo
{-------------------------------------------------------------}

function selModo: boolean;
var c: char;
    modoTransm: char;
    codigo: integer;
begin
    selModo := true;

    mensagem ('FTMODIMG', 0);  {'Devo usar o modo imagem (sugiro que sim) ? '}
    c := sintReadkey;
    writeln (c);
    if upcase (c) = 'N' then
        modoTransm := 'A'
    else
        modoTransm := 'I';
    if enviaComando ('TYPE ' + modoTransm) then
        mostraRespostas (codigo)
    else
        begin
            mensagem ('FTERRMOD', 1);  {'Problemas ao selecionar modo de transmissão'}
            selModo := false;
        end;
end;

{-------------------------------------------------------------}
{                   inicia envio de arquivo
{-------------------------------------------------------------}

procedure iniciaEnvio;
var codigo: integer;
    c: char;
    modoTransm: char;
    s: string;
    continua: boolean;
label fim;
begin
    textBackGround (MAGENTA);
    mensagem ('FTTRANSM', 0);  {'Transmitir'}
    textBackground (BLACK);
    writeln;

    mensagem ('FTNOMLOC', 0);  {'Qual o nome do arquivo local ? '}
    sintReadln (nomeArqLocal);
    if nomeArqLocal = '' then exit;

    assign (arqLocal, nomeArqLocal);
    {$I-}  reset (arqLocal, 1);  {$I+}
    if ioresult <> 0 then
        begin
            mensagem ('FTARQNAO', 1);  {'Arquivo não existe...'}
            exit;
        end;

    mensagem ('FTNOMREM', 0);  {'Qual o nome do arquivo remoto ? '}
    sintReadln (nomeArqHost);
    if nomeArqHost = '' then exit;

    if not selModo then exit;

    trocaPortaLocal;
    if abreConexaoArq then
        begin
            totalTransmitido := 0;
            if enviaComando ('STOR ' + nomeArqHost) then
                begin
                    mostraRespostas (codigo);
                    if (codigo <> 125) and (codigo <> 150) then
                        begin
                            mensagem ('FTTRAREC', 1);  {'Transferência de arquivo foi recusada'}
                            fechaConexaoArq;
                            exit;
                        end
                    else
                        begin
                            while (not eof (arqLocal)) and (processaTransf) do
                                begin
                                    enviaCanalArq;

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

                                    while pins <> pret do
                                        begin
                                            pegaResposta (s, codigo, continua);
                                            if (codigo <> 226) and (codigo <> 250) then
                                                begin
                                                    sintBip;
                                                    textColor (RED);
                                                    mensagem ('FTERRENV', 1);  {'Erro no envio dos dados, código'}
                                                    sintWriteln (s);
                                                    textColor (WHITE);
                                                    goto fim;
                                                end;
                                        end;

                                end;
                        end;
                end;

        end;

    mensagem ('FTFIMENV', 1);  {'Envio completado'}
fim:
    fechaConexaoArq;

    processaRede;
    mostraRespostas (codigo);

    {$I-}  close (arqLocal);  {$I+}
    if ioresult <> 0 then;
end;

{-------------------------------------------------------------}
{                 inicia recepcao de arquivo
{-------------------------------------------------------------}

procedure iniciaRecepcao (nomeDesejado: string);
var i, codigo: integer;
    s: string;
    continua: boolean;
label ok, fim;
begin
    textBackGround (MAGENTA);
    mensagem ('FTRECEBE', 0);  {'Receber'}
    textBackground (BLACK);
    writeln;

    if nomeDesejado = '' then
        begin
            mensagem ('FTNOMREM', 0);  {'Qual o nome do arquivo remoto ? '}
            sintReadln (nomeArqHost);
            if nomeArqHost = '' then exit;
        end
    else
        nomeArqHost := nomeDesejado;

    mensagem ('FTNOMLOC', 0);  {'Qual o nome do arquivo local ? '}
    sintReadln (nomeArqLocal);
    if nomeArqLocal = '' then
        begin
            nomeArqLocal := nomeArqHost;
            writeln ('(Assumindo nomes idênticos)');
        end;
    assign (arqLocal, nomeArqLocal);

    {$I-}  rewrite (arqLocal, 1);  {$I+}
    if ioresult <> 0 then
        begin
            mensagem ('FTNAOCRI', 1);  {'Não consegui criar o arquivo local'}
            exit;
        end;

    if not selModo then exit;

    trocaPortaLocal;
    if abreConexaoArq then
        begin
            totalTransmitido := 0;
            if enviaComando ('RETR ' + nomeArqHost) then
                begin
                    mostraRespostas (codigo);
                    if (codigo = 125) or (codigo = 150) then
                        goto ok;
                end;
        end;

    mensagem ('FTTRAREC', 1);  {'Transferência de arquivo foi recusada'}
    goto fim;

ok:
    while processaTransf 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
        begin
            sintBip;
            textColor (RED);
            mensagem ('FTERRENV', 1);  {'Erro no envio dos dados, código'}
            sintWriteln (s);
            textColor (WHITE);
            goto fim;
        end;

    mensagem ('FTFIMREC', 1);  {'Recepção completada'}
fim:
    fechaConexaoArq;
end;

{-------------------------------------------------------------}
{                         apaga um arquivo
{-------------------------------------------------------------}

procedure apagaArquivo;
var nome: string;
    codigo: integer;
begin
    mensagem ('FTAPAGA', 1);  {'Apagar'}
    mensagem ('FTNOMAPA', 0);  {'Qual o nome do arquivo remoto a apagar ? '}
    sintReadln (nome);
    if enviaComando ('DELE ' + nome) then
        begin
            mostraRespostas (codigo);
            if (codigo = 125) or (codigo = 150) or (codigo = 250) then
                mensagem ('FTOKAPAG', 1)  {'Ok, apagado'}
            else
                mensagem ('FTNAOAPA', 1);  {'Não consegui apagar este arquivo'}
        end;
end;

end.
