projeto em pascal
SkiLL-World :: Geral :: Pascal
Página 1 de 1
projeto em pascal
pessoal, eu tenho de entregar o meu projeto de pascal amanha , e o programa ta a dar erro que eu tou a conseguir corrigir , sera que me podiam ajudar . vou postar aqui o meu programa .
program ficheiro_dados;
uses crt ;
Type registo=record
codigo: string[10];
descricao: string[25];
quantidade: integer;
data: string[10];
end;
var ficheiro: File of registo;
ficha: registo;
NRegistos: integer;
opcao:string;
FUNCTION existe(nome:string):boolean; {verifica se o ficheiro existe }
VAR flista:file;
existe:boolean;
BEGIN
RESET(flista);
CLOSE(flista);
existe:=(IOresult=0) and (nome<>'') ;
end;
Procedure inser;
var i: integer;
option:string;
begin
i:= 0;
IF not existe('Dados.dat') then
begin
writeln('o ficheiro nao existe. Deseja criar o Ficheiro (s/n) ?');
readln(option);
if option = 's' then
begin
rewrite(ficheiro); {cria o ficheiro em branco}
close(ficheiro); {fecha o ficheiro}
end;
end
ELSE
begin
repeat
clrscr;
reset(ficheiro); {abre o ficheiro e fica no primeiro registo}
i:= filesize(ficheiro); {determina o tamanho do ficheiro}
seek(ficheiro, i); {coloca-se no ultimo registo do ficheiro}
write('Codigo: '); readln(ficha.codigo);
write('Descricao: '); readln(ficha.descricao);
write('Quantidade: '); readln(ficha.quantidade);
write('Data de Entrada: '); readln(ficha.data);
writeln('Confirma os dados s/n '); option:= readkey;
if option='s' then
begin
write(ficheiro, ficha); {escreve no ficheiro}
close(ficheiro);
end;
writeln('Pretende sair s/n ');
option:= readkey;
until option='s';
end;
end;
procedure lista;
begin
clrscr;
IF not existe('Dados.dat') then
begin
writeln('Nao existe ficheiro de dados');
readln;
end
else
begin
RESET(ficheiro);
WHILE NOT EOF(ficheiro) DO
BEGIN
READ(ficheiro,ficha);
WITH ficha DO
begin
if ficha.codigo <> '' then {evita que registos em branco sejam escritos}
begin
writeln('Ficha Nr.', filepos(ficheiro));
writeln('Codigo: ', ficha.codigo);
writeln('Descricao: ', ficha.descricao);
writeln('Quantidade: ', ficha.quantidade);
writeln('Data de Entrada: ', ficha.data);
writeln;
end;
end;
end;
CLOSE(ficheiro);
readln;
end;
end;
procedure altera;
var x: string;
sair: boolean;
i: integer;
begin
clrscr;
sair:= false;
IF not existe('Dados.dat') then
writeln('Não existe ficheiro de dados')
else
begin
write('Digite o codigo da ficha a alterar: ');
readln(x);
RESET(ficheiro);
WHILE NOT EOF(ficheiro) and (sair=false) DO
BEGIN
READ(ficheiro,ficha);
WITH ficha DO
begin
if x = ficha.codigo then
begin
writeln('Ficha Nr.', filepos(ficheiro));
write('Codigo: ', ficha.codigo,' Novo codigo: '); readln(ficha.codigo);
write('Descricao: ', ficha.descricao,' Nova Descricao: '); readln(ficha.descricao);
write('Quantidade: ', ficha.quantidade,' Nova Quantidade: '); readln(ficha.quantidade);
write('Data de Entrada: ', ficha.data,' Nova Data: ');readln(ficha.data);
writeln;
writeln('Confirma os dados s/n '); opcao:= readkey;
if opcao='s' then
begin
i:= filepos(ficheiro);
seek(ficheiro, i-1);
write(ficheiro, ficha);
sair:= true;
writeln('Alteracao efectuada');
readln;
end;
end;
end;
end;
CLOSE(ficheiro);
end;
end;
{este procedimento exclui o registo}
procedure exclui;
var x: string;
sair: boolean;
i: integer;
begin
clrscr;
sair:= false;
x:= '';
i:= 0;
IF not existe('Dados.dat') then
writeln('Não existe ficheiro de dados')
else
begin
write('Digite o codigo da ficha a excluir: ');
readln(x);
RESET(ficheiro);
WHILE NOT EOF(ficheiro) and (sair=false) DO
BEGIN
READ(ficheiro,ficha);
WITH ficha DO
begin
if x = ficha.codigo then
begin
writeln('Ficha Nr.', filepos(ficheiro));
writeln('Codigo: ', ficha.codigo);
writeln('Descricao: ', ficha.descricao);
writeln('Quantidade: ', ficha.quantidade);
writeln('Data de Entrada: ', ficha.data);
writeln;
writeln('Confirma? (s/n)'); opcao:= readkey;
if opcao='s' then
begin
i:= filepos(ficheiro);
seek(ficheiro, i-1);
ficha.codigo:= '';
ficha.descricao:= '';
ficha.quantidade:= 0;
ficha.data:= '';
write(ficheiro, ficha);
end;
sair:= true;
writeln('Exclusao efectuada!');
readln;
end;
end;
end;
CLOSE(ficheiro);
if sair=false then
begin
writeln('Codigo nao encontrado!');
readln;
end;
end;
end;
begin
assign(flista,'nome.dat');
ASSIGN(ficheiro,'dados.dat');
ASSIGN(ficheiro,'dados.dat');
ASSIGN(ficheiro,'Dados.dat');
ASSIGN(ficheiro,'dados.dat');
repeat
clrscr;
writeln(' 1 - INSERIR');
writeln;
writeln(' 2 - LISTAR');
writeln;
writeln(' 3 - ALTERAR');
writeln;
writeln(' 4 - EXCLUIR');
writeln;
writeln(' 0 - FIM');
readln (opcao);
if opcao='1' then
INSER
else
begin
if opcao='2' then
LISTA
else
begin
if opcao='3' then
ALTERA
else
begin
if opcao='4' then
EXCLUI
end;
end;
end;
readln;
until opcao='0';
end.
program ficheiro_dados;
uses crt ;
Type registo=record
codigo: string[10];
descricao: string[25];
quantidade: integer;
data: string[10];
end;
var ficheiro: File of registo;
ficha: registo;
NRegistos: integer;
opcao:string;
FUNCTION existe(nome:string):boolean; {verifica se o ficheiro existe }
VAR flista:file;
existe:boolean;
BEGIN
RESET(flista);
CLOSE(flista);
existe:=(IOresult=0) and (nome<>'') ;
end;
Procedure inser;
var i: integer;
option:string;
begin
i:= 0;
IF not existe('Dados.dat') then
begin
writeln('o ficheiro nao existe. Deseja criar o Ficheiro (s/n) ?');
readln(option);
if option = 's' then
begin
rewrite(ficheiro); {cria o ficheiro em branco}
close(ficheiro); {fecha o ficheiro}
end;
end
ELSE
begin
repeat
clrscr;
reset(ficheiro); {abre o ficheiro e fica no primeiro registo}
i:= filesize(ficheiro); {determina o tamanho do ficheiro}
seek(ficheiro, i); {coloca-se no ultimo registo do ficheiro}
write('Codigo: '); readln(ficha.codigo);
write('Descricao: '); readln(ficha.descricao);
write('Quantidade: '); readln(ficha.quantidade);
write('Data de Entrada: '); readln(ficha.data);
writeln('Confirma os dados s/n '); option:= readkey;
if option='s' then
begin
write(ficheiro, ficha); {escreve no ficheiro}
close(ficheiro);
end;
writeln('Pretende sair s/n ');
option:= readkey;
until option='s';
end;
end;
procedure lista;
begin
clrscr;
IF not existe('Dados.dat') then
begin
writeln('Nao existe ficheiro de dados');
readln;
end
else
begin
RESET(ficheiro);
WHILE NOT EOF(ficheiro) DO
BEGIN
READ(ficheiro,ficha);
WITH ficha DO
begin
if ficha.codigo <> '' then {evita que registos em branco sejam escritos}
begin
writeln('Ficha Nr.', filepos(ficheiro));
writeln('Codigo: ', ficha.codigo);
writeln('Descricao: ', ficha.descricao);
writeln('Quantidade: ', ficha.quantidade);
writeln('Data de Entrada: ', ficha.data);
writeln;
end;
end;
end;
CLOSE(ficheiro);
readln;
end;
end;
procedure altera;
var x: string;
sair: boolean;
i: integer;
begin
clrscr;
sair:= false;
IF not existe('Dados.dat') then
writeln('Não existe ficheiro de dados')
else
begin
write('Digite o codigo da ficha a alterar: ');
readln(x);
RESET(ficheiro);
WHILE NOT EOF(ficheiro) and (sair=false) DO
BEGIN
READ(ficheiro,ficha);
WITH ficha DO
begin
if x = ficha.codigo then
begin
writeln('Ficha Nr.', filepos(ficheiro));
write('Codigo: ', ficha.codigo,' Novo codigo: '); readln(ficha.codigo);
write('Descricao: ', ficha.descricao,' Nova Descricao: '); readln(ficha.descricao);
write('Quantidade: ', ficha.quantidade,' Nova Quantidade: '); readln(ficha.quantidade);
write('Data de Entrada: ', ficha.data,' Nova Data: ');readln(ficha.data);
writeln;
writeln('Confirma os dados s/n '); opcao:= readkey;
if opcao='s' then
begin
i:= filepos(ficheiro);
seek(ficheiro, i-1);
write(ficheiro, ficha);
sair:= true;
writeln('Alteracao efectuada');
readln;
end;
end;
end;
end;
CLOSE(ficheiro);
end;
end;
{este procedimento exclui o registo}
procedure exclui;
var x: string;
sair: boolean;
i: integer;
begin
clrscr;
sair:= false;
x:= '';
i:= 0;
IF not existe('Dados.dat') then
writeln('Não existe ficheiro de dados')
else
begin
write('Digite o codigo da ficha a excluir: ');
readln(x);
RESET(ficheiro);
WHILE NOT EOF(ficheiro) and (sair=false) DO
BEGIN
READ(ficheiro,ficha);
WITH ficha DO
begin
if x = ficha.codigo then
begin
writeln('Ficha Nr.', filepos(ficheiro));
writeln('Codigo: ', ficha.codigo);
writeln('Descricao: ', ficha.descricao);
writeln('Quantidade: ', ficha.quantidade);
writeln('Data de Entrada: ', ficha.data);
writeln;
writeln('Confirma? (s/n)'); opcao:= readkey;
if opcao='s' then
begin
i:= filepos(ficheiro);
seek(ficheiro, i-1);
ficha.codigo:= '';
ficha.descricao:= '';
ficha.quantidade:= 0;
ficha.data:= '';
write(ficheiro, ficha);
end;
sair:= true;
writeln('Exclusao efectuada!');
readln;
end;
end;
end;
CLOSE(ficheiro);
if sair=false then
begin
writeln('Codigo nao encontrado!');
readln;
end;
end;
end;
begin
assign(flista,'nome.dat');
ASSIGN(ficheiro,'dados.dat');
ASSIGN(ficheiro,'dados.dat');
ASSIGN(ficheiro,'Dados.dat');
ASSIGN(ficheiro,'dados.dat');
repeat
clrscr;
writeln(' 1 - INSERIR');
writeln;
writeln(' 2 - LISTAR');
writeln;
writeln(' 3 - ALTERAR');
writeln;
writeln(' 4 - EXCLUIR');
writeln;
writeln(' 0 - FIM');
readln (opcao);
if opcao='1' then
INSER
else
begin
if opcao='2' then
LISTA
else
begin
if opcao='3' then
ALTERA
else
begin
if opcao='4' then
EXCLUI
end;
end;
end;
readln;
until opcao='0';
end.
jaguarselvagem- Novato
- Mensagens : 1
Data de inscrição : 19/02/2013
Tópicos semelhantes
» Programas em Pascal
» Objectivo do pascal
» Introdução ao pascal
» comandos de ficheiros em Pascal
» filmezito de 1 programa de pascal :o
» Objectivo do pascal
» Introdução ao pascal
» comandos de ficheiros em Pascal
» filmezito de 1 programa de pascal :o
SkiLL-World :: Geral :: Pascal
Página 1 de 1
Permissões neste sub-fórum
Não podes responder a tópicos
|
|