Cadastro Empresarial
Publicado por Ivan Rocha 19/12/2006
[ Hits: 6.876 ]
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
Questionário em estatisticas em Pascal
Visualizador de imagens feito no Lazarus
Enviar mensagem ao usuário trabalhando com as opções do php.ini
Meu Fork do Plugin de Integração do CVS para o KDevelop
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
Compartilhamento de Rede com samba em modo Público/Anônimo de forma simples, rápido e fácil
Cups: Mapear/listar todas as impressoras de outro Servidor CUPS de forma rápida e fácil
Criando uma VPC na AWS via CLI
Tem como instalar o gerenciador AMD Adrenalin no Ubuntu 24.04? (16)
Arch Linux - Guia para Iniciantes (2)
Problemas ao instalar o PHP (11)
Tenho dois Link's ( IP VÁLIDOS ), estou tentando fazer o failover... (0)