Cadastro Empresarial
Publicado por Ivan Rocha 19/12/2006
[ Hits: 7.107 ]
Homepage: http://homes.dcc.ufba.br/~ivan062/bahia
Programa que cadastra Funcionários, Setores e Folhas de Pagamento, trabalhando com arquivos nas três situações.
{ Universidade Federal da Bahia
Bacharelado em Ciencia da Computaçao
MAT146 - Introduçao a Logica de Programaçao
Alunos: Gabriel Oliveira Barreto
Ivan Carmo da Rocha Neto
PROGRAMA COMPILADO PARA LINUX}
program projetofinal;
uses crt;
type
func = record
matricula: integer; {Nao pode haver matriculas iguais}
nome: string[80];
setor: integer;
{numero: integer;
nome_set: string[80];}{Validar se o setor existe;}
{end;}
data_nasc: string[10];
data_adm: string[10]; {Validar se as datas informadas sao validas (usar funcoes de manipulacao de strings);}
salario: real;
flag: integer;
end;
setor = record
numero: integer; {Nao pode haver numeros iguais;}
nome: string[80];
flag: integer;
end;
fopag = record
mes: 1..12; {(inteiro 1 a 12)}
ano: 1900..2100; {(inteiro 1990 a 2100)}
matricula: integer; {Nao pode haver registros com o mesmo o trio mes, ano e matriculas iguais}
salario: real;
setor: integer;
flag: integer;
end;
var
filefunc: file of func; {arquivo de funcionarios}
varfunc, aux_func: func; {variavel funcionarios}
filesetor: file of setor; {arquivo setores}
varsetor, aux_setor: setor; {variavel setores}
filefopag: file of fopag;
varfopag, aux_fopag: fopag;
matr, existe_setor, mes_folha, ano_folha, existe_folha, existe_func, num_setor, num_temp , existe_matricula, achou_flag0, func_cadastrado: integer; {num_setor - validar o cadastro de setores, Op - Opcao, matr - usada para validar a matricula, num_set - usado para validar o cadastro de funcionarios}
esc, op, resp: char; {esc - escolha}
achou: boolean; {usada para as buscas}
{nomefunc: string[80];}
procedure TestNum(var numero:real); {Procedure para nao aceitar cadastros menores que 1}
var x,y:integer;
a: real;
(***************************************************)
procedure testeInt;
var n,error:integer;
st:string;
(*******************************)
procedure erro;
begin
gotoxy(x+12,y);
write('Valor incorreto, digite novamente!!!');
delay(1500);
gotoxy(x,y);
clreol;
TestNum(a) {*}
end;
(*******************************)
begin
readln(st);
val(st,n,error);
if (n>=1) and (error=0) then
numero:=n
else
erro
end;
(**********************************************************)
begin
x:=wherex;
y:=wherey;
TestNum(a) {*}
end;
(**********************************************************)
procedure TestSal(var valor:real); {procedure para nao aceitar salario menor que 0,01}
var x,y:integer;
a: real;
(***************************************************)
procedure testereal;
var n,w:real;
error:integer;
st:string;
(*******************************)
procedure erro;
begin
gotoxy(x+12,y);
write('Valor incorreto, digite novamente!!!');
delay(1500);
gotoxy(x,y);
clreol;
Testereal
end;
(*******************************)
begin
readln(st);
val(st,n,error);
if (n>=(1/100)) and (error=0) then
valor:=n
else
erro
end;
(**********************************************************)
begin
x:=wherex;
y:=wherey;
testereal
end;
(**********************************************************)
procedure TestDat(var Data1:string[10]); {Procedure para as DATAS}
var x,y:integer;
(***********************************)
procedure TestData;
var Data:string[10];
sDia,sMes,sAno:string[2];
dia,mes,ano,erroD,erroM,erroA:integer;
(************************************************)
procedure erro;
begin
gotoxy(x,y);
write('Data incorreta digite novamente!!!');
delay(1500);
gotoxy(x,y);
clreol;
TestData
end;
(************************************************)
begin
readln(data);
sDia:=data[1]+data[2];
sMes:=data[4]+data[5];
sAno:=data[7]+data[8]+data[9]+data[10];
val(sDia,Dia,erroD);
val(sMes,mes,erroM);
val(sAno,ano,erroA);
if (erroD=0) and (erroM=0) and (erroA=0) and (data[3]='/') and (data[6]='/') and (data[0]<>'10') then
case mes of
1,3,5,7,8,10,12:begin
if not (dia in [1..31]) then
erro
else
Data1:=data
end;
4,6,9,11:begin
if not (dia in [1..30]) then
erro
else
Data1:=data
end;
2:begin
if (ano mod 4 =0) {and (not (dia in [1..29]))} then
if not (dia in [1..29]) then
erro
else
Data1:=data
else
if ano mod 4<>0{not (dia in [1..28])} then
if not (dia in [1..28]) then
erro
else
Data1:=data
end;
else
erro
end
else
erro
end;
(***********************************)
begin
x:=wherex;
y:=wherey;
TestData
end;
(**********************************)
function inss (salario:real):real; {function para o calculo de INSS}
const
aliq1=0.0765;
aliq2=0.0865;
aliq3=0.09;
aliq4=0.11;
teto=275.96;
var
var_inss:real;
begin
if (salario>=0.01) and (salario<=752.62) then
var_inss:=salario*aliq1;
if (salario>=752.63) and (salario<=780.00) then
var_inss:=salario*aliq2;
if (salario>=780.01) and (salario<=1254.36) then
var_inss:=salario*aliq3;
if (salario>=1254.37) and (salario<=2508.72) then
var_inss:=salario*aliq4;
if (salario>=2508.73) then
var_inss:=teto;
inss:=var_inss;
end;
function irrf (salario:real):real; {Funcao para o calculo de IRRF}
const
aliq1 = 0;
aliq2 = 0.15;
aliq3 = 0.275;
var
imposto:real;
begin
if (salario>=0.01) and (salario<=1058.00) then
imposto:=salario*aliq1;
if (salario>=1058.01) and (salario<=2115.00) then
imposto:=salario*aliq2;
if (salario>=2115.01) then
imposto:=salario*aliq3;
irrf:=imposto;
end;
procedure validaflagfolha; {Procura o flag 0 (remocao logica) para cadastrar por cima do registro onde esta o flag 0}
begin
reset(filefopag);
seek(filefopag,0);
if filesize(filefopag) <> 0 then
begin
achou_flag0 := 0; {flag 0 siginifica que foi removido logicamente, quando ele acha ele}
repeat {posiciona o cursor acima do registro para ser sobreposto}
begin
read(filefopag, aux_fopag);
if aux_fopag.flag = 0 then
achou_flag0 := 1;
end;
until (eof(filefopag)) or (achou_flag0 =1);
end;
{else
achou_flag0 := 0;}
if achou_flag0 = 1 then
seek(filefopag,filepos(filefopag)-1) {posiciona o cursor um registro acima para o registro de baixo ser sobreposto}
else
seek(filefopag,filesize(filefopag));
end;
procedure validaflagfunc; {Procura o flag 0 (remocao logica) para cadastrar por cima do registro onde esta o flag 0}
begin {Idem ao flag da folha}
seek(filefunc,0);
if filesize(filefunc) <> 0 then
begin
achou_flag0 := 0;
repeat
begin
read(filefunc, aux_func);
if aux_func.flag = 0 then
achou_flag0 := 1;
end;
until (eof(filefunc)) or (achou_flag0 =1);
end;
if achou_flag0 = 1 then
seek(filefunc,filepos(filefunc)-1)
else
seek(filefunc,filesize(filefunc));
end;
procedure validaflagsetor; {Procura o flag 0 (remocao logica) para cadastrar por cima do registro onde esta o flag 0}
begin {IDEM aos flags da folha e dos funcionarios}
seek(filesetor,0);
if filesize(filesetor) <> 0 then
begin
achou_flag0 := 0;
repeat
begin
read(filesetor, aux_setor);
if aux_setor.flag = 0 then
achou_flag0 := 1;
end;
until (eof(filesetor)) or (achou_flag0 =1);
end;
if achou_flag0 = 1 then
seek(filesetor,filepos(filesetor)-1)
else
seek(filesetor,filesize(filesetor));
end;
procedure existefolha; {Procedure feita para reconhecer que nao ha folhas cadastradas, devido a remocao logica}
begin {se o mes e o ano digitados ja estiverem no registro, nao serao aceitos, pois o programa fara uma varredura no arquivo}
reset(filefopag);
if filesize(filefopag) = 0 then
existe_folha :=0
else
begin
existe_folha := 0;
seek(filefopag,0);
repeat
begin
read(filefopag, varfopag);
if (mes_folha = varfopag.mes) {and (ano_folha = varfopag.ano) and (varfopag.flag = 1)} then
begin
if (ano_folha = varfopag.ano) and (varfopag.flag = 1) then
existe_folha := 1;
end;
end;
until (eof(filefopag)) or (existe_folha = 1);
end;
end;
procedure existesetor; {Procedure feita para reconhecer que nao ha setores cadastrados, devido a remocao logica}
begin {IDEM ao existe folha}
reset(filesetor);
if filesize(filesetor) = 0 then
existe_setor :=0
else
begin
existe_setor :=0;
seek(filesetor,0);
repeat
begin
read(filesetor,varsetor);
if varsetor.flag = 1 then
existe_setor := 1;
end;
until (eof(filesetor)) or (existe_setor =1);
end;
end;
procedure existefuncionario; {Procedure feita para reconhecer que nao ha funcionarios cadastrados, devido a remocao logica}
begin {IDEM aos existesetor e existe funcionario}
reset(filefunc);
if filesize(filefunc) = 0 then
existe_func := 0
else
begin
existe_func :=0;
seek(filefunc,0);
repeat
begin
read(filefunc,varfunc);
if varfunc.flag = 1 then
existe_func := 1;
end;
until (eof(filefunc)) or (existe_func =1);
end;
end;
procedure localizamat; {Procedure localiza matricula para nao permitir cadastramento de duas matriculas iguais}
begin
existe_matricula :=0;
writeln('MATRICULA: ');
readln(matr);
seek(filefunc,0);
repeat
begin
read(filefunc,varfunc);
if (matr = varfunc.matricula) and (varfunc.flag = 1) then
existe_matricula := 1;
end;
until (eof(filefunc)) or (existe_matricula =1);
seek(filefunc,filepos(filefunc)-1);
end;
procedure localizasetor; {Procedure localiza setor para nao permitir o cadastramento de dois setores iguais}
begin
existe_matricula :=0;
writeln('NUMERO DO SETOR: ');
readln(matr);
seek(filesetor,0);
repeat
begin
read(filesetor,varsetor);
if (matr = varsetor.numero) and (varsetor.flag = 1) then
existe_matricula := 1;
end;
until (eof(filesetor)) or (existe_matricula =1);
seek(filesetor,filepos(filesetor)-1);
end;
procedure cadastrofunc; {procedure para o cadastro de funcionarios}
begin
existesetor;
if existe_setor <> 0 then
begin
repeat
clrscr;
reset(filefunc);
writeln('===== Cadastro de Funcionarios =====');
writeln;
{validaflagfunc;}
write('MATRICULA: ');
readln(matr);
if matr <> 9999 then
begin
while not eof(filefunc) do {enquanto nao chega ao fim... vai olhando registro por registro, a finalidade sera vista a seguir}
begin
read(filefunc, varfunc);
if (matr= varfunc.matricula) and (varfunc.flag = 1) then {faz o loop e volta ao inicio do arquivo no comando "seek" para verificar e so permitir o numero de matricula se ja nao estiver um gravado no registro}
begin
writeln;
writeln('Ja existe Funcionario cadastrado com essa Matricula! '); {Fazer rotina para listar o funcionario cadastrado com essa matricula}
writeln('Pressione qualquer tecla para continuar. ');
readkey;
clrscr;
writeln('===== Cadastro de Funcionarios =====');
writeln;
write('MATRICULA: ');
readln(matr);
seek(filefunc,0); {coloca o arquivo na posicao inicial para executar a varredura outra vez}
end;
end;
varfunc.matricula := matr;
write('NOME: ');
readln(varfunc.nome);
write('SETOR (9999 Lista os Setores): ');
readln({varfunc.setorsetor.numero}num_temp);
achou := false;
while (achou=false) or (num_temp<0) do {Lista setores cadastrados, buscando no arquivo de setor}
begin
reset(filesetor);
writeln('Setores Cadastrados: ');
seek(filesetor,0);
while (eof(filesetor)=false) do
begin
if (varsetor.flag =1) then
writeln(varsetor.numero,' - ',varsetor.nome);
{writeln;}
read(filesetor,varsetor);
if (varsetor.numero = num_temp) and (varsetor.flag = 1) then
achou:=true;
{seek(filesetor,0);}
end;
if (achou=false) or (num_temp<0) then
begin
if num_temp <> 9999 then
begin
writeln;
writeln('Setor nao cadastrado! ');
writeln('Digite novamente! ');
end;
writeln('Pressione Qualquer tecla...');
readkey;
clrscr;
writeln('===== Cadastro de Funcionarios =====');
writeln;
writeln('MATRICULA: ',varfunc.matricula);
writeln('NOME: ',varfunc.nome);
writeln('SETOR (9999 Lista Setores): '); {FALTA associar o numero do setor aqui com o numero do setor no cadastro de setores}
readln(num_temp);
end;
end;
seek(filesetor,0);
writeln;
varfunc.setor:=num_temp; {Depois de verificar e validar setores cadastrados, finalmente armazena valor temporario}
write('DATA DE NASCIMENTO: ');
TestDat(varfunc.data_nasc);
write('DATA DE ADMISSAO: ');
TestDat(varfunc.data_adm);
write('SALARIO: ');
readln(varfunc.salario);
validaflagfunc; {Execucao da procedure}
if achou_flag0 = 1 then
seek(filefunc,filepos(filefunc)-1)
else
seek(filefunc,filesize(filefunc));
varfunc.flag := 1;
write(filefunc,varfunc); {Escreve todas as "partes do registro" no arquivo}
end
else
begin
writeln('Numero de Cadastro Invalido!');
writeln('Cadastre outro numero!');
delay(2000);
end;
writeln;
writeln('Q. SAIR; ');
writeln('OUTRA TECLA: CADASTRAR OUTRO FUNCIONARIO. ');
writeln;
esc:= upcase(readkey);
until esc = 'Q';
reset(filefunc);
end {fim do if que verifica se ja existem setores cadastrados}
else
begin
writeln('Setores nao cadastrados!');
writeln('Cadastrar Setores Primeiro!');
delay(2500);
end;
end;
procedure cadastrosetor; {procedure para o cadastro de setores}
begin
repeat
clrscr;
reset(filesetor);
writeln('===== Cadastro de Setores =====');
writeln;
write('NUMERO DO SETOR: ');
readln(num_setor);
if num_setor <> 9999 then
begin
while not eof(filesetor) do
begin
read(filesetor, varsetor);
if (num_setor = varsetor.numero) and (varsetor.flag = 1) then
begin
writeln;
writeln('Ja existe Setor cadastrado com esse numero! ');
writeln('Pressione qualquer tecla para continuar. ');
readkey;
clrscr;
writeln('===== Cadastro de Setores =====');
writeln;
write('NUMERO DO SETOR: ');
readln(num_setor);
seek(filesetor,0); {coloca o arquivo na posicao inicial para executar a varredura outra vez}
end;
end;
varsetor.numero := num_setor;
write('NOME DO SETOR: ');
readln(varsetor.nome);
varsetor.flag := 1;
validaflagsetor;
write(filesetor,varsetor); {Escreve todas as "partes do registro" no arquivo}
writeln;
reset(filesetor);
end
else
begin
writeln;
writeln('Numero de Cadastro Invalido!');
writeln('Cadastre outro numero!');
delay(2000);
end;
writeln('Q. SAIR; ');
writeln('Outra Tecla: Cadastrar Outro Setor. ');
writeln;
esc:= upcase(readkey);
until esc = 'Q';
reset(filesetor);
end;
procedure alterarfunc; {Procedure para a alteracao de funcionarios no arquivo}
var
novo_nome : string[30];
novo_setor: integer;
nova_data_nasc: string[10];
nova_data_adm: string[10];
novo_salario: real;
begin
clrscr;
existefuncionario;
writeln('===== Alteracao de Funcionarios =====');
writeln;
reset(filefunc);
if existe_func <>1 then {COLOCAR FLAG}{ok}
begin
writeln('Nao ha funcionarios cadastrados! ');
writeln('Cadastrar Funcionarios Primeiro! ');
delay(2500);
end
else
begin
repeat
reset(filefunc);
seek(filefunc,0);
clrscr;
writeln('===== Alteracao de Funcionarios =====');
writeln;
writeln('Digite 9999 se quiser SAIR. ');
writeln;
localizamat; {Executa procedure para ver se existe funcionario cadastrado}
if existe_matricula = 1 then
begin
writeln('Matricula encontrada!');
writeln;
writeln('MATRICULA: ',varfunc.matricula);
writeln('NOME: ',varfunc.nome);
writeln('SETOR: ',varfunc.setor);
writeln('DATA DE NASCIMENTO: ',varfunc.data_nasc);
writeln('DATA DE ADMISSAO: ',varfunc.data_adm);
writeln('SALARIO: ',varfunc.salario:10:2);
writeln;
write('Deseja efetuar alteracao? [S/N]: ');
readln (resp);
if (resp = 's') or (resp = 's') then
begin
write('NOME: ');
readln(novo_nome);
write('SETOR (9999 Lista Setores): ');
readln(num_temp);
achou := false;
while (achou=false) or (num_temp<0) do {Verifica setores validos para poder alterar}
begin
reset(filesetor);
writeln('Setores Cadastrados: ');
seek(filesetor,0);
while (eof(filesetor)=false) do
begin
if (varsetor.flag = 1) then;
writeln(varsetor.numero,' - ',varsetor.nome);
read(filesetor,varsetor);
if (varsetor.numero = num_temp) and (varsetor.flag = 1) then
achou:=true;
{seek(filesetor,0);}
end;
if (achou=false) or (num_temp<0) then
begin
if num_temp <> 9999 then
begin
writeln;
writeln('Setor nao cadastrado! ');
writeln('Digite novamente! ');
end;
writeln('Pressione qualquer tecla...');
readkey;
writeln;
writeln('SETOR (9999 Lista Setores): ');
readln(num_temp);
end;
end;
seek(filesetor,0);
writeln;
novo_setor:=num_temp;
write('DATA DE NASCIMENTO: ');
TestDat(nova_data_nasc);
write('DATA DE ADMISSAO: ');
TestDat(nova_data_adm);
write('SALARIO: ');
readln(novo_salario);
write('Confirma Alteracao? [S/N]: ');
readln(resp);
if (resp = 'S') or (resp = 's') then
begin
varfunc.nome := novo_nome;
varfunc.setor := novo_setor;
varfunc.data_nasc := nova_data_nasc;
varfunc.data_adm := nova_data_adm;
varfunc.salario := novo_salario;
write(filefunc, varfunc);
writeln;
writeln('Funcionario Alterado com Sucesso! ');
end;
close(filefunc);
write('Pressione qualquer tecla para continuar...');
readkey;
end;
end
else
if matr = 9999 then
begin
writeln;
writeln('9999. Codigo de Saida...');
writeln('Saindo! Pressione qualquer tecla...');
readkey;
end
else
begin
writeln('Matricula nao encontrada! ');
write('Pressione qualquer tecla para continuar... ');
readkey;
end;
until (matr = 9999);
end;
end;
procedure alterarsetor; {Procedure para a alteracao de setores no arquivo}
var
novo_nome_set : string[30];
begin
clrscr;
existesetor;
writeln('===== Alteracao de Setores =====');
writeln;
reset(filesetor);
if existe_setor <> 1 then
begin
writeln('Nao ha setores cadastrados! ');
writeln('Cadastrar Setores Primeiro! ');
delay(2500);
end
else
begin
repeat
reset(filesetor);
seek(filesetor,0);
clrscr;
writeln('===== Alteracao de Setores =====');
writeln;
writeln('Digite 9999 se quiser SAIR. ');
writeln;
localizasetor;
if existe_matricula = 1 then
begin
writeln('Setor Encontrado!');
writeln;
writeln('NUMERO DO SETOR: ',varsetor.numero);
writeln('NOME DO SETOR: ',varsetor.nome);
writeln;
write('Deseja efetuar alteracao? [S/N]: ');
readln (resp);
if (resp = 's') or (resp = 's') then
begin
write('NOME DO SETOR: ');
readln(novo_nome_set);
write('Confirma Alteracao? [S/N]: ');
readln(resp);
if (resp = 'S') or (resp = 's') then
begin
varsetor.nome := novo_nome_set;
write(filesetor, varsetor);
writeln;
writeln('Setor Alterado com Sucesso! ');
end;
close(filesetor);
write('Pressione qualquer tecla para continuar...');
readkey;
end;
end
else
if matr = 9999 then
begin
writeln;
writeln('9999. Codigo de Saida...');
writeln('Saindo! Pressione qualquer tecla...');
readkey;
end
else
begin
writeln('Setor nao encontrado! ');
write('Pressione qualquer tecla para continuar... ');
readkey;
end;
until (matr = 9999);
end;
end;
procedure removerfunc; {Procedure para a remocao logica de funcionarios no arquivo}
begin
clrscr;
existefuncionario;
writeln('===== Remocao de Funcionarios =====');
writeln;
reset(filefunc);
if existe_func <>1 then
begin
writeln('Nao ha funcionarios cadastrados! ');
writeln('Cadastrar Funcionarios Primeiro! ');
delay(2500);
end
else
begin
repeat
reset(filefunc);
seek(filefunc,0);
clrscr;
writeln('===== Remocao de Funcionarios =====');
writeln;
writeln('Digite 9999 se quiser SAIR. ');
writeln;
localizamat;
if existe_matricula = 1 then
begin
writeln('Matricula encontrada!');
writeln;
writeln('MATRICULA: ',varfunc.matricula);
writeln('NOME: ',varfunc.nome);
writeln('SETOR: ',varfunc.setor);
writeln('DATA DE NASCIMENTO: ',varfunc.data_nasc);
writeln('DATA DE ADMISSAO: ',varfunc.data_adm);
writeln('SALARIO: ',varfunc.salario:10:2);
writeln;
write('Deseja remover este funcionario? [S/N]: ');
readln (resp);
if (resp = 's') or (resp = 's') then
begin
varfunc.flag := 0; {O flag eh essencial para remocoes logicas no arquivo}
write(filefunc, varfunc);
writeln;
writeln('Funcionario Removido com Sucesso! ');
end;
close(filefunc);
write('Pressione qualquer tecla para continuar...');
readkey;
end
else
if matr = 9999 then
begin
writeln;
writeln('9999. Codigo de Saida...');
writeln('Saindo! Pressione qualquer tecla...');
readkey;
end
else
begin
writeln('Matricula nao encontrada! ');
write('Pressione qualquer tecla para continuar... ');
readkey;
end;
until (matr = 9999);
end;
end;
procedure removersetor; {Procedure para a remocao logica de setores no arquivo}
begin
clrscr;
existesetor;
writeln('===== Remocao de Setores =====');
writeln;
reset(filesetor);
if existe_setor <> 1 then
begin
writeln('Nao ha setores cadastrados! ');
writeln('Cadastrar Setores Primeiro! ');
delay(2500);
end
else
begin
repeat
reset(filesetor);
seek(filesetor,0);
clrscr;
writeln('===== Remocao de Setores =====');
writeln;
writeln('Digite 9999 se quiser SAIR. ');
writeln;
localizasetor;
if existe_matricula = 1 then
begin
writeln('Setor Encontrado!');
writeln;
writeln('NUMERO DO SETOR: ',varsetor.numero);
writeln('NOME DO SETOR: ',varsetor.nome);
writeln;
func_cadastrado:=0; {simplesmente busca o setor, posiciona na posicao -1 do registro e coloca o flag como 0}
reset(filefunc);
seek(filefunc,0);
repeat
begin
read(filefunc,varfunc);
if (matr = varfunc.setor) and (varfunc.flag = 1) then
func_cadastrado := 1;
end;
until (eof(filefunc)) or (func_cadastrado = 1);
if func_cadastrado = 1 then
begin
writeln('Ha funcionarios cadastrados neste setor!!!');
writeln('Remova os Funcionarios deste Setor ou mude-os de Setor antes de remover este Setor!');
writeln;
writeln('Pressione qualquer tecla...');
readkey;
end
else
begin
write('Deseja remover este setor? [S/N]: ');
readln (resp);
if (resp = 's') or (resp = 's') then
begin
varsetor.flag :=0;
write(filesetor, varsetor);
writeln;
writeln('Setor Removido com Sucesso! ');
end;
close(filesetor);
write('Pressione qualquer tecla para continuar...');
readkey;
end
end
else
if matr = 9999 then
begin
writeln;
writeln('9999. Codigo de Saida...');
writeln('Saindo! Pressione qualquer tecla...');
readkey;
end
else
begin
writeln('Setor nao encontrado! ');
write('Pressione qualquer tecla para continuar... ');
readkey;
end;
until (matr = 9999);
end;
end;
procedure gerafolha; {Procedure para a remocao logica de folhas de pagamento}
begin
clrscr;
existefuncionario;
existesetor;
writeln('===== Geracao de Folha de Pagamento =====');
writeln;
if (existe_setor = 0) or (existe_func = 0) then
begin
if (existe_func = 0) then
begin
writeln;
writeln('Nao Ha funcionarios Cadastrados!!!');
writeln('Cadastrar Funcionarios Primeiro!');
delay(2000);
end;
if (existe_setor = 0) then
begin
writeln;
writeln('Nao Ha Setores Cadastrados!!!');
writeln('Cadastrar Setores Primeiro!');
delay(2000);
end
end
else
begin
repeat
reset(filefopag);
clrscr;
writeln('===== Geracao de Folha de Pagamento =====');
writeln;
writeln('Digite 0 para MES se quiser SAIR');
writeln;
writeln('MES: ');
read(mes_folha);
if mes_folha <> 0 then
begin
writeln('ANO: ');
read(ano_folha);
writeln;
existefolha; {Roda a procedure existe folha de pagamento}
if (existe_folha = 1) then
begin
writeln('Folha ja Feita!');
writeln('Cadastre a Folha de Outro Mes/Ano! ');
delay(2000);
end
else
begin
write('Deseja Cadastrar Folha dos meses e anos informados? [S/N] ');
readln;
readln(resp);
if (resp='s') or (resp='S') then
begin
reset(filefunc);
seek(filefunc,0);
repeat
read(filefunc,varfunc);
if varfunc.flag <> 0 then {copia tudo do arquivo de funcionarios}
begin
varfopag.mes := mes_folha;
varfopag.ano := ano_folha;
varfopag.flag := 1;
varfopag.matricula := varfunc.matricula;
varfopag.salario := varfunc.salario;
varfopag.setor := varfunc.setor;
end;
write(filefopag, varfopag);
seek(filefopag,filesize(filefopag));
until eof(filefunc);
writeln;
writeln('Cadastro realizado com Sucesso! ');
writeln('Pressione qualquer tecla... ');
writeln;
reset(filefopag);
repeat
read(filefopag,varfopag);
if (varfopag.flag =1) and (mes_folha = varfopag.mes) then
begin
if (ano_folha = varfopag.ano) then
begin {Lista depois do cadastro}
writeln;
writeln('MES: ',varfopag.mes);
writeln('ANO: ',varfopag.ano);
writeln('FUNCIONARIO (MATRICULA): ',varfopag.matricula);
writeln('SALARIO: ',varfopag.salario:10:2);
end;
end;
until (eof(filefopag));
writeln;
writeln('Pressione qualquer tecla... ');
readkey;
end;
end;
end
else
begin
writeln;
writeln('0. Codigo de Saida...');
writeln('Saindo! Pressione qualquer tecla...');
readkey;
end;
until (mes_folha) = 0;
end;
end;
procedure removerfolha; {Procedure para a remocao logica de folhas de pagamento}
begin {simplesmente faz as buscas e coloca o flag como 0 (removido logicamente)}
clrscr;
writeln('===== Remocao de Folha de Pagamento =====');
writeln;
reset(filefopag);
if filesize(filefopag) = 0 then
begin
writeln('Nao ha folhas cadastradas! ');
writeln('Cadastrar Folhas Primeiro! ');
delay(2500);
end
else
begin
repeat
reset(filefopag);
seek(filefopag,0);
clrscr;
writeln('===== Remocao de Folha de Pagamento =====');
writeln;
writeln('Digite 0 se quiser SAIR. ');
writeln;
writeln('MES: ');
read(mes_folha);
if mes_folha <> 0 then
begin
writeln('ANO: ');
read(ano_folha);
writeln;
existefolha;
if (existe_folha = 1) then
begin
writeln('Folha Encontrada!');
seek(filefopag,0);
repeat
read(filefopag,varfopag);
if (existe_folha = 1) then
begin
if (varfopag.flag =1) and (mes_folha = varfopag.mes) then
begin
if (ano_folha = varfopag.ano) then
begin
writeln;
writeln('MES: ',varfopag.mes);
writeln('ANO: ',varfopag.ano);
writeln('FUNCIONARIO (MATRICULA): ',varfopag.matricula);
writeln('SALARIO: ',varfopag.salario:10:2);
end;
end;
end;
until eof(filefopag);
readln;
write('Deseja remover esta folha? [S/N]: ');
readln (resp);
if (resp = 's') or (resp = 's') then
begin
existefolha;
seek(filefopag,0);
repeat
read(filefopag,varfopag);
if (varfopag.flag = 1) and (mes_folha = varfopag.mes) and (ano_folha = varfopag.ano) then
begin
seek(filefopag,filepos(filefopag)-1); {posiciona no -1 para colocar flag 0 no lugar correto}
varfopag.flag := 0;
write(filefopag, varfopag);
end;
until eof(filefopag);
writeln;
writeln('Folha Removida com Sucesso! ');
end;
write('Pressione qualquer tecla para continuar...');
readkey;
end
else
begin
writeln('Folha nao encontrada! ');
write('Pressione qualquer tecla para continuar... ');
readkey;
end;
end
else
begin
writeln;
writeln('0. Codigo de Saida...');
writeln('Saindo! Pressione qualquer tecla...');
readkey;
end
until (mes_folha = 0);
end;
end;
procedure funcporsetor; {Procedure para a listagem de funcionarios por setor digitado}
begin
clrscr;
existefuncionario;
existesetor;
writeln('===== Listagem de Funcionarios por Setor =====');
writeln;
if (existe_setor = 0) or (existe_func = 0) then
begin
if (existe_func = 0) then
begin
writeln;
writeln('Nao Ha funcionarios Cadastrados!!!');
writeln('Cadastrar Funcionarios Primeiro!');
delay(2000);
end;
if (existe_setor = 0) then
begin
writeln;
writeln('Nao Ha Setores Cadastrados!!!');
writeln('Cadastrar Setores Primeiro!');
delay(2000);
end
end
else
repeat
clrscr;
writeln('===== Listagem de Funcionarios por Setor =====');
writeln;
writeln('Digite 9999 para SETOR se quiser SAIR');
writeln;
writeln('SETOR: ');
read(num_setor);
if num_setor <> 9999 then
begin
reset(filesetor);
writeln;
achou:=false;
while not eof(filesetor) do
begin
read(filesetor,varsetor);
if (num_setor = varsetor.numero) and (varsetor.flag = 1) then
begin
writeln('Funcionarios Cadastrados no Setor ',varsetor.numero,' - ',varsetor.nome,' : ');
writeln;
achou:=true;
end;
end;
if achou = true then
begin
reset(filefunc);
seek(filefunc,0);
existe_func := 0;
repeat
read(filefunc,varfunc);
if (num_setor = varfunc.setor) and (varfunc.flag = 1) then
existe_func := 1; {verifica se existe funcionario}
until (eof(filefunc)) or (existe_func =1);
if existe_func = 1 then
begin
seek(filefunc,0);
repeat
if (existe_func = 1) then {se SIM ele lista}
begin
read(filefunc,varfunc);
if (num_setor = varfunc.setor) and (varfunc.flag = 1) then
begin
writeln('MATRICULA: ',varfunc.matricula);
writeln('NOME: ',varfunc.nome);
writeln('SETOR: ',varfunc.setor);
writeln('DATA DE NASCIMENTO: ',varfunc.data_nasc);
writeln('DATA DE ADMISSAO: ',varfunc.data_adm);
writeln('SALARIO: ',varfunc.salario:10:2);
writeln;
end;
end;
until eof(filefunc);
end
else
begin
writeln('Nao ha Funcionarios cadastrados neste Setor!');
writeln;
end;
writeln('Pressione Qualquer tecla...');
readkey;
end
else
begin
writeln('Setor nao cadastrado!!!');
writeln('Digite outro setor!');
writeln;
writeln('Pressione Qualquer tecla...');
readkey;
end;
end
else
begin
writeln;
writeln('9999. Codigo de Saida...');
writeln('Saindo! Pressione qualquer tecla...');
readkey;
end;
until (num_setor) = 9999;
end;
procedure funcpornome; {Procedure para a listagem de funcionarios por nome}
var
pos, pos2: integer;
begin
clrscr;
existefuncionario; {verifica se existe funcionarios e setores}
existesetor;
writeln('===== Listagem de Funcionarios por Nome =====');
writeln;
if (existe_setor = 0) or (existe_func = 0) then
begin
if (existe_func = 0) then
begin
writeln;
writeln('Nao Ha funcionarios Cadastrados!!!');
writeln('Cadastrar Funcionarios Primeiro!');
delay(2000);
end;
if (existe_setor = 0) then
begin
writeln;
writeln('Nao Ha Setores Cadastrados!!!');
writeln('Cadastrar Setores Primeiro!');
delay(2000);
end
end
else
begin
clrscr;
writeln('===== Listagem de Funcionarios por Nome =====');
writeln;
reset(filefunc);
seek(filefunc,0);
reset(filesetor);
for pos2 := 0 to (filesize(filefunc) - 2) do
begin
for pos :=0 to (filesize(filefunc) - 2) do
begin
seek(filefunc,pos);
read(filefunc,varfunc);
read(filefunc,aux_func);
if upcase(varfunc.nome) > upcase(aux_func.nome) then
begin
seek(filefunc,pos);
write(filefunc,aux_func); {se um nome for "maior" que o outro, ele escreve invertido no arquivo}
write(filefunc,varfunc); {usando variaveis auxiliares}
end;
end;
end;
seek(filefunc,0); {logo apos, lista tudo, com a nova forma arrumada}
while not eof(filefunc) do
begin
read(filefunc,varfunc);
writeln('MATRICULA: ',varfunc.matricula);
writeln('NOME: ',varfunc.nome);
seek(filesetor,0);
repeat
read(filesetor,varsetor);
until (varfunc.setor = varsetor.numero);
writeln('SETOR: ',varsetor.nome);
writeln('DATA DE NASCIMENTO: ',varfunc.data_nasc);
writeln('DATA DE ADMISSAO: ',varfunc.data_adm);
writeln('SALARIO: ',varfunc.salario:10:2);
writeln;
end;
writeln;
writeln('Pressione Qualquer tecla...');
readkey;
end;
end;
procedure setorpornome; {Procedure para a listagem de setores por nome}
var {FAZ A MESMA COISA QUE NA PROCEDURE DE FUNCIONARIOS}
pos, pos2: integer;
begin
clrscr;
existesetor;
writeln('===== Listagem de Setores por Nome =====');
writeln;
if (existe_setor = 0) then
begin
if (existe_setor = 0) then
begin
writeln;
writeln('Nao Ha Setores Cadastrados!!!');
writeln('Cadastrar Setores Primeiro!');
delay(2000);
end
end
else
begin
clrscr;
writeln('===== Listagem de Setores por Nome =====');
writeln;
reset(filesetor);
seek(filesetor,0);
for pos2 := 0 to (filesize(filesetor) - 2) do
begin
for pos :=0 to (filesize(filesetor) - 2) do
begin
seek(filesetor,pos);
read(filesetor,varsetor);
read(filesetor,aux_setor);
if upcase(varsetor.nome) > upcase(aux_setor.nome) then
begin
seek(filesetor,pos);
write(filesetor,aux_setor);
write(filesetor,varsetor);
end;
end;
end;
seek(filesetor,0);
while not eof(filesetor) do
begin
read(filesetor,varsetor);
writeln('NUMERO: ',varsetor.numero);
writeln('NOME: ',varsetor.nome);
writeln;
end;
writeln('Pressione Qualquer tecla...');
readkey;
end;
end;
procedure fopagfunc; {Procedure para a listagem total de folhas de pagamento}
begin
clrscr;
existefuncionario;
existesetor;
writeln('===== Folha de Pagamento Funcionarios =====');
writeln;
if (existe_setor = 0) or (existe_func = 0) then
begin
if (existe_func = 0) then
begin
writeln;
writeln('Nao Ha funcionarios Cadastrados!!!');
writeln('Cadastrar Funcionarios Primeiro!');
delay(2000);
end;
if (existe_setor = 0) then
begin
writeln;
writeln('Nao Ha Setores Cadastrados!!!');
writeln('Cadastrar Setores Primeiro!');
delay(2000);
end
end
else
begin
repeat
reset(filefopag);
clrscr;
writeln('===== Folha de Pagamento Funcionarios =====');
writeln;
writeln('Digite 0 para MES se quiser SAIR');
writeln;
writeln('MES: ');
read(mes_folha);
if mes_folha <> 0 then
begin
writeln('ANO: ');
read(ano_folha);
writeln;
existefolha; {Roda a procedure existe folha de pagamento}
if (existe_folha <> 1) then
begin
writeln('Folha nao Cadastrada!');
writeln('Digite outro Mes/Ano para a Folha! ');
delay(2000);
end
else
begin
write('Deseja Listar a Folha dos meses e anos informados? [S/N] ');
readln;
readln(resp);
if (resp='s') or (resp='S') then
begin
reset(filefopag);
seek(filefopag,0);
repeat
read(filefopag,varfopag);
if (varfopag.flag =1) and (mes_folha = varfopag.mes) then
begin
if (ano_folha = varfopag.ano) then
begin
writeln;
writeln('MES: ',varfopag.mes);
writeln('ANO: ',varfopag.ano);
writeln('MATRICULA: ',varfopag.matricula);
reset(filefunc);
seek(filefunc,0);
repeat
read(filefunc,varfunc);
until (varfopag.matricula = varfunc.matricula);
reset(filesetor);
seek(filesetor,0);
repeat
read(filesetor,varsetor);
until (varfunc.setor = varsetor.numero);
writeln('SETOR: ',varsetor.nome);
writeln('NOME: ',varfunc.nome);
writeln('SALARIO: ',varfopag.salario:10:2);
writeln('INSS: ', inss(varfopag.salario):10:2);
writeln('IRRF: ',irrf(varfopag.salario):10:2);
writeln('SALARIO LIQUIDO: ',varfopag.salario-(inss(varfopag.salario) + irrf(varfopag.salario)):10:2);
end;
end;
until (eof(filefopag));
writeln;
writeln('Pressione qualquer tecla... ');
readkey;
end;
end;
end
else
begin
writeln;
writeln('0. Codigo de Saida...');
writeln('Saindo! Pressione qualquer tecla...');
readkey;
end;
until (mes_folha) = 0;
end;
end;
procedure fopagset; {Procedure para a listagem total de folhas de pagamento}
var
soma_inss, soma_irrf, soma_sal, soma_saliq: real;
pos: integer;
begin
clrscr;
existefuncionario;
existesetor;
writeln('===== Folha de Pagamento Resumo Setores =====');
writeln;
if (existe_setor = 0) or (existe_func = 0) then
begin
if (existe_func = 0) then
begin
writeln;
writeln('Nao Ha funcionarios Cadastrados!!!');
writeln('Cadastrar Funcionarios Primeiro!');
delay(2000);
end;
if (existe_setor = 0) then
begin
writeln;
writeln('Nao Ha Setores Cadastrados!!!');
writeln('Cadastrar Setores Primeiro!');
delay(2000);
end
end
else
begin
repeat
reset(filefopag);
clrscr;
writeln('===== Folha de Pagamento Resumo Setores =====');
writeln;
writeln('Digite 0 para MES se quiser SAIR');
writeln;
writeln('MES: ');
read(mes_folha);
if mes_folha <> 0 then
begin
writeln('ANO: ');
read(ano_folha);
writeln;
existefolha; {Roda a procedure existe folha de pagamento, 1 a folha existe e 0 ela nao existe}
if (existe_folha <> 1) then
begin
writeln('Folha nao Cadastrada!');
writeln('Digite outro Mes/Ano para a Folha! ');
delay(2000);
end
else
begin
write('Deseja Listar a Folha dos meses e anos informados? [S/N] ');
readln;
readln(resp);
if (resp='s') or (resp='S') then
begin
soma_inss := 0;
soma_irrf := 0;
soma_saliq := 0;
soma_sal := 0;
for pos := 1 to filesize(filefopag) do
begin
seek(filefopag,pos-1);
read(filefopag,varfopag);
if (varfopag.flag =1) and (mes_folha = varfopag.mes) then
begin
if (ano_folha = varfopag.ano) then
begin
reset(filesetor);
seek(filesetor,0);
repeat
read(filesetor,varsetor);
if (varsetor.numero = varfopag.setor) and (varsetor.flag = 1) then
begin
soma_inss := soma_inss + inss(varfopag.salario);
soma_irrf := soma_irrf + irrf(varfopag.salario);
soma_saliq := soma_saliq + (varfopag.salario-(inss(varfopag.salario) + irrf(varfopag.salario)));
soma_sal := soma_sal + varfopag.salario;
end;
until eof(filesetor);
end;
end;
end;
for pos := 1 to filesize(filefopag) do
begin
seek(filefopag,pos-1);
read(filefopag,varfopag);
if (varfopag.flag = 1) and (mes_folha = varfopag.mes) then {lista a soma dos setores}
begin
if (ano_folha = varfopag.ano) then
begin
writeln;
writeln('MES: ',varfopag.mes);
writeln('ANO: ',varfopag.ano);
seek(filesetor,0);
achou := false;
repeat
read(filesetor,aux_setor);
if (aux_setor.numero = varfopag.setor) and (aux_setor.flag = 1) then
achou := true;
until (achou = true);
writeln('SETOR: ',aux_setor.nome);
writeln('SOMA DOS SALARIOS: ',soma_sal:10:2);
writeln('INSS TOTAL: ', soma_inss:10:2);
writeln('IRRF TOTAL: ',soma_irrf:10:2);
writeln('SOMA DOS SALARIOS LIQUIDOS: ',soma_saliq:10:2);
end;
end;
end;
writeln;
writeln('Pressione qualquer tecla... ');
readkey;
end;
end;
end
else
begin
writeln;
writeln('0. Codigo de Saida...');
writeln('Saindo! Pressione qualquer tecla...');
readkey;
end;
until (mes_folha) = 0;
end;
end;
{PROGRAMA PRINCIPAL}
begin
{$I-}
assign(filefunc,{C:\Documents and Settings\Administrador\Meus documentos\Prog\}'funcionarios.txt'); {cria arquivo, associando variavel filefunc com o arquivo}
reset(filefunc);
if not (IOResult = 0) then{confere se ja existe o arquivo, se nao, cria-o e coloca na posicao 0, logo abaixo, no comando reset(arq_aluno)}
rewrite(filefunc);
{$I+}
{$I-}
assign(filesetor,{C:\Documents and Settings\Administrador\Meus documentos\Prog\}'setores.txt');
reset(filesetor);
if not (IOResult = 0) then
rewrite(filesetor);
reset(filesetor);
{$I+}
{$I-}
assign(filefopag,{C:\Documents and Settings\Administrador\Meus documentos\Prog\}'folhapagto.txt');
reset(filefopag);
if not (IOResult = 0) then
rewrite(filefopag);
reset(filefopag);
{$I+}
clrscr;
writeln('===== P.A.N.D.A Corp =====');
delay(1000);
writeln;
writeln('===== Programa de Gerenciamento Empresarial =====');
delay(1000);
writeln;
writeln('Por: Gabriel Oliveira e Ivan Rocha');
delay(3000);
repeat {essencial para a criacao de menus}
clrscr;
writeln('===== Menu Principal ====='); {Menu principal do programa}
writeln;
writeln('a. Cadastro; '); {Entrada no menu de cadastros}
writeln('b. Manutencao de Cadastros; '); {Entrada no menu manutencao}
writeln('c. Folha de Pagamento; '); {Entrada no menu folha de pagamento}
writeln('d. Consulta/Relatorios; '); {Entrada no menu consulta/ relatorios}
writeln('s. Sair. '); {Saida do programa}
writeln;
op:= upcase(readkey); {Ler a opcao desejada}
case op of
'A':begin
repeat
clrscr;
writeln('===== Area de Cadastros =====');
writeln;
writeln('a. Cadastro de Funcionarios; ');
writeln('b. Cadastro de Setores; ');
writeln('s. Voltar ao Menu Principal (SAIR). ');
writeln;
esc:= upcase(readkey); {comando para se usar so uma tecla para a navegacao dentro dos menus}
case esc of
'A':begin
cadastrofunc;
end; {fim do label cadastro de funcionarios}
'B':begin
cadastrosetor;
end; {fim do label cadastro de setores}
end;
until esc = 'S';
end; {Fim do Label A do case principal}
'B':begin
repeat
clrscr;
writeln('===== Area de Manutencao Cadastros =====');
writeln;
writeln('a. Alterar Funcionario; ');
writeln('b. Excluir Funcionario; ');
writeln('c. Alterar Setor; ');
writeln('d. Excluir Setor; ');
writeln('s. Voltar ao Menu Principal (SAIR). ');
writeln;
esc:= upcase(readkey);
case esc of
'A':begin
alterarfunc;
end; {fim do label alterar funcionario}
'B':begin
removerfunc;
end; {fim do label excluir funcionario}
'C':begin
alterarsetor;
end; {fim do label altera setor}
'D':begin
removersetor;
end; {fim do label excluir setor}
end;
until esc = 'S';
end; {Fim do Label B do Case principal}
'C':begin
repeat
clrscr;
writeln('===== Folha de Pagamento =====');
writeln;
writeln('a. Gerar Folha de Pagamento; ');
writeln('b. Excluir Folha; ');
writeln('s. Voltar ao Menu Principal (SAIR). ');
writeln;
esc:= upcase(readkey);
case esc of
'A':begin
gerafolha;
end; {fim do label gerar folha de pagamento}
'B':begin
removerfolha;
end; {fim do label excluir folha}
end;
until esc = 'S';
end; {Fim do Label C do Case principal}
'D':begin
repeat
clrscr;
writeln('===== Consultas/Relatorios =====');
writeln;
writeln('a. Funcionarios por Setor; ');
writeln('b. Funcionarios por Nome; ');
writeln('c. Setores por Nome; ');
writeln('d. Folha de Pagamento Funcionarios; ');
writeln('e. Folha de Pagamento Resumo Setores; ');
writeln('s. Voltar ao Menu Principal (SAIR). ');
writeln;
esc:= upcase(readkey);
case esc of
'A':begin
funcporsetor;
end; {fim do label funcionarios por setor}
'B':begin
funcpornome;
end; {fim do label funcionarios por nome}
'C':begin
setorpornome;
end; {fim do Label Setores por nome}
'D':begin
fopagfunc;
end; {fim do label folha pagamentos funcionarios}
'E':begin
fopagset;
end; {fim do label pagamentos resumo setores}
end;
until esc = 'S';
end; {Fim do Label D do case principal}
end; {Fim do case principal}
until op = 'S';
clrscr;
close(filefunc);
close(filefopag);
close(filesetor);
end. {fim do programa}
[Script Pascal] Verificando quantos Caracteres por Segundo tem a legenda
Funções de Manipulação de Arquivos Pascal
Questionário em estatisticas em Pascal
Monitorando o Preço do Bitcoin ou sua Cripto Favorita em Tempo Real com um Widget Flutuante
IA Turbina o Desktop Linux enquanto distros renovam forças
Como extrair chaves TOTP 2FA a partir de QRCODE (Google Authenticator)
Ativando e usando "zoom" no ambiente Cinnamon
Vídeo Nostálgico de Instalação do Conectiva Linux 9
Como realizar um ataque de força bruta para desobrir senhas?
Estou tentando ser legalista, mas tá complicado! (8)
Thinkpads são bons mesmo ?! (0)
Queda no serviços da Cloudflare, alguns sites estão fora do ar. (1)









