unit u_updownload;

{$mode delphi}

interface

uses
  Classes, SysUtils,
  Math,
  uempaquetar,
  uauxiliares,
  uDataSetGenerico, urosx, uConstantesSimSEE;

const
  MAX_FILE_BLOCK = 1024*100;
// si la cantidad de bytes a almacenar supera MAX_FILE_BLOCK los datos
// se parten en bloques de MAX_FILE_BLOCK y se almacenan en una tabla de blocks
// aparte. Esto es así para evitar porblemas de transimisión de datos sobre http


// sube el archivo a la carpeta identificada por nid_carpeta.
// si no detecta error retorna el nid del archivo asignado en la DB.
// si hay error retorna -1.
function upload_archi(dbcon: TDBrosxCon; tbl_archivo: string; nid_carpeta: integer; archi: string): integer;

// Crea la carpeta "path" en la tabla tbl_carpeta
// devuelve nid_Carpeta o -1 en error
function crear_carpeta (dbcon: TDBrosxCon; tbl_carpeta, tbl_archivos, path: string; tipo: integer;
                       descripcion: string; vaciarSiExiste:Boolean=false):Integer;

// Elimina todos los archivos (y sus bloques) asociados a la carpeta
// nid_carpeta
procedure clear_carpeta(dbcon: TDBrosxCon; tbl_archivo: string; nid_carpeta: integer);


// Baja los archivo asociados a nidCarpeta y los almacena en la carpeta
// destino. Si no se pasa CarpetaDestino, o se pasa un string vacio se
// utiliza como carpeta destino el directorio de SimSEE local concatenado
// con el valor del campo "path" en el registro de la carpeta en la DB.
// Si el parámetro xflg se opmite o es verdadero, y si el nombre de archivo
// contiene el string: ".zip" se descomprime en una sub-carpeta
// con igual nombre de archivo y luego se borra el arhivo. Si xunzip= false
// no se intenta descomprimir el archivo.
function bajarCarpeta_SIN_CACHE(
  dbcon: TDBrosxCon; tbl_carpeta, tbl_archivo: string; nidCarpeta: integer;
  carpetaDestino: string = ''; xunzip: boolean = True): boolean;

function bajarCarpeta(dbcon: TDBrosxCon; tbl_carpeta, tbl_archivo: string; nidCarpeta: integer;
  carpetaDestino: string = ''; xunzip: boolean = True): boolean;


// en caso de error de alguna de las funciones anteriores, llamando
// esta función se puede obtener información sobre el error ocurrido.
function UltimoError: string;

implementation

var
  error: string;

function UltimoError: string;
begin
  Result := error;
end;



function copyfile( origen, destino: string ): boolean;
var
  forg, fdest: TFileStream;
begin
  if not fileExists( origen ) then
  begin
     result:= false;
     exit;
  end;

  if fileExists( destino ) then
    if not  DeleteFile( destino ) then
    begin
       result:= false;
       exit;
    end;

  result:= false;
  try
    forg:= TFileStream.Create( origen, fmOpenRead);
    try
      fdest:= TFileStream.Create( destino, fmCreate );
      try
        fdest.CopyFrom( forg, forg.Size );
        result:= true;
      finally
        fdest.Free;
        forg.Free;
      end;
    except
      forg.Free;
      result:= false;
    end;
  except
    result:= false;
  end;
end;

procedure CopyUnzip( carpetaOrigen, carpetaDestino: string; xunzip: boolean  );
var
  Error: integer;
  FileSearch: TSearchRec;
  nomArch: string;
  camino: string;
  xmascara: string;
  archiDestino: string;
begin
  ForceDirectories( carpetaDestino );
  {$IFDEF LINUX}
    xmascara := '*';
  {$ELSE}
    xmascara := '*.*';
  {$ENDIF}
  camino := CarpetaOrigen + DirectorySeparator;
  Error := FindFirst(camino + xmascara, faAnyFile, FileSearch);
  try
    while (Error = 0) do
    begin
      if (FileSearch.Name <> '.') and (FileSearch.Name <> '..') then
      begin
         nomArch:= FileSearch.Name;
         archiDestino:= CarpetaDestino + DirectorySeparator + nomArch;
         copyfile( camino+ nomArch, archiDestino );
        if xunzip and ( ExtractFileExt( nomArch )='.zip' ) then
        begin
          Unzip( archiDestino );
          deletefile( archiDestino);
        end;
      end;
      Error := FindNext(FileSearch);
    end;
  finally
    SysUtils.FindClose(FileSearch);
  end;
