unit checa;

interface
uses dialogs;
function acceso(clav,directorio:String):integer;
function caso(usu,opcion:integer):Boolean;
function leeruta:String;
function leeempresa:String;
function comenta(nume:integer;archivo:string):string;
function fechavalida(fecha:String):Boolean;
function flotantevalido(flotante:String):Boolean;
function enterovalido(entero:String):Boolean;

function ruta(linea:integer):String;
function leetapiz(caso:integer):String;
function acceadmi(clav,directorio:String):Boolean;
procedure guardatapiz(archi:string;nume:integer);
function sonido(duracion:integer):Boolean;
function tipooperador(cadena:string):Char;
function ImpresoraLista : Boolean;
function redondear(cantidad:Currency):String;
function FormatosPais:Boolean;
function leecampos(inicio,numecampo:Integer):String;
function rangoscampos(archivo:string):LongInt;
function CambiaLetras(letra:char):char;


implementation

uses SysUtils,Dialogos;

//function CambiaLetras(letra:char):char;
//begin
//if letra=Char(39) then CambiaLetras:='-'
//else
//CambiaLetras:=letra;

//end;

//*******
function CambiaLetras(letra:Char):Char;
var
Cambiador:String;
begin
//Cambiador:='';
Cambiador:=Letra;
if (Ord(letra)>64)and(Ord(letra)<123) then
begin
if letra=Char(39) then CambiaLetras:='-'
else
begin
Cambiador:=UpperCase(Cambiador[1]);
CambiaLetras:=Cambiador[1];
end;

end
else
CambiaLetras:=letra;
end;








//********
function rangoscampos(archivo:string):LongInt;

var
i,conta,inicio,fin:integer;

begin

if archivo='clientes.cmp' then
begin
inicio:=1;
fin:=18;
end;

if archivo='proveedo.cmp' then
begin
inicio:=47;
fin:=61;

end;

if archivo='vendedor.cmp' then
begin
inicio:=31;
fin:=34;

end;

if archivo='facturae.cmp' then
begin
inicio:=74;
fin:=101;

end;

if archivo='comprase.cmp' then
begin
inicio:=135;
fin:=151;

end;

if archivo='cxp.cmp' then
begin
inicio:=295;
fin:=306;

end;

if archivo='cxc.cmp' then
begin
inicio:=268;
fin:=280;

end;


if archivo='inventar.cmp' then
begin
inicio:=228;
fin:=255;

end;
if archivo='movinven.cmp' then
begin
inicio:=185;
fin:=196;

end;

inicio:=inicio*1000;
rangoscampos:=inicio+fin;

end;



function leecampos(inicio,numecampo:Integer):String;

type
campos=record
numero:string[4];
campo:String[10];
descripcion:String[35];
tipo:String[10];
tamo:string[3];
tabla:string[15];
end;

var
dat:campos;
arch:file of campos;
i:integer;

begin
AssignFile(arch,leeruta+'\confcamp.cmp');
Reset(arch);
seek(arch,inicio);
read(arch,dat);

if numecampo=0 then
leecampos:=dat.numero;

if numecampo=1 then
leecampos:=dat.campo;


if numecampo=2 then
leecampos:=dat.descripcion;

if numecampo=3 then
leecampos:=dat.tipo;

if numecampo=4 then
leecampos:=dat.tamo;

if numecampo=5 then
leecampos:=dat.tabla;

CloseFile(arch);

end;


function FormatosPais:Boolean;
begin

try
{******fechas*******}
{DateOrder:= doDMY;}

DateSeparator:='/';
ShortDateFormat:='dd/MM/yyyy';
LongDateFormat:='dddd d de MMMM de aaaa';
{*****moneda****}
CurrencyFormat:=0;
NegCurrFormat:=0;
ThousandSeparator:=',';
DecimalSeparator:='.';
CurrencyDecimals:=2;

FormatosPais:=True;
except
FormatosPais:=False;
end;

{CurrencyFormat}


end;




function ImpresoraLista : Boolean;
Const
PrnStInt: Byte = $17;
StRq: Byte = $02;
PrnNum: Word = 0;{ 0 para LPT1, 1 para LPT2, etc. }
Var
nResult : byte;
Begin

