Cadastro Empresarial
Publicado por Ivan Rocha 19/12/2006
[ Hits: 7.082 ]
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}
Funções de Manipulação de Arquivos Pascal
Visualizador De Imagem feito no Lazarus (Delphi 7 para Linux)
Como extrair chaves TOTP 2FA a partir de QRCODE (Google Authenticator)
Linux em 2025: Segurança prática para o usuário
Desktop Linux em alta: novos apps, distros e privacidade marcam o sábado
IA chega ao desktop e impulsiona produtividade no mundo Linux
Novos apps de produtividade, avanços em IA e distros em ebulição agitam o universo Linux
Como instalar o repositório do DBeaver no Ubuntu
Como instalar o Plex Media Server no Ubuntu
Digitando underscore com "shift" + "barra de espaços"
Como ativar a lixeira e recuperar aquivos deletados em um servidor Linux
Como mudar o nome de dispositivos Bluetooth via linha de comando
dpkg: erro: gatilho de arquivo duplicado chamado pelo arquivo de nome (6)
Instalação não está resolvendo as dependencias (2)
Captação de áudio no zorin linux começa a diminuir com o tempo (5)
Alternativas ao Multilogin para gerenciamento de múltiplas contas/prof... (0)