end;



function bajarCarpeta( dbcon: TDBrosxCon; tbl_carpeta, tbl_archivo: string; nidCarpeta: integer;
  carpetaDestino: string = ''; xunzip: boolean = True): boolean;
var
  carpetaBaseCache: string;
  carpetaid: string;
  carpetaCache: string;
  archiSemaforo: string;
  dtInicioEspera: TDateTime;
  cnt_Esperando: integer;
  f: TFileStream;
begin
  carpetaId:= 't_'+tbl_carpeta+'_a_'+tbl_archivo+'_n_'+IntToStr( nidCarpeta );
  carpetaBaseCache:= getDir_CacheOddFace;
  if not DirectoryExists( carpetaBaseCache ) then
    mkdir( carpetaBaseCache );
  archiSemaforo:= carpetaBaseCache+ DirectorySeparator + 'sem_'+carpetaID+'.lck';
  CarpetaCache:=carpetaBaseCache+ DirectorySeparator + carpetaId;
  cnt_Esperando:= 0;
  dtInicioEspera:= now;

  while FileExists( archiSemaforo ) do
  begin
    inc( cnt_Esperando );
    if (( ( now - dtInicioEspera ) * 24* 60 ) > 10 ) then
    begin
      result:= false;
      exit;
    end;
    sleep( trunc( 100 + random * 500 ) );
  end;

  if ( cnt_esperando = 0 ) and not DirectoryExists( CarpetaCache ) then
  begin // lo tengo que bajar
    try
     f:= TFileStream.Create( archiSemaforo, fmCreate + fmShareExclusive );
    except
      result:= false;
      exit;
    end;
    try
      if not bajarCarpeta_SIN_CACHE( dbcon, tbl_carpeta, tbl_archivo, nidCarpeta,
         carpetaCache, false ) then
      begin
        LimpiarCarpeta(carpetaCache, '*.*', true );
        rmdir( carpetaCache );
      end;
    finally
      f.Free;
      DeleteFile( archiSemaforo );
    end;
  end;

  if not DirectoryExists( CarpetaCache ) then
  begin
    result:= false;
    exit;
  end;

  try
   copyUnZip( CarpetaCache, carpetaDestino, xunzip );
   result:= true;
  except
    result:= false;
  end;


end;

function bajarCarpeta_SIN_CACHE( dbcon: TDBrosxCon; tbl_carpeta, tbl_archivo: string; nidCarpeta: integer;
  carpetaDestino: string = ''; xunzip: boolean = True): boolean;
var
  pathCarpeta, nomArch: string;
  chkSumRemoto, chkSumLocal: ShortString;
  orden: string;
  f: TextFile;
  ds, ds_Bloques: TResultadoQuery;
  rCarpeta, rArchi, rBloque: TDataRecord;
  s, datos: string;
  sql: string;
  nbloques: integer;
  k_bloque: integer;
  nidArchivo: integer;
  cnt_intentos: integer;

begin
  cnt_intentos:= 0;
  Result := False;

  sql := 'SELECT fecha, path, descripcion FROM ' + tbl_carpeta +
    ' WHERE nid=' + IntToStr(nidCarpeta);
  rCarpeta := dbcon.sql_ficha(sql);

  if rCarpeta = nil then
  begin
    error := 'No se encontró el Rcord de la carpeta: ' + sql;
    Result := False;
    exit;
  end;
  if carpetaDestino = '' then
    pathCarpeta := getDir_SimSEE + rCarpeta.GetByNameAsString('path')
  else
    pathCarpeta := carpetaDestino;

  orden := 'SELECT nid, nombre, checksum, datos, nbloques FROM ' +
    tbl_archivo + ' WHERE nid_carpeta = ' + IntToStr(nidCarpeta);
  ds := dbcon.sql_query(orden);

  if ds = nil then
    raise Exception.Create( dbcon.UltimoError);

  ForceDirectories(pathCarpeta);

  error := '';

  ds.First;

  while not ds.EOF do
  begin
    rArchi := ds.getFilaActiva;
    nidArchivo := rArchi.GetByNameAsInt('nid');
    nomArch := rArchi.GetByNameAsString('nombre');
    nbloques := rArchi.GetByNameAsInt('nbloques');
    if nbloques = 1 then
    begin
      // baja archivo monobloque
      {$IFDEF OLD_ESCAPE_ARCHIS}
      chkSumRemoto := rArchi.GetByNameAsString('checksum' );
      datos := rArchi.GetByNameAsString('datos');
      {$ELSE}
      chkSumRemoto := rArchi.GetByNameAsString('checksum' );
      if dbcon.tipoServidor = CTS_MySQL then
        datos := HexStrToBuffStr_(rArchi.GetByNameAsString('datos') )
      else
        datos := PG_HexStrToBuffStr( rArchi.GetByNameAsString('datos') );
      {$ENDIF}

      chkSumLocal := checksum(@datos[1], length(datos));

      if chkSumLocal = chkSumRemoto then
      begin
        AssignFile(f, pathCarpeta + DirectorySeparator + nomArch);
        Rewrite(f);
        Write(f, datos);
        CloseFile(f);

        if xunzip and (pos('.zip', nomArch) > 0) then
        begin
          Unzip(pathCarpeta + DirectorySeparator + nomArch);
          deletefile(pathCarpeta + DirectorySeparator + nomArch);
        end;
      end
      else
      begin
        error := error + nomArch + #13#10;
      end;
    end
    else
    begin
      // baja archivo multibloque
      AssignFile(f, pathCarpeta + DirectorySeparator + nomArch);
      Rewrite(f);

      orden := 'SELECT nid, checksum FROM ' + tbl_archivo +
        '_bloques WHERE nid_archivo = ' + IntToStr(nidArchivo) + ' ORDER BY k_bloque ';
      ds_Bloques := dbcon.sql_query(orden);

      ds_Bloques.First;
      while not ds_Bloques.EOF do
      begin
        rBloque := ds_Bloques.getFilaActiva;
        writeln( 'Leyendo bloque: ',  rBloque.GetByNameAsString( 'nid' ) );
        try
        {$IFDEF OLD_ESCAPE_ARCHIS}
        chkSumRemoto := rBloque.GetByNameAsString('checksum');
        datos := dbcon.sql_func('SELECT datos FROM '
              + tbl_archivo+'_bloques WHERE nid = '
              + rBloque.GetByNameAsString('nid')) ;
        {$ELSE}

        chkSumRemoto := rBloque.GetByNameAsString('checksum');
        s:= dbcon.sql_func('SELECT datos FROM '
              + tbl_archivo+'_bloques WHERE nid = '
              + rBloque.GetByNameAsString('nid'));

        if dbcon.tipoServidor = CTS_MySQL then
           datos := HexStrToBuffStr_( s )
        else
          datos := PG_HexStrToBuffStr( s );

        {$ENDIF}

        chkSumLocal := checksum(@datos[1], length(datos));
        if chkSumLocal = chkSumRemoto then
        begin
          Write(f, datos);
          ds_bloques.Next;
          cnt_intentos:= 0;
        end
        else
        begin
          inc( cnt_intentos );
          writeln( '...error chksum bajando bloque reintento n: ', IntToStr( cnt_intentos ) );
          error := error + nomArch + #13#10;
          if cnt_intentos > 10 then
            raise Exception.Create('Error de conexión, imposible bajar archivo: '+nomArch + #13#10 );
        end;
        except
          writeln( '...error de conexion bajando bloque reintento n: ', IntToStr( cnt_intentos ) );
          error := error + nomArch + #13#10;
          inc( cnt_intentos );
          if cnt_intentos > 10 then
            raise Exception.Create('Error de conexión, imposible bajar archivo: '+nomArch + #13#10 );
        end;

      end;
      CloseFile(f);
      if xunzip and (pos('.zip', nomArch) > 0) then
      begin
        Unzip(pathCarpeta + DirectorySeparator + nomArch);
        deletefile(pathCarpeta + DirectorySeparator + nomArch);
      end;
      ds_Bloques.Free;
    end;
    ds.Next;
  end;
  ds.Free;
  Result := error = '';
end;

function crear_carpeta(dbcon: TDBrosxCon; tbl_carpeta, tbl_archivos, path: string; tipo: integer;
  descripcion: string; vaciarSiExiste: Boolean): Integer;
var
  nid_carpeta: integer;
  cnt: integer;
begin
  Result := -1;
  cnt := StrToInt( dbcon.sql_func(
    'SELECT count(*) FROM '+tbl_carpeta+' WHERE path=''' + path + ''''));
  if cnt = 0 then
  begin
    nid_carpeta:= dbcon.sql_nextnid(tbl_carpeta);
    if dbcon.sql_exec('INSERT INTO '+ tbl_carpeta+' ( nid, fecha, tipo, path, descripcion ) VALUES ('
       + IntToStr(nid_carpeta) + ', now(), ' +IntToStr(
       tipo) + ', ''' + path + ''', ''' + Descripcion + ''' ) ') then

       Result := nid_carpeta;
  end
  else
  begin
    nid_carpeta:= StrToInt (dbcon.sql_func('SELECT nid FROM '+tbl_carpeta+' WHERE path=''' + path + ''' LIMIT 1'));
    if vaciarSiExiste then
      clear_carpeta(dbcon, tbl_archivos, nid_carpeta);

  end;
  Result := nid_carpeta;


end;

procedure clear_carpeta(dbcon: TDBrosxCon; tbl_archivo: string; nid_carpeta: integer);
var
  sql: string;
begin
  if dbcon.tipoServidor = CTS_MySQL then
  sql:= 'DELETE FROM ' + tbl_archivo + '_bloques USING ' + tbl_archivo
   +' LEFT JOIN '+ tbl_archivo+'_bloques ON '
   + tbl_archivo + '.nid = ' + tbl_archivo + '_bloques.nid_archivo '
   +' WHERE ' + tbl_archivo + '.nid_carpeta = ' + IntToStr(nid_carpeta)
  else
  sql:= 'DELETE FROM ' + tbl_archivo + '_bloques USING ' + tbl_archivo
   +' WHERE '
   + tbl_archivo + '.nid = ' + tbl_archivo + '_bloques.nid_archivo '
   +' AND ' + tbl_archivo + '.nid_carpeta = ' + IntToStr(nid_carpeta);

  dbcon.sql_exec( sql );

  dbcon.sql_exec('DELETE FROM ' + tbl_archivo + ' WHERE nid_carpeta = ' +
    IntToStr(nid_carpeta));
end;

function upload_archi(dbcon: TDBrosxCon; tbl_archivo: string; nid_carpeta: integer; archi: string): integer;
var
  sql, fechaServidor, pathCompleto: string;
  nombreArchivo: string;
  arch: string;
  chksum: ShortString;
  nidArchivo, i: integer;
  ok: boolean;
  fb: file of byte;
  nbytes: longint;
  nidBloque: integer;
  k_bloque: integer;
  bytes_restantes: integer;
  flg_error: boolean;

  nBytesTotal: integer;
begin
  error := '';

  pathCompleto := ExtractFilePath(archi);
  nombreArchivo := ExtractFileName(archi);

  nidArchivo := dbcon.sql_nextnid(tbl_archivo);
  assignfile(fb, archi);
  reset(fb);
  nbytes := system.filesize(fb);
  nBytesTotal:= nbytes;

  if (nbytes <= MAX_FILE_BLOCK) then
  begin
    setlength(arch, nbytes);
    blockread(fb, arch[1], nbytes);
    closefile(fb);
    chksum := checksum(@arch[1], Length(arch));


{$IFDEF OLD_ESCAPE_ARCHIS}
    sql := 'INSERT INTO ' + tbl_archivo +
      ' (nid, fecha, nombre, nid_carpeta, datos, checksum, nbloques) ' +
      'VALUES (' + IntToStr(nidArchivo) + ', now(), ''' + nombreArchivo +
      ''', ' + IntToStr(nid_Carpeta) + ', ''' + escapeChars(arch) +
      ''', ''' + escapeChars(chksum) + ''', 1)';
{$ELSE}
  if dbcon.tipoServidor = CTS_MySQL then
    sql := 'INSERT INTO ' + tbl_archivo +
      ' (nid, fecha, nombre, nid_carpeta, datos, checksum, nbloques) ' +
      'VALUES (' + IntToStr(nidArchivo) + ', now(), ''' + nombreArchivo +
      ''', ' + IntToStr(nid_Carpeta) + ', ''' + BuffStrToHexStr_(arch)  +
      ''', ''' +  chksum  + ''', 1)'
  else
    sql := 'INSERT INTO ' + tbl_archivo +
      ' (nid, fecha, nombre, nid_carpeta, datos, checksum, nbloques) ' +
      'VALUES (' + IntToStr(nidArchivo) + ', now(), ''' + nombreArchivo +
      ''', ' + IntToStr(nid_Carpeta) + ', ''' + PG_BuffStrToHexStr(arch)  +
      ''', ''' +  chksum  + ''', 1)';
{$ENDIF}
    if not dbcon.sql_exec(sql) then
    begin
      error := sql + #13#10 + dbcon.UltimoError;
      Result := -1;
    end
    else
      Result := nidArchivo;
  end
  else
  begin
    k_bloque := 0;
    bytes_restantes := nbytes;
    flg_error := False;
    while (bytes_restantes > 0) and not flg_error do
    begin
      Inc(k_bloque);

      if bytes_restantes > MAX_FILE_BLOCK then
        nbytes := MAX_FILE_BLOCK
      else
        nbytes := bytes_restantes;

      setlength(arch, nbytes);
      blockread(fb, arch[1], nbytes);
      chksum := checksum(@arch[1], Length(arch));
      nidBloque := dbcon.sql_nextnid(tbl_archivo + '_bloques');

   {$IFDEF OLD_ESCAPE_ARCHIS}
      sql := 'INSERT INTO ' + tbl_archivo +
        '_bloques (nid, nid_archivo, k_bloque, datos, checksum) ' +
        ' VALUES (' + IntToStr(nidBloque) + ', ' + IntToStr(nidArchivo) +
        ', ' + IntToStr(k_bloque) + ', ''' + escapeChars(arch) +
        ''', ''' + escapeChars(chksum) + ''')';
  {$ELSE}
      if dbcon.tipoServidor = CTS_MySQL then
      sql := 'INSERT INTO ' + tbl_archivo +
        '_bloques (nid, nid_archivo, k_bloque, datos, checksum) ' +
        ' VALUES (' + IntToStr(nidBloque) + ', ' + IntToStr(nidArchivo) +
        ', ' + IntToStr(k_bloque) + ', ''' + BuffStrToHexStr_( arch ) +
        ''', ''' + chksum  + ''')'
      else
      sql := 'INSERT INTO ' + tbl_archivo +
        '_bloques (nid, nid_archivo, k_bloque, datos, checksum) ' +
        ' VALUES (' + IntToStr(nidBloque) + ', ' + IntToStr(nidArchivo) +
        ', ' + IntToStr(k_bloque) + ', ''' + PG_BuffStrToHexStr( arch ) +
        ''', ''' + chksum  + ''')';

  {$ENDIF};
      if dbcon.sql_exec(sql) then
      begin
        bytes_restantes := bytes_restantes - nbytes;
        writeln( 100*(1 - bytes_restantes / nBytesTotal ) );
      end
      else
      begin
        error := sql + #13#10 + dbcon.UltimoError;
        flg_error := True;
      end;
    end;
    closefile(fb);
    if flg_error then
    begin
      sql := 'DELETE FROM ' + tbl_archivo + '_bloques WHERE nid_archivo= ' +
        IntToStr(nidArchivo);
      dbcon.sql_exec(sql);
      Result := -1;
    end
    else
    begin
      sql := 'INSERT INTO ' + tbl_archivo +
        ' (nid, fecha, nombre, nid_carpeta, datos, checksum, nbloques) ' +
        'VALUES (' + IntToStr(nidArchivo) + ', now(), ''' + nombreArchivo +
        ''', ' + IntToStr(nid_Carpeta) + ', '''', '''', ' + IntToStr(k_bloque) + ')';
      dbcon.sql_exec(sql);
      Result := nidArchivo;
    end;
  end;
end;

begin
  error := '';
end.