Asm
   mov ah,StRq;
   mov dx,PrnNum;
   Int $17;
   mov nResult,ah;
end;
ImpresoraLista := (nResult and $80) = $80;
End;




function sonido(duracion:integer):Boolean;
var
i:integer;
begin
for i:=0 to duracion do
beep;
end;

function redondear(cantidad:Currency):String;
var
aux:String;
begin
{Str(cantidad:18:decimales,aux);}
aux:=FormatCurr('###########0.00',cantidad);

redondear:=aux;

end;

{function ruta(linea:integer):String;
var
arch:TextFile;
aux:string;
i:integer;

begin
AssignFile(arch,ruta(8)+'\Sistema\General.cnf');
Reset(arch);
for i:=1 to linea do
Readln(arch,aux);
CloseFile(arch);
ruta:=aux;
end;}

function enterovalido(entero:string):Boolean;
var
i:integer;
begin
for i:=1 to length(entero) do
begin
if ((Ord(entero[i])>47)and(Ord(entero[i])<58)) then
enterovalido:=True
else
enterovalido:=False;

end;

end;

function flotantevalido(flotante:string):Boolean;
var
i:integer;
begin
for i:=1 to length(flotante) do
begin

if ((Ord(flotante[i])>47)and(Ord(flotante[i])<58))or(flotante[i]='.') then
flotantevalido:=True
else
flotantevalido:=False;
if flotante='' then flotantevalido:=False;
end;
end;


function fechavalida(fecha:String):Boolean;
var
num,codigo,conta,i,a,m,d:integer;
aux:string;
begin
conta:=1;
aux:='';
fechavalida:=True;
if fecha<>'' then
begin
  val(fecha[1]+fecha[2],num,codigo);
  if codigo=0 then d:=num
  else
  fechavalida:=False;

  val(fecha[4]+fecha[5],num,codigo);
  if codigo=0 then m:=num
  else
  fechavalida:=False;
  if fecha[7]='_' then fecha[7]:='0';
  if fecha[8]='_' then fecha[8]:='0';

  val(fecha[7]+fecha[8]+fecha[9]+fecha[10],num,codigo);
  if codigo=0 then a:=num
  else
  fechavalida:=False;

  if (d>31)and(d<1) then fechavalida:=False;
  if (m>12)and(m<1) then fechavalida:=False;
  if a<0 then   fechavalida:=False;
end
else
fechavalida:=False;

  {
for i:=1 to length(fecha) do
begin
if fecha[i]='/' then
begin
  val(aux,num,codigo);
  if codigo<>0 then
  begin
  fechavalida:=False;
  aux:='';
  end
  else
  case conta of
    1:begin
    if num>31 then fechavalida:=False;
    aux:='';
    end;
    2:begin
    if num>12 then fechavalida:=False;
    aux:='';
    end;
  end;
  conta:=conta+1;
  aux:='';
end
else
aux:=aux+fecha[i];
end;

val(aux,num,codigo);
if codigo<>0 then fechavalida:=False;
if conta<3 then
fechavalida:=False;}

end;

procedure creaini;
var
unidad:string[1];
directorio:String;
begin
GetDir(0,directorio);
unidad:=directorio;
{SetCurrentDir(unidad+':\');}

end;

function leeempresa:String;
var
arch1:TextFile;
ruta:string;
begin
if FileExists('c:\sif2000.ini') then
begin
AssignFile(arch1,'c:\sif2000.ini');
reset(arch1);
Readln(arch1,ruta);
Readln(arch1,ruta);
CloseFile(arch1);
leeempresa:=ruta;
end
else
MuestraMensaje('El Archivo de Inicio No Existe Revise su configuración');

end;


function leeruta:String;
var
arch:TextFile;
ruta:string;
begin
if not (FileExists('c:\sif2000.ini')) then
begin
AssignFile(arch,'c:\sif2000.ini');
Rewrite(arch);
GetDir(0,ruta);
Writeln(arch,ruta);
CloseFile(arch);
end;

AssignFile(arch,'c:\sif2000.ini');
reset(arch);
Readln(arch,ruta);
CloseFile(arch);
leeruta:=ruta;
end;



function acceso(clav,directorio:String):integer;
type
datos=record
usuario:integer;
Empresa:String[2];
Nombre:String[60];
Clave:String[10];
modulos:String[50];
end;
var
dat:datos;
arch:file of datos;
i:integer;
aux:string;
begin
if FileExists(leeruta()+'\usuarios.def') then
begin
AssignFile(arch,leeruta()+'\usuarios.def');
Reset(arch);

for i:=0 to FileSize(arch)-1 do
begin
Read(arch,dat);

if dat.Clave=clav then
begin
acceso:=dat.usuario;
Break;
end
else
acceso:=-1;
end;
CloseFile(arch);
end
else
MuestraMensaje('El Archivo de Usuarios No Existe ');
end;

function acceadmi(clav,directorio:String):Boolean;
type
datos=record
usuario:integer;
Empresa:String[2];
Nombre:String[60];
Clave:String[10];
modulos:String[50];
end;
var
dat:datos;
arch:file of datos;
i:integer;
aux:string;
begin
if FileExists(leeruta()+'\usuarios.def') then
begin

AssignFile(arch,leeruta()+'\usuarios.def');
Reset(arch);
Seek(arch,0);
Read(arch,dat);

if dat.Clave=clav then
begin
acceadmi:=True;
end
else
acceadmi:=False;

CloseFile(arch);
end
else
MuestraMensaje('El Archivo de Usuarios No Existe ');

end;


function caso(usu,opcion:integer):Boolean;
type
datos=record
usuario:integer;
Empresa:String[2];
Nombre:String[60];
Clave:String[10];
modulos:String[50];
end;
var
dat:datos;
arch:file of datos;
i:integer;
aux,dire:string;
begin

GetDir(0,dire);

if FileExists(leeruta()+'\usuarios.def') then
begin
AssignFile(arch,leeruta()+'\usuarios.def');
Reset(arch);
if usu<=Filesize(arch) then
begin
Seek(arch,usu);
Read(arch,dat);
aux:=dat.modulos;
if aux[opcion]='s' then
caso:=True
else
begin
caso:=False;
MuestraMensaje('No Se Tiene Acceso...');
end;
end
else
caso:=false;
CloseFile(arch);
end
else
MuestraMensaje('El Archivo de Usuarios No Existe ');
end;

function comenta(nume:integer;archivo:string):string;
var
arch:TextFile;
linea:String;
i:integer;
begin
if FileExists(leeruta()+'\'+archivo) then
begin
AssignFile(arch,leeruta()+'\'+archivo);
Reset(arch);
for i:=1 to nume do
Readln(arch,linea);
CloseFile(arch);
comenta:=linea;
end
else
MuestraMensaje('El Archivo '+archivo+' No Existe');

end;

function ruta(linea:integer):String;
var
arch:TextFile;
aux,directorioactual:string;
i:integer;
begin
{GetDir(0,directorioactual);}
if FileExists(leeempresa) then
begin
AssignFile(arch,leeempresa);
Reset(arch);
for i:=1 to linea do
Readln(arch,aux);
CloseFile(arch);
ruta:=aux;
end
else
MuestraMensaje('El Archivo '+leeempresa+' No Existe');
end;


function leetapiz(caso:integer):string;
type
tapices=record
archivo:String[124];
end;

var
tap:tapices;
arch:File of Tapices;
i:integer;
begin

end;

procedure guardatapiz(archi:string;nume:integer);
type
tapices=record
archivo:String[124];
end;

var
tap:tapices;
arch:File of Tapices;
i:integer;

begin

end;

function tipooperador(cadena:string):Char;
begin
if cadena='=' then tipooperador:='=';
if cadena='<' then tipooperador:='<';
if cadena='>' then tipooperador:='>';
if cadena='<>' then tipooperador:='X';
if cadena='<=' then tipooperador:='Y';
if cadena='>=' then tipooperador:='Z';
end;



end.