ProGestion/Modulos/Documentos asociados/uBizDocumentosAsociados.pas

unit uBizDocumentosAsociados;

interface

uses Classes, DataAbstract_Intf;

const
  CTE_ALMACEN_ANTIGUO = '0';
  CTE_ALAMCEN_NUEVO = '1';
  
type
  TGestorDocumentos = class(TObject)
  private
    FRootDocumentos: Variant;
    FDirectorio: Variant;
    FModoInsert: Boolean;
    FEstructuraDir: TDAStringArray;
    FOnEliminarDirDocumentos: TNotifyEvent;    
    FOnBeforeDirectorioChanged: TNotifyEvent;
    FOnAfterDirectorioChanged: TNotifyEvent;

    procedure CrearEstructuraDirectorios;
    function CrearDirDocumentos: Boolean;
    function EliminarDirDocumentos : Boolean;

    function getDirectorio: Variant;
    function getModoInsert: Boolean;
    function getRootDocumentos: Variant;
    procedure setDirectorio(const Value: Variant);
    procedure setModoInsert(const Value: Boolean);
    procedure setRootDocumentos(const Value: Variant);
    function GetOnEliminarDirDocumentos : TNotifyEvent;
    procedure SetOnEliminarDirDocumentos (const Value : TNotifyEvent);
    function GetOnBeforeDirectorioChanged : TNotifyEvent;
    procedure SetOnBeforeDirectorioChanged (const Value : TNotifyEvent);
    function GetOnAfterDirectorioChanged : TNotifyEvent;
    procedure SetOnAfterDirectorioChanged (const Value : TNotifyEvent);

  public
    property RootDocumentos: Variant read getRootDocumentos write setRootDocumentos;
    property Directorio: Variant read getDirectorio write setDirectorio;
    property ModoInsert: Boolean read getModoInsert write setModoInsert;
    property OnEliminarDirDocumentos : TNotifyEvent read GetOnEliminarDirDocumentos write SetOnEliminarDirDocumentos;
    property OnBeforeDirectorioChanged : TNotifyEvent read GetOnBeforeDirectorioChanged write SetOnBeforeDirectorioChanged;
    property OnAfterDirectorioChanged : TNotifyEvent read GetOnAfterDirectorioChanged write SetOnAfterDirectorioChanged;

    function AnadirDocumento(RutaDocumento: String; RutaDestino: String): Boolean;
    function AnadirDirectorio(NuevoDirectorio: String): Boolean;
    function EliminarDirectorio(Directorio: String): Boolean;

    procedure HabilitarDirectorio;
    function darRutaDocumentos: Variant;

    procedure procesarDeleteTable;
    procedure procesarCancelTable;
    constructor Create (Estructura: TDAStringArray);
    destructor Destroy; override;
  end;

  IBizDocumentosAsociados = interface
  ['{C6D5D7B4-AEFF-477A-98AC-56B7993664C6}']
    function GetGestorDocumentos: TGestorDocumentos;
    procedure SetGestorDocumentos(Value: TGestorDocumentos);
    property GestorDocumentos: TGestorDocumentos read GetGestorDocumentos write SetGestorDocumentos;
    function GetGestorDocumentosNuevo: TGestorDocumentos;
    procedure SetGestorDocumentosNuevo(Value: TGestorDocumentos);
    property GestorDocumentosNuevo: TGestorDocumentos read GetGestorDocumentosNuevo write SetGestorDocumentosNuevo;
  end;

implementation

uses SysUtils, uSysFunc, Variants, Forms, JclFileUtils, Dialogs;

function TGestorDocumentos.AnadirDocumento(RutaDocumento: String; RutaDestino: String): Boolean;
var
  DireccionDestino: String;
begin
  try
    Result := False;
    DireccionDestino := RutaDestino + PathDelim + ExtractFileName(RutaDocumento);
    CopiarFichero(RutaDocumento, DireccionDestino);
    Result := True;
  finally
  end;
end;

procedure TGestorDocumentos.HabilitarDirectorio;
begin
  if not DirectoryExists(darRutaDocumentos) then
     CrearDirDocumentos;
end;

function TGestorDocumentos.darRutaDocumentos: Variant;
begin
  Result := FRootDocumentos + PathDelim + VarToStr(FDirectorio);
end;

function TGestorDocumentos.CrearDirDocumentos: Boolean;
var
  DireccionDestino: String;
begin
  Result := False;
  DireccionDestino := darRutaDocumentos;
  if not DirectoryExists(DireccionDestino) then
  begin
     CreateDir(DireccionDestino);
     CrearEstructuraDirectorios;
  end;
  Result := True;
end;

function TGestorDocumentos.EliminarDirDocumentos: Boolean;
begin
  if Assigned(FOnEliminarDirDocumentos) then
     FOnEliminarDirDocumentos(Self);

  Result := EliminarDirectorio(darRutaDocumentos);
end;

procedure TGestorDocumentos.ProcesarDeleteTable;
begin
  EliminarDirDocumentos;
  FDirectorio := Null;
end;

procedure TGestorDocumentos.ProcesarCancelTable;
begin
  if FModoInsert then
     EliminarDirDocumentos;

//  else
     //Eliminaremos el directorio si no tiene documentos, solo tendremos direcctorios
     //en el caso que el presupuesto tenga documentos asociados
//     RemoveDir(darRutaDocumentos);

  Application.ProcessMessages;
end;

function TGestorDocumentos.getDirectorio: Variant;
begin
  Result := FDirectorio;
end;

function TGestorDocumentos.getModoInsert: Boolean;
begin
  Result := FModoInsert;
end;

function TGestorDocumentos.getRootDocumentos: Variant;
begin
  Result := FRootDocumentos;
end;

procedure TGestorDocumentos.setDirectorio(const Value: Variant);
var
  DirectorioAnt, NombreAnt, NombrePos: string;

begin
  //Asigno el mismo valor que se tiene
  if (VarToStr(FDirectorio) = VarToStr(Value)) then
     Exit;

  //Si es cadena vacia
  if (not VarIsNull(Value)) and (Length(Value) = 0) then
     Exit;

  //LANZAMOS EVENTO ANTES
  if Assigned(FOnBeforeDirectorioChanged) then
     FOnBeforeDirectorioChanged(Self);

  if VarIsNull(FDirectorio)
  or VarIsNull(Value) then
     FDirectorio := Value
  else
  begin
    NombreAnt := darRutaDocumentos;
    DirectorioAnt := FDirectorio;
    FDirectorio := Value;
    NombrePos := darRutaDocumentos;

    if DirectoryExists(NombreAnt) then
       if not RenameFile(NombreAnt, NombrePos) then
       begin
          FDirectorio := DirectorioAnt;
          raise Exception.Create('No se pude renombrar el directorio, asegurese que no tenga abierto nada de su contenido y no exista ya una carpeta con ese nombre');
       end;
  end;

  //LANZAMOS EVENTO DESPUES
  if Assigned(FOnAfterDirectorioChanged) then
     FOnAfterDirectorioChanged(Self);
end;

procedure TGestorDocumentos.setModoInsert(const Value: Boolean);
begin
  FModoInsert := Value;
end;

procedure TGestorDocumentos.setRootDocumentos(const Value: Variant);
begin
  FRootDocumentos := Value;
end;

procedure TGestorDocumentos.CrearEstructuraDirectorios;
var
  RutaBase: String;
  i: Integer;
begin
  RutaBase := darRutaDocumentos;

  if not DirectoryExists(RutaBase) then
     Exit;

  for i:=0 to FEstructuraDir.Count-1 do
      CreateDir(RutaBase + '\' + FEstructuraDir.Items[i]);
end;

function TGestorDocumentos.AnadirDirectorio(NuevoDirectorio: String): Boolean;
begin
  Result := False;
  Application.ProcessMessages;
  if DirectoryExists(NuevoDirectorio) then
     raise Exception.Create('Ya existe un directorio con ese nombre, en el directorio actual')
  else
     Result := CreateDir(NuevoDirectorio)
end;

function TGestorDocumentos.EliminarDirectorio(Directorio: String): Boolean;
begin
  Result := False;
  Application.ProcessMessages;
  if DirectoryExists(Directorio) then
  begin
    if not Deltree(Directorio) then
       raise Exception.Create('Error al eliminar el directorio, compruebe archivos abiertos y tiene permisos')
    else
       Result := True;
  end;
end;

constructor TGestorDocumentos.Create (Estructura: TDAStringArray);
begin
  FDirectorio := Null;
  FModoInsert := False;
  FEstructuraDir := Estructura;
end;

function TGestorDocumentos.GetOnAfterDirectorioChanged: TNotifyEvent;
begin
  Result := FOnAfterDirectorioChanged;
end;

procedure TGestorDocumentos.SetOnAfterDirectorioChanged(const Value: TNotifyEvent);
begin
  FOnAfterDirectorioChanged := Value;
end;

function TGestorDocumentos.GetOnBeforeDirectorioChanged: TNotifyEvent;
begin
  Result := FOnBeforeDirectorioChanged;
end;

procedure TGestorDocumentos.SetOnBeforeDirectorioChanged(const Value: TNotifyEvent);
begin
  FOnBeforeDirectorioChanged := Value;
end;

destructor TGestorDocumentos.Destroy;
begin
  FreeAndNil(FEstructuraDir);
  inherited;
end;

function TGestorDocumentos.GetOnEliminarDirDocumentos: TNotifyEvent;
begin
  Result := FOnEliminarDirDocumentos;
end;

procedure TGestorDocumentos.SetOnEliminarDirDocumentos(const Value: TNotifyEvent);
begin
  FOnEliminarDirDocumentos := Value;
end;

end.