projeto em pascal

Ver o tópico anterior Ver o tópico seguinte Ir em baixo

projeto em pascal

Mensagem  jaguarselvagem em Ter Fev 19, 2013 2:49 pm

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.

jaguarselvagem
Novato
Novato

Mensagens : 1
Data de inscrição : 19/02/2013

Ver perfil do usuário

Voltar ao Topo Ir em baixo

Ver o tópico anterior Ver o tópico seguinte Voltar ao Topo

- Tópicos similares

 
Permissão deste fórum:
Você não pode responder aos tópicos neste fórum