git-svn-id: https://192.168.0.254/svn/Proyectos.Tecsitel_FactuGES/trunk@4 b68bf8ae-e977-074f-a058-3cfd71dd8f45
563 lines
16 KiB
ObjectPascal
563 lines
16 KiB
ObjectPascal
{
|
|
===============================================================================
|
|
Copyright (©) 2001. Rodax Software.
|
|
===============================================================================
|
|
Los contenidos de este fichero son propiedad de Rodax Software titular del
|
|
copyright. Este fichero sólo podrá ser copiado, distribuido y utilizado,
|
|
en su totalidad o en parte, con el permiso escrito de Rodax Software, o de
|
|
acuerdo con los términos y condiciones establecidas en el acuerdo/contrato
|
|
bajo el que se suministra.
|
|
-----------------------------------------------------------------------------
|
|
Web: www.rodax-software.com
|
|
===============================================================================
|
|
Fecha primera versión: 01-10-2001
|
|
Versión actual: 1.0.8
|
|
Fecha versión actual: 12-10-2004
|
|
===============================================================================
|
|
Modificaciones:
|
|
|
|
Fecha Comentarios
|
|
---------------------------------------------------------------------------
|
|
24-10-2001 Se ha revisado el procedimiento 'ComprobarContadores'.
|
|
|
|
07-04-2002 Se ha cambiado el constructor y la función 'darTransaccion'
|
|
para adaptarlo a la transacción única.
|
|
|
|
04-05-2002 Se han añadido constantes para los tamaños de las columnas
|
|
de los grids.
|
|
|
|
15-05-2002 Se han añadido los procedimiento 'Commit' y 'Rollback'.
|
|
|
|
21-10-2002 Se han añadido la tabla Tipos de cliente.
|
|
|
|
06-03-2004 P272. Adaptación a multiempresa.
|
|
|
|
12-10-2004 p290. Campos nuevos de columna para peticion
|
|
===============================================================================
|
|
}
|
|
|
|
unit BaseDatos;
|
|
|
|
interface
|
|
|
|
uses
|
|
SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms,
|
|
Dialogs, DBTables, DB, IBDatabase, IBCustomDataSet, IBTable, IBSQLMonitor,
|
|
IBSQL, IB, IBServices, dxDBGrid, RdxGestorContadores, RxMemDS,
|
|
cxGridDBCardView, cxGrid, cxGridCustomTableView,
|
|
cxGridTableView, cxGridDBTableView;
|
|
|
|
const
|
|
tamColCalle = 200;
|
|
tamColCantidad = 35;
|
|
tamColCantidad2 = 15;
|
|
tamClaseFactura = 15;
|
|
tamColCodigo = 78;
|
|
tamColCodigo2 = 35;
|
|
tamColCodigo3 = 20;
|
|
tamColCodigo4 = 65;
|
|
tamColCodigoPostal = 45;
|
|
tamColDescripcion = 350;
|
|
tamColDescripcion1 = 250;
|
|
tamColDescripcion2 = 150;
|
|
tamColDescripcion3 = 100;
|
|
tamColDescripcion4 = 200;
|
|
tamColEMail = 100;
|
|
tamColFamilias = 95;
|
|
tamColFamilias2 = 50;
|
|
tamColFamilias3 = 75;
|
|
tamColFecha = 70;
|
|
tamColFecha2 = 30;
|
|
tamColNIFCIF = 65;
|
|
tamColNombre = 200;
|
|
tamColNombreAlmacen = 120;
|
|
tamColNumPiso = 35;
|
|
tamColPorcentaje = 35;
|
|
tamColPorcentaje2 = 50;
|
|
tamColPorcentaje3 = 30;
|
|
tamColPrecio = 65;
|
|
tamColPrecio2 = 30;
|
|
tamColPrecio3 = 35;
|
|
tamColPrecio4 = 45;
|
|
tamColPrecio5 = 50;
|
|
tamColPrecio6 = 60;
|
|
tamColProvincia = 85;
|
|
tamColSituacion = 70;
|
|
tamColTelefono = 60;
|
|
tamColTipo = 55;
|
|
tamColUnidadesMedida = 65;
|
|
tamColUnidadesMedida2 = 40;
|
|
tamColPoblacion = 95;
|
|
tamColExistencias = 15;
|
|
tamColExistencias2 = 25;
|
|
tamColStockMin = 15;
|
|
tamColStockMax = 15;
|
|
tamColHora = 10;
|
|
tamColTipoOperacion = 20;
|
|
tamColTipoMovimiento = 20;
|
|
tamColFabricante = 85;
|
|
tamColCodFabricante = 55;
|
|
tamColProveedor = 85;
|
|
tamColProveedor2 = 110;
|
|
tamColNombreProveedor = 145;
|
|
tamColCodProveedor = 65;
|
|
tamColPreAceAnuPen = 50;
|
|
|
|
USER_SYSDBA = 'sysdba';
|
|
|
|
type
|
|
TPTabla = ^TIBDataSet;
|
|
TPTablaMem = ^TRxMemoryData;
|
|
|
|
TdmBaseDatos = class(TDataModule)
|
|
private
|
|
FBD : TIBDatabase;
|
|
FTransaccionBD : TIBTransaction;
|
|
FNombreBD : string;
|
|
|
|
procedure IniciarTablasBackOffice;
|
|
procedure IniciarTablas;
|
|
function DarTransaccion: TIBTransaction;
|
|
function DarUsuario : string;
|
|
function DarRutaBD: String;
|
|
function DarNombreServidor: String;
|
|
function ValidarPrivilegios: Boolean;
|
|
public
|
|
procedure Commit;
|
|
procedure Rollback;
|
|
procedure Desconectar;
|
|
procedure Conectar (RutaBD : String; Usuario : String; Clave : String); overload;
|
|
procedure Conectar (RutaBD : String); overload;
|
|
procedure Conectar; overload;
|
|
constructor Create(AOwner : TComponent); override;
|
|
destructor Destroy; override;
|
|
function DarFecha : TDateTime;
|
|
function DarAno : string;
|
|
function DarMes : string;
|
|
function DarSeriesFacturas : TStrings;
|
|
published
|
|
property BD : TIBDatabase read FBD;
|
|
property Transaccion : TIBTransaction read FTransaccionBD;
|
|
property Usuario : String read DarUsuario;
|
|
property NombreBD : String read FNombreBD write FNombreBD;
|
|
property RutaBD : String read DarRutaBD;
|
|
property NombreServidor : String read DarNombreServidor;
|
|
end;
|
|
|
|
|
|
procedure ActivarEdicionGridDetalles(var vGrid: TcxGridDBTableView); overload;
|
|
procedure ActivarEdicionGridDetalles(var Grid : TdxDBGrid); overload;
|
|
procedure DesactivarEdicionGridDetalles(var Grid: TcxGridDBTableView); overload;
|
|
procedure DesactivarEdicionGridDetalles(var Grid : TdxDBGrid); overload;
|
|
procedure GetRecordsBookmarkList(AView: TcxGridDBTableView;
|
|
aBookMarkList: TList);
|
|
|
|
var
|
|
dmBaseDatos: TdmBaseDatos;
|
|
|
|
implementation
|
|
{$R *.DFM}
|
|
|
|
uses
|
|
Ibquery, dbgrids,
|
|
Mensajes, Literales,
|
|
TablaArticulos,
|
|
TablaProveedores,
|
|
TablaClientes,
|
|
TablaSucursalesCliente,
|
|
TablaPedidosProveedor,
|
|
TablaFacturasProveedor,
|
|
TablaProvincias,
|
|
TablaPoblaciones,
|
|
TablaAlmacenes,
|
|
TablaArticulosAlmacen,
|
|
TablaMovimientos,
|
|
TablaFormasPago,
|
|
TablaFamilias,
|
|
TablaTiposCliente,
|
|
TablaPresupuestos,
|
|
TablaBancos,
|
|
TablaUnidadesMedida,
|
|
TablaHistoricoMovimientos,
|
|
TablaFacturasCliente,
|
|
TablaAlbaranesCliente,
|
|
TablaAlbaranesProveedor,
|
|
TablaSucursalesProveedor,
|
|
TablaInstaladores,
|
|
TablaArticulosObraHistorica,
|
|
Excepciones, TablaEmpresas,
|
|
RdxEmpresaActiva, TablaAlbaranesInstalador, TablaFabricantes;
|
|
|
|
|
|
constructor TdmBaseDatos.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
|
|
FBD := TIBDatabase.Create(Self);
|
|
with FBD do
|
|
begin
|
|
SQLDialect := 3;
|
|
LoginPrompt := False;
|
|
end;
|
|
|
|
FTransaccionBD := TIBTransaction.Create(Self);
|
|
with FTransaccionBD do
|
|
begin
|
|
DefaultAction := TARollbackRetaining;
|
|
DefaultDatabase := FBD;
|
|
Params.Add('read_committed');
|
|
Params.Add('rec_version');
|
|
Params.Add('nowait');
|
|
end;
|
|
FBD.DefaultTransaction := FTransaccionBD;
|
|
end;
|
|
|
|
destructor TdmBaseDatos.Destroy;
|
|
begin
|
|
Desconectar;
|
|
FBD.DefaultTransaction := NIL;
|
|
FBD.Free;
|
|
FBD := NIL;
|
|
|
|
FTransaccionBD.Free;
|
|
FTransaccionBD := NIL;
|
|
|
|
inherited;
|
|
end;
|
|
|
|
procedure TdmBaseDatos.IniciarTablas;
|
|
begin
|
|
Application.CreateForm(TdmTablaAlmacenes, dmTablaAlmacenes);
|
|
Application.CreateForm(TdmTablaArticulos, dmTablaArticulos);
|
|
Application.CreateForm(TdmTablaProveedores, dmTablaProveedores);
|
|
Application.CreateForm(TdmTablaSucursalesProveedor, dmTablaSucursalesProveedor);
|
|
Application.CreateForm(TdmTablaPedidosProveedor, dmTablaPedidosProveedor);
|
|
Application.CreateForm(TdmTablaFacturasProveedor, dmTablaFacturasProveedor);
|
|
Application.CreateForm(TdmTablaClientes, dmTablaClientes);
|
|
Application.CreateForm(TdmTablaPresupuestos, dmTablaPresupuestos);
|
|
Application.CreateForm(TdmTablaAlbaranesCliente, dmTablaAlbaranesCliente);
|
|
Application.CreateForm(TdmTablaAlbaranesProveedor, dmTablaAlbaranesProveedor);
|
|
Application.CreateForm(TdmTablaAlbaranesInstalador, dmTablaAlbaranesInstalador);
|
|
Application.CreateForm(TdmTablaFacturasCliente, dmTablaFacturasCliente);
|
|
Application.CreateForm(TdmTablaSucursalesCliente, dmTablaSucursalesCliente);
|
|
Application.CreateForm(TdmTablaArticulosAlmacen, dmTablaArticulosAlmacen);
|
|
Application.CreateForm(TdmTablaArticulosObraHistorica, dmTablaArticulosObraHistorica);
|
|
Application.CreateForm(TdmTablaMovimientos, dmTablaMovimientos);
|
|
Application.CreateForm(TdmTablaHistoricoMovimientos, dmTablaHistoricoMovimientos);
|
|
Application.CreateForm(TdmTablaFormasPago, dmTablaFormasPago);
|
|
Application.CreateForm(TdmTablaFamilias, dmTablaFamilias);
|
|
Application.CreateForm(TdmTablaTiposCliente, dmTablaTiposCliente);
|
|
Application.CreateForm(TdmTablaBancos, dmTablaBancos);
|
|
Application.CreateForm(TdmTablaUnidadesMedida, dmTablaUnidadesMedida);
|
|
Application.CreateForm(TdmTablaInstaladores, dmTablaInstaladores);
|
|
|
|
Application.CreateForm(TdmTablaFabricantes, dmTablaFabricantes);
|
|
end;
|
|
|
|
function TdmBaseDatos.DarTransaccion: TIBTransaction;
|
|
begin
|
|
Result := FTransaccionBD;
|
|
end;
|
|
|
|
function TdmBaseDatos.DarAno : string;
|
|
var
|
|
Ano, Mes, Dia : Word;
|
|
begin
|
|
DecodeDate(darFecha, ano, mes, dia);
|
|
Result := IntToStr(ano);
|
|
end;
|
|
|
|
function TdmBaseDatos.DarMes : string;
|
|
var
|
|
Ano, Mes, Dia : Word;
|
|
begin
|
|
DecodeDate(darFecha, ano, mes, dia);
|
|
Result := IntToStr(mes);
|
|
end;
|
|
|
|
function TdmBaseDatos.DarUsuario: string;
|
|
begin
|
|
Result := BD.Params.Values['user_name'];
|
|
end;
|
|
|
|
procedure TdmBaseDatos.Commit;
|
|
begin
|
|
if FTransaccionBD = NIL then
|
|
Exit;
|
|
if FTransaccionBD.InTransaction then
|
|
FTransaccionBD.CommitRetaining;
|
|
end;
|
|
|
|
procedure TdmBaseDatos.Rollback;
|
|
begin
|
|
if FTransaccionBD = NIL then
|
|
exit;
|
|
if FTransaccionBD.InTransaction then
|
|
FTransaccionBD.RollbackRetaining;
|
|
end;
|
|
|
|
function TdmBaseDatos.DarSeriesFacturas: TStrings;
|
|
var
|
|
oSQL : TIBSQL;
|
|
Lista : TStringList;
|
|
begin
|
|
Result := NIL;
|
|
oSQL := TIBSQL.Create(Self);
|
|
Lista := TStringList.Create;
|
|
with oSQL do
|
|
begin
|
|
Database := dmBaseDatos.BD;
|
|
Transaction := dmBaseDatos.Transaccion;
|
|
SQL.Add('select DESCRIPCION from SERIES');
|
|
try
|
|
Prepare;
|
|
ExecQuery;
|
|
while not EOF do begin
|
|
Lista.Append(Fields[0].AsString);
|
|
Next;
|
|
end;
|
|
Result := Lista;
|
|
finally
|
|
Close;
|
|
Transaction := NIL;
|
|
Free;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TdmBaseDatos.DarFecha: TDateTime;
|
|
var
|
|
oSQL : TIBSQL;
|
|
Fecha : TDateTime;
|
|
begin
|
|
Result := Date;
|
|
oSQL := TIBSQL.Create(Self);
|
|
with oSQL do
|
|
begin
|
|
Database := BD;
|
|
Transaction := DarTransaccion;
|
|
SQL.Add('select CURRENT_DATE from RDB$DATABASE');
|
|
try
|
|
Prepare;
|
|
ExecQuery;
|
|
Fecha := Fields[0].AsDateTime;
|
|
Result := Fecha;
|
|
finally
|
|
Close;
|
|
Transaction := NIL;
|
|
Free;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TdmBaseDatos.Conectar(RutaBD : String; Usuario : String; Clave : String);
|
|
begin
|
|
with BD do
|
|
begin
|
|
DatabaseName := RutaBD;
|
|
Params.Clear;
|
|
Params.Add('user_name=' + LowerCase(Usuario));
|
|
Params.Add('password=' + LowerCase(Clave));
|
|
Params.Add('lc_ctype=ISO8859_1');
|
|
Params.Add('sql_role_name=usuarios');
|
|
try
|
|
Screen.Cursor := crHourGlass;
|
|
Connected := True;
|
|
FTransaccionBD.StartTransaction;
|
|
if (validarPrivilegios) then
|
|
begin
|
|
GestorContadores.BD := FBD;
|
|
GestorContadores.Transaccion := FTransaccionBD;
|
|
EmpresaActiva.BD := FBD;
|
|
EmpresaActiva.Transaccion := FTransaccionBD;
|
|
|
|
//Asignamos empresa como variable de entorno
|
|
IniciarTablasBackOffice;
|
|
IniciarTablas;
|
|
end
|
|
else
|
|
begin
|
|
Rollback;
|
|
Connected := False;
|
|
raise EIBError.Create(msgUsuarioInc);
|
|
end;
|
|
finally
|
|
Screen.Cursor := crDefault;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TdmBaseDatos.DarRutaBD: String;
|
|
begin
|
|
Result := Copy(BD.DatabaseName, Pos(':', BD.DatabaseName) + 1, MaxInt);
|
|
end;
|
|
|
|
function TdmBaseDatos.DarNombreServidor: String;
|
|
begin
|
|
//Result := LeftStr(BD.DatabaseName, Pos(':', BD.DatabaseName) - 1);
|
|
end;
|
|
|
|
procedure TdmBaseDatos.Desconectar;
|
|
begin
|
|
with BD do
|
|
begin
|
|
try
|
|
Screen.Cursor := crHourGlass;
|
|
if DefaultTransaction.InTransaction then
|
|
DefaultTransaction.Rollback;
|
|
Close;
|
|
finally
|
|
Screen.Cursor := crDefault;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TdmBaseDatos.Conectar;
|
|
begin
|
|
with BD do
|
|
begin
|
|
try
|
|
Screen.Cursor := crHourGlass;
|
|
Connected := True;
|
|
FTransaccionBD.StartTransaction;
|
|
finally
|
|
Screen.Cursor := crDefault;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TdmBaseDatos.Conectar(RutaBD: String);
|
|
begin
|
|
with BD do
|
|
begin
|
|
DatabaseName := RutaBD;
|
|
Params.Clear;
|
|
Params.Add('user_name=' + LowerCase('FACTUGES'));
|
|
Params.Add('password=' + LowerCase('FACTUGES'));
|
|
Params.Add('lc_ctype=ISO8859_1');
|
|
try
|
|
Screen.Cursor := crHourGlass;
|
|
Connected := True;
|
|
FTransaccionBD.StartTransaction;
|
|
finally
|
|
Screen.Cursor := crDefault;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TdmBaseDatos.ValidarPrivilegios: Boolean;
|
|
begin
|
|
//Por si en un futuro se desea establecer una politica de privilegios de usuario
|
|
//para cada empresa.
|
|
Result := True;
|
|
end;
|
|
|
|
procedure ActivarEdicionGridDetalles(var Grid : TdxDBGrid);
|
|
begin
|
|
if Grid = NIL then
|
|
Exit;
|
|
with Grid do
|
|
begin
|
|
OptionsDB := OptionsDB + [edgoCanAppend, edgoCanDelete, edgoCanInsert,
|
|
edgoConfirmDelete];
|
|
OptionsBehavior := OptionsBehavior + [edgoEditing, edgoImmediateEditor];
|
|
end
|
|
end;
|
|
|
|
procedure DesactivarEdicionGridDetalles(var Grid : TdxDBGrid);
|
|
begin
|
|
if Grid = NIL then
|
|
Exit;
|
|
with Grid do
|
|
begin
|
|
OptionsDB := OptionsDB - [edgoCanAppend, edgoCanDelete, edgoCanInsert,
|
|
edgoConfirmDelete];
|
|
OptionsBehavior := OptionsBehavior - [edgoEditing, edgoImmediateEditor];
|
|
end
|
|
end;
|
|
|
|
procedure TdmBaseDatos.IniciarTablasBackOffice;
|
|
begin
|
|
Application.CreateForm(TdmTablaProvincias, dmTablaProvincias);
|
|
Application.CreateForm(TdmTablaPoblaciones, dmTablaPoblaciones);
|
|
|
|
// Empresas
|
|
Application.CreateForm(TdmTablaEmpresas, dmTablaEmpresas);
|
|
end;
|
|
|
|
procedure ActivarEdicionGridDetalles(var vGrid: TcxGridDBTableView);
|
|
begin
|
|
if vGrid = NIL then
|
|
Exit;
|
|
with (vGrid as TcxCustomGridTableView) do
|
|
begin
|
|
OptionsBehavior.FocusCellOnTab := True;
|
|
OptionsBehavior.GoToNextCellOnEnter := True;
|
|
OptionsBehavior.ImmediateEditor := True;
|
|
OptionsBehavior.AlwaysShowEditor := False;
|
|
|
|
OptionsSelection.CellSelect := True;
|
|
OptionsSelection.InvertSelect := False;
|
|
OptionsSelection.HideFocusRect := False;
|
|
|
|
OptionsData.Appending := True;
|
|
OptionsData.Inserting := True;
|
|
OptionsData.Editing := True;
|
|
{ El borrado se debe controlar en cada pantalla para
|
|
que no salga el mensaje en inglés. }
|
|
OptionsData.Deleting := False;
|
|
OptionsData.DeletingConfirmation := False;
|
|
end
|
|
end;
|
|
|
|
procedure DesactivarEdicionGridDetalles(var Grid: TcxGridDBTableView);
|
|
begin
|
|
if Grid = NIL then
|
|
Exit;
|
|
with (Grid as TcxCustomGridTableView) do
|
|
begin
|
|
OptionsBehavior.FocusCellOnTab := True;
|
|
OptionsBehavior.GoToNextCellOnEnter := True;
|
|
OptionsBehavior.ImmediateEditor := False;
|
|
OptionsBehavior.AlwaysShowEditor := False;
|
|
|
|
OptionsSelection.CellSelect := False;
|
|
OptionsSelection.InvertSelect := False;
|
|
OptionsSelection.HideFocusRect := True;
|
|
|
|
OptionsData.Appending := False;
|
|
OptionsData.Deleting := False;
|
|
OptionsData.DeletingConfirmation := False;
|
|
OptionsData.Editing := False;
|
|
OptionsData.Inserting := False;
|
|
end
|
|
end;
|
|
|
|
procedure GetRecordsBookmarkList(AView: TcxGridDBTableView;
|
|
aBookMarkList: TList);
|
|
var
|
|
AFocusedRecord: TcxCustomGridRecord;
|
|
ADataSet: TDataSet;
|
|
I: Integer;
|
|
begin
|
|
aBookMarkList.Clear;
|
|
if not Assigned(AView) then
|
|
Exit;
|
|
ADataSet := AView.DataController.DataSet;
|
|
AView.BeginUpdate;
|
|
try
|
|
AFocusedRecord := AView.Controller.FocusedRecord;
|
|
for I := 0 to AView.Controller.SelectedRecordCount - 1 do
|
|
begin
|
|
AView.Controller.SelectedRecords[I].Focused := True;
|
|
aBookMarkList.Add(TBookMarkList(ADataSet.GetBookmark)); ;
|
|
end;
|
|
if Assigned(AFocusedRecord) then
|
|
AFocusedRecord.Focused := True;
|
|
finally
|
|
AView.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
end.
|