Cadastro Empresarial
Publicado por Ivan Rocha 19/12/2006
[ Hits: 6.860 ]
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
[Script Pascal] Verificando quantos Caracteres por Segundo tem a legenda
ZCodEdit - Editor de textos com sintaxe HTML e Pascal
Compartilhando a tela do Computador no Celular via Deskreen
Como Configurar um Túnel SSH Reverso para Acessar Sua Máquina Local a Partir de uma Máquina Remota
Configuração para desligamento automatizado de Computadores em um Ambiente Comercial
Como renomear arquivos de letras maiúsculas para minúsculas
Imprimindo no formato livreto no Linux
Vim - incrementando números em substituição
Efeito "livro" em arquivos PDF
Como resolver o erro no CUPS: Unable to get list of printer drivers
Melhores Práticas de Nomenclatura: Pastas, Arquivos e Código (2)
Preciso resolver um erro de DPKG (0)
Não to conseguindo resolver este problemas ao instalar o playonelinux (1)
[Python] Automação de scan de vulnerabilidades
[Python] Script para analise de superficie de ataque
[Shell Script] Novo script para redimensionar, rotacionar, converter e espelhar arquivos de imagem
[Shell Script] Iniciador de DOOM (DSDA-DOOM, Doom Retro ou Woof!)
[Shell Script] Script para adicionar bordas às imagens de uma pasta