Ir ao conteúdo

Arquivo em pascal


Escrifonife19

Posts recomendados

Postado

Bom...

Estou tentando fazer um arquivo em Pascal que:

Cria e grava dados num arquivo

Exibi o conteúdo do arquivo

Altera dados de um registro no arquivo

Inclui novos registros no arquivo

Exclui um registro de um arquivo

Parece que o programa que eu fiz ta certo, só que num faz nada

sera que alguém pode me ajudar?

Só consegui fazer isso


program GeraArquivo;
uses Crt;
type TRegistro = record
Marca: char;
Matr: string[9];
Nome: string[40];
SalarioBruto, SalarioLiquido, Inss: real;
NumDepend: integer;
end;
TArquivo = file of TRegistro;
var Arq: TArquivo;
Matricula: string;
Registro: TRegistro;
Escolha: char;
{Funcao para verificar a existencia de um arquivo}
function ExisteArquivo(var f: TArquivo):boolean;
begin
{$I-}
Reset(f);
if IOResult = 0 then
ExisteArquivo:= true
else
ExisteArquivo:= false;
{$I+}
end;
{Procedimento para gravar dados num arquivo}
procedure GravaDados(var f: TArquivo);
var r: TRegistro;
begin
with r do
repeat
ClrScr;
writeln('Digite matricula: OU DIGITE 0(ZERO) PARA ENCERRAR');
readln(Matr);
if Matr <>'0' then
begin
Marca:=' ';
writeln('Digite o nome:');
readln(Nome);
writeln('Digite o salario:');
readln(SalarioBruto);
writeln('Informe quantos dependentes:');
readln(NumDepend);
write(f, r);
end;
until Matr = '0';

end;
{Procedimento para exibir o conteudo de um arquivo}
procedure ExibeArquivo(var f: TArquivo);
var r: TRegistro;
begin
Reset(f);
while not EOF(f) do
begin
read(f, r);
if r.Marca <>'*' then
with r do
writeln(Matr:20,'a', Nome:20,'b', SalarioBruto:6:2,'c', NumDepend:3);
end;
writeln('fim');
ReadKey;
end;
{Funcao que realiza consulta por matricula num arquivo}
function Consulta(var f: TArquivo; Mat: string; var r: TRegistro):integer;
begin
Reset(f);
read(f, r);
while (not EOF(f)) and (r.Matr <> Mat) do
read(f, r);
if (r.Matr = Mat) and (r.Marca <> '*') then
begin
with r do
writeln(Matr, Nome, SalarioBruto, NumDepend);
Consulta:= FilePos(f);
end
else
begin
writeln('Matricula nao cadastrada');
Consulta:= -1;
end;

end;
{Procedimento para excluir logicamente um registro}
procedure ExcluiLogicamenteUmRegistro(var f: TArquivo; Mat: string);
var n, i: integer;
Reg: TRegistro;
Sim: Char;
begin
n:= Consulta(f, Mat, Reg);
if n <> -1 then
begin
write('Deseja excluir o registro(S/N)?');
readln(Sim);
if UpCase(Sim) = 'S' then
begin
Seek(f, n);
read(f, Reg);
Reg.Marca:='*';
Seek(f, n);
write(f, Reg);
end;
end;
Close(f);

end;
{Procedimento que altera un nome de um registro de matricula dada}
procedure AlteraRegistro(var f: TArquivo; Mat: string; var r: TRegistro);
var n: integer;
Sim: char;
begin
Reset(f);
n:= Consulta(f, Mat, r);
if n<> -1 then
begin
writeln('Deseja alterar o campo nome?');
readln(Sim);
if UpCase(Sim) = 'S' then
begin
writeln('Digite o novo nome');
readln(r.Nome);
end;
writeln('Deseja alterar o campo salario?');
readln(Sim);
if UpCase(Sim) = 'S' then
begin
writeln('Digite o novo salario');
readln(r.SalarioBruto);
end;
writeln('Deseja alterar o campo numero de dependentes?');
readln(Sim);
if UpCase(Sim) = 'S' then
begin
writeln('Digite o novo numero de dependentes');
readln(r.NumDepend);
end;
Seek(f, n);
write(f, r);
end;

end;
{Procedimento que inclui um novo registro no registro atual}
procedure IncluiRegistro(var f: TArquivo; r: TRegistro);
var n: integer;
Reg: TRegistro;
begin

n:= Consulta(f, r.Matr, Reg);
if n = -1 then
begin
Seek(f, FileSize(f));
write(f, r);
end
else
writeln('Matricula ja cadastrada');
end;
{Procedimento Menu}
procedure Menu;
begin
ClrScr;
Assign(Arq,'/media/TIAGO/ Folha.arq');
Rewrite(Arq);
repeat
writeln(' Menu ');
writeln('------------------------');
writeln('O que voce deseja fazer?');
writeln;
writeln('1 - Registra uma pessoa');
writeln('2 - Exibe um arquivo');
writeln('3 - Altera dados de um registro de um arquivo');
writeln('4 - Inclui novos registros em um arquivo');
writeln('5 - Exclui um registro de um arquivo');
writeln('6 - Sair');
readln(Escolha);
until (Escolha ='1') or(Escolha ='2') or (Escolha ='3') or (Escolha ='4') or (Escolha ='5') or (Escolha ='6');
Case Escolha of
'1' : GravaDados(Arq);
'2' : ExibeArquivo(Arq);
'3' : begin
writeln('Digite a matricula a ser alterada');
readln(Matricula);
AlteraRegistro(Arq, Matricula, Registro);
end;
'4' : IncluiRegistro(Arq, Registro);
'5' : begin
writeln('Digite a matricula para ser excluida');
readln(Matricula);
ExcluiLogicamenteUmRegistro(Arq, Matricula);
end;
'6' : begin
writeln('Saindo...');
Delay(1000);
end;
end;
end;
{Programa principal}
begin
ClrScr;
Assign(Arq,'/media/TIAGO/Arquivos/Folha.arq');
if not ExisteArquivo(Arq) then
begin
Rewrite(Arq);
Menu;
end
else
begin
writeln('Arquivo ja existe');
Menu;
end;
writeln;
writeln('Aperte uma tecla para encerar...');
end.
{Programa para gerar um arquivo e gravar dados no arquivo gerado}

  • 3 semanas depois...
  • 5 anos depois...

Arquivado

Este tópico foi arquivado e está fechado para novas respostas.

Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas comunidades sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×
×
  • Criar novo...

LANÇAMENTO!

eletronica2025-popup.jpg


CLIQUE AQUI E BAIXE AGORA MESMO!