Pascal - Arquivo

[demolish]

Olá, sou novato no forum e na área de programação.

Gostaria da ajuda de vocês para implementar Arquivo (criar,carregar,salvar) no meu programa de registro, uma agenda de compromissos.

Se alguém puder implementar arquivo nesse codigo eu ficarei muito grato.

program agenda_de_notas;

uses

crt;

type

reg_agenda = record

mes:integer;

dia:integer;

cod:integer;

nota:string;

end;

agenda = array [1..100] of reg_agenda;

VAR cod,x:integer;

procedure insere(var a:agenda; var ultimo:integer);

begin

clrscr;

writeln('::Inserindo nova nota::');

writeln;

ultimo:=ultimo+1;

for x := 100 downto 1 do

begin

if a[x].cod = 0 then

cod:=x;

end;

a[ultimo].cod :=cod;

writeln('Digite a data da nota:');

write('Mes: ');

readln(a[ultimo].mes);

while (a[ultimo].mes < 1) or (a[ultimo].mes > 12) do

begin

writeln('Mes invalido, digite novamente: ');

readln(a[ultimo].mes);

end;

write('Dia: ');

readln(a[ultimo].dia);

case a[ultimo].mes of

2: while ((a[ultimo].dia < 1) or (a[ultimo].dia > 29)) do

begin

writeln('Dia invalido, digite novamente: ');

readln(a[ultimo].dia);

end;

1,3,5,7,8,10,12: while ((a[ultimo].dia < 1) or (a[ultimo].dia > 31)) do

begin

writeln('Dia invalido, digite novamente: ');

readln(a[ultimo].dia);

end;

4,6,9,11: while ((a[ultimo].dia < 1) or (a[ultimo].dia > 30)) do

begin

writeln('Dia invalido, digite novamente: ');

readln(a[ultimo].dia);

end;

End;

write('Digite uma nota: ');

readln(a[ultimo].nota);

writeln('Código:', a[ultimo].cod);

writeln;

writeln('Pressione uma tecla para retornar ao menu.');

readkey;

end;

//------------------------------------------------------------------------------

procedure consulta(a:agenda; ultimo:integer);

var

m,d:integer;

achou:boolean;

cont:integer;

begin

clrscr;

writeln('::Consultar uma nota::');

writeln;

write('Entre com o mes: ');

readln(m);

write('Entre com o dia: ');

readln(d);

achou:=false;

for cont:=1 to ultimo

do if (a[cont].mes=m) and (a[cont].dia=d)

then begin

achou:=true;

writeln('Nota agendada: ');

writeln(a[cont].nota);

writeln('Data: ',a[cont].dia,'/',a[cont].mes);

writeln('Código: ',a[cont].cod);

end;

if not achou

then writeln('Nenhuma nota foi encontrada para essa data.');

writeln;

writeln('Pressione uma tecla para retornar ao menu.');

readkey;

end;

//------------------------------------------------------------------------------

procedure change(var a:agenda; var ultimo:integer);

var cod2,cont:integer;

begin

clrscr;

Write('Informe o código: '); readln(cod2);

for cont := 1 to ultimo do

if (cod2 = a[cont].cod)

then begin

writeln('::Alterar uma nota::');

write('Nota [', a[cont].nota, ']: ');

write('Digite nova nota: '); readln(a[cont].nota);

writeln('Data: ');

write('Dia [', a[cont].dia,']: ');

write('Digite o novo dia: '); readln(a[cont].dia);

write('Mês [',a[cont].mes,']: ');

write('Digite o novo mes: '); readln(a[cont].mes);

Readkey;

End;

end;

//------------------------------------------------------------------------------

procedure listar(var a:agenda; var ultimo:integer);

var cont:integer;

begin

clrscr;

writeln('::Lista de Notas::');

writeln;

for cont :=1 to ultimo

do begin

if a[cont].cod <> 0

then begin

writeln('###');

writeln('Codigo: ',a[cont].cod);

writeln('Nota: ',a[cont].nota);

writeln('Data: ',a[cont].dia,'/',a[cont].mes);

writeln('###');

end;

end;

Readkey;

end;

//------------------------------------------------------------------------------

procedure ordenar(var a:agenda; var ultimo:integer);

var

cont,j,mes1,dia1,cod1: integer;

nota1:string;

begin //Ordenar Meses;

for cont := ultimo downto 2 do

for j := 1 to cont-1 do

if a[j].mes > a[j+1].mes then

begin

mes1 := a[j].mes;

a[j].mes := a[j+1].mes;

a[j+1].mes := mes1;

dia1 := a[j].dia;

a[j].dia := a[j+1].dia;

a[j+1].dia := dia1;

cod1 := a[j].cod;

a[j].cod := a[j+1].cod;

a[j+1].cod := cod1;

nota1 := a[j].nota;

a[j].nota := a[j+1].nota;

a[j+1].nota := nota1;

end;

begin //Ordenar Dias;

for cont := ultimo downto 2 do

for j := 1 to cont-1 do

if a[j].mes = a[j+1].mes then

if a[j].dia > a[j+1].dia then

begin

mes1 := a[j].mes;

a[j].mes := a[j+1].mes;

a[j+1].mes := mes1;

dia1 := a[j].dia;

a[j].dia := a[j+1].dia;

a[j+1].dia := dia1;

cod1 := a[j].cod;

a[j].cod := a[j+1].cod;

a[j+1].cod := cod1;

nota1 := a[j].nota;

a[j].nota := a[j+1].nota;

a[j+1].nota := nota1;

end;

end;

writeln('Ordenado com sucesso.');

Readkey;

end;

//------------------------------------------------------------------------------

procedure del(var a:agenda; var ultimo:integer);

var apagar:integer;

begin

clrscr;

writeln('::Excluir uma nota::');

writeln;

write('Digite o codigo da nota a ser excluida: ');

readln(apagar);

for x:=1 to ultimo do

begin

if apagar = a[x].cod then

begin

a[x].cod:=0;

writeln('Nota removida.');

Readkey;

end;

end;

end;

//------------------------------------------------------------------------------

function le_opcao:integer;

var

opcao:integer;

begin

clrscr;

writeln('Agenda de Notas');

writeln;

writeln('::::::::::Menu::::::::::');

writeln('1. Inserir uma nova nota');

writeln('2. Consultar uma nota');

writeln('3. Alterar nota');

writeln('4. Listar notas');

writeln('5. Ordenar notas');

writeln('6. Excluir nota');

writeln('7. Sair do programa');

writeln;

writeln('Escolha uma opcao valida: ' );

readln(opcao);

le_opcao:=opcao;

end;

var

vetor:agenda;

quantidade:integer;

op:integer;

sair:boolean;

begin

sair:=false;

quantidade:=0;

repeat

op:=le_opcao;

if op=1 then insere(vetor,quantidade);

if op=2 then consulta(vetor,quantidade);

if op=3 then change(vetor,quantidade);

if op=4 then listar(vetor,quantidade);

if op=5 then ordenar(vetor,quantidade);

if op=6 then del(vetor,quantidade);

if op>=7 then sair:=true;

until sair;

readln;

end.

[M@RcOs pS09]

demolish,

Para carregar, utilize a função:

function carregar(Arq: string): boolean;
var
     arquivo: file of reg_agenda;
     aux: reg_agenda;
     i: integer;
begin
        try
            assign(arquivo, Arq);       
        reset(arquivo);
            result:=true;
        except
            result:=false;
        end;

        i := 0;
        while (not eof(arquivo)) do
        begin
                read (arquivo,aux);
                a[i] := aux;
                i := i +1;
        end;

        close(arquivo);
         
end;

Para salvar, utilize a função:

function salvar(Arq: string): boolean;
var
     arquivo: file of reg_agenda;
     aux: reg_agenda;
     i: integer;
begin
        try
            assign(arquivo, Arq);        
        rewrite(arquivo);
            result:=true;
        except
            result:=false;
        end;

        for i:=0 to 100 do
        begin
                aux = a[i];
                write(arquivo,aux);
        end;

        close(arquivo);
         
end;

Att

Editado Julho 18, 2010 por M@RcOs pS09

[demolish]

demolish,

Para carregar, utilize a função:

function carregar(Arq: string): boolean;
var
     arquivo: file of reg_agenda;
     aux: reg_agenda;
     i: integer;
begin
        try
            assign(arquivo, Arq);       
        reset(arquivo);
            result:=true;
        except
            result:=false;
        end;

        i := 0;
        while not eof(arquivo)
        begin
                read (arquivo,aux);
                a[i] := aux;
                i := i +1;
        end;

        close(arquivo);
         
end;

Para salvar, utilize a função:

function salvar(Arq: string): boolean;
var
     arquivo: file of reg_agenda;
     aux: reg_agenda;
     i: integer;
begin
        try
            assign(arquivo, Arq);        
        rewrite(arquivo);
            result:=true;
        except
            result:=false;
        end;

        for i:=0 to 100 do
        begin
                aux = a[i];
                write(arquivo,aux);
        end;

        close(arquivo);
         
end;

Att

vlw, mas ainda não consegui, tenho muita dificuldade nessa parte de arquivo. 262 / 9 progra~1.pas Fatal: Syntax error, DO expected but BEGIN found tah dando erro no begin nessa parte da function carregar

while not eof(arquivo)
        begin

esse carregar serveria tb p criar caso não existesse arquivo?

Editado Julho 18, 2010 por demolish

[M@RcOs pS09]

demolish,

Corrigi o erro, estava faltando um "do".

Olha só, quando o arquivo não existir ele simplesmente não carrega. Porém, quando for salvar, se o arquivo não existir ele o cria. Daí não precisa de uma função para criar.

Att

[demolish]

aaah, entendi!

agora tah travando na variavel a

tentei declarar separada, mas sem exito.

Se puder, junta com o meu programa e teste para ver onde acontece os erros ^^

obrigado!

function carregar(Arq: string): boolean;
var
     arquivo: file of reg_agenda;
     aux: reg_agenda;
     i: integer;
begin
        try
            assign(arquivo, Arq);      
        reset(arquivo);
            result:=true;
        except
            result:=false;
        end;

        i := 0;
        while (not eof(arquivo)) do
        begin
                read (arquivo,aux);
                a[i] := aux;                <-------------
                i := i +1;
        end;

        close(arquivo);
        
end;

[M@RcOs pS09]

demolish,

100% funcionado

program agenda_de_notas;
uses
crt;
type
reg_agenda = record
mes:integer;
dia:integer;
cod:integer;
nota:string[10];
end;

agenda = array [1..100] of reg_agenda;
VAR cod,x:integer;

procedure insere(var a:agenda; var ultimo:integer);
begin
clrscr;
writeln('::Inserindo nova nota::');
writeln;
ultimo:=ultimo+1;
for x := 100 downto 1 do
begin
if a[x].cod = 0 then
cod:=x;
end;
a[ultimo].cod :=cod;
writeln('Digite a data da nota:');
write('Mes: ');
readln(a[ultimo].mes);
while (a[ultimo].mes < 1) or (a[ultimo].mes > 12) do
begin
writeln('Mes invalido, digite novamente: ');
readln(a[ultimo].mes);
end;

write('Dia: ');
readln(a[ultimo].dia);
case a[ultimo].mes of
2: while ((a[ultimo].dia < 1) or (a[ultimo].dia > 29)) do
begin
writeln('Dia invalido, digite novamente: ');
readln(a[ultimo].dia);
end;

1,3,5,7,8,10,12: while ((a[ultimo].dia < 1) or (a[ultimo].dia > 31)) do
begin
writeln('Dia invalido, digite novamente: ');
readln(a[ultimo].dia);
end;

4,6,9,11: while ((a[ultimo].dia < 1) or (a[ultimo].dia > 30)) do
begin
writeln('Dia invalido, digite novamente: ');
readln(a[ultimo].dia);
end;
End;
write('Digite uma nota: ');
readln(a[ultimo].nota);
writeln('C¢digo:', a[ultimo].cod);
writeln;
writeln('Pressione uma tecla para retornar ao menu.');
readkey;
end;

//------------------------------------------------------------------------------

procedure consulta(a:agenda; ultimo:integer);
var
m,d:integer;
achou:boolean;
cont:integer;
begin
clrscr;
writeln('::Consultar uma nota::');
writeln;
write('Entre com o mes: ');
readln(m);
write('Entre com o dia: ');
readln(d);
achou:=false;
for cont:=1 to ultimo
do if (a[cont].mes=m) and (a[cont].dia=d)
then begin
achou:=true;
writeln('Nota agendada: ');
writeln(a[cont].nota);
writeln('Data: ',a[cont].dia,'/',a[cont].mes);
writeln('C¢digo: ',a[cont].cod);
end;
if not achou
then writeln('Nenhuma nota foi encontrada para essa data.');
writeln;
writeln('Pressione uma tecla para retornar ao menu.');
readkey;
end;

//------------------------------------------------------------------------------

procedure change(var a:agenda; var ultimo:integer);
var cod2,cont:integer;

begin
clrscr;
Write('Informe o c¢digo: '); readln(cod2);
for cont := 1 to ultimo do
if (cod2 = a[cont].cod)
then begin
writeln('::Alterar uma nota::');
write('Nota [', a[cont].nota, ']: ');
write('Digite nova nota: '); readln(a[cont].nota);
writeln('Data: ');
write('Dia [', a[cont].dia,']: ');
write('Digite o novo dia: '); readln(a[cont].dia);
write('Mˆs [',a[cont].mes,']: ');
write('Digite o novo mes: '); readln(a[cont].mes);
Readkey;
End;
end;

//------------------------------------------------------------------------------

procedure listar(var a:agenda; var ultimo:integer);
var cont:integer;
begin
clrscr;
writeln('::Lista de Notas::');
writeln;
for cont :=1 to ultimo
do begin
if a[cont].cod <> 0
then begin
writeln('###');
writeln('Codigo: ',a[cont].cod);
writeln('Nota: ',a[cont].nota);
writeln('Data: ',a[cont].dia,'/',a[cont].mes);
writeln('###');
end;
end;
Readkey;
end;

//------------------------------------------------------------------------------

procedure ordenar(var a:agenda; var ultimo:integer);
var
cont,j,mes1,dia1,cod1: integer;
nota1:string;

begin //Ordenar Meses;
for cont := ultimo downto 2 do
for j := 1 to cont-1 do
if a[j].mes > a[j+1].mes then
begin
mes1 := a[j].mes;
a[j].mes := a[j+1].mes;
a[j+1].mes := mes1;

dia1 := a[j].dia;
a[j].dia := a[j+1].dia;
a[j+1].dia := dia1;

cod1 := a[j].cod;
a[j].cod := a[j+1].cod;
a[j+1].cod := cod1;

nota1 := a[j].nota;
a[j].nota := a[j+1].nota;
a[j+1].nota := nota1;
end;

begin //Ordenar Dias;
for cont := ultimo downto 2 do
for j := 1 to cont-1 do
if a[j].mes = a[j+1].mes then
if a[j].dia > a[j+1].dia then
begin
mes1 := a[j].mes;
a[j].mes := a[j+1].mes;
a[j+1].mes := mes1;

dia1 := a[j].dia;
a[j].dia := a[j+1].dia;
a[j+1].dia := dia1;

cod1 := a[j].cod;
a[j].cod := a[j+1].cod;
a[j+1].cod := cod1;

nota1 := a[j].nota;
a[j].nota := a[j+1].nota;
a[j+1].nota := nota1;
end;
end;

writeln('Ordenado com sucesso.');
Readkey;
end;

//------------------------------------------------------------------------------

procedure del(var a:agenda; var ultimo:integer);
var apagar:integer;
begin
clrscr;
writeln('::Excluir uma nota::');
writeln;
write('Digite o codigo da nota a ser excluida: ');
readln(apagar);
for x:=1 to ultimo do
begin
if apagar = a[x].cod then
begin
a[x].cod:=0;
writeln('Nota removida.');
Readkey;
end;
end;
end;

//------------------------------------------------------------------------------

function le_opcao:integer;
var
opcao:integer;
begin
clrscr;
writeln('Agenda de Notas');
writeln;
writeln('::::::::::Menu::::::::::');
writeln('1. Inserir uma nova nota');
writeln('2. Consultar uma nota');
writeln('3. Alterar nota');
writeln('4. Listar notas');
writeln('5. Ordenar notas');
writeln('6. Excluir nota');
writeln('7. Sair do programa');

writeln;
writeln('Escolha uma opcao valida: ' );
readln(opcao);
le_opcao:=opcao;
end;

function FileExists(FileName: string): Boolean;
var
  F: file;
begin
  {$I-}
  Assign(F, FileName);
  FileMode := 0;
  Reset(F);
  Close(F);
  {$I+}
  FileExists := (IOResult = 0) and (FileName <> '');
end;  { FileExists }

function carregar(Arq: string;var agenda: array of reg_agenda): integer;
var
     arquivo: file of reg_agenda;
     aux: reg_agenda;
     i: integer;
begin
        assign(arquivo, Arq);
        if (FileExists(Arq)) then
           reset(arquivo)
        else
           rewrite(arquivo);



        i := 0;
        while (not eof(arquivo)) do
        begin
                read(arquivo,aux);
                agenda[i] := aux;
                i := i +1;

        end;
        carregar := i;

        close(arquivo);

end;


procedure salvar(Arq: string; agenda: array of reg_agenda);
var
     arquivo: file of reg_agenda;
     aux: reg_agenda;
     i: integer;
begin

        assign(arquivo, Arq);
        rewrite(arquivo);

        for i:=0 to 99 do
        begin
                aux := agenda[i];
                write(arquivo,aux);
        end;

        close(arquivo);

end;




var
vetor:agenda;
quantidade:integer;
op:integer;
sair:boolean;
begin
sair:=false;
quantidade := carregar('teste.dat',vetor);
repeat
op:=le_opcao;
if op=1 then insere(vetor,quantidade);
if op=2 then consulta(vetor,quantidade);
if op=3 then change(vetor,quantidade);
if op=4 then listar(vetor,quantidade);
if op=5 then ordenar(vetor,quantidade);
if op=6 then del(vetor,quantidade);
if op>=7 then sair:=true;
until sair;
salvar('teste.dat',vetor);
readln;

end.

Att

[demolish]

Muito obrigado amigo!

Att.

João Paulo

Editado Julho 19, 2010 por demolish

[demolish]

Surgiu um probleminha,

toda vez que eu fecho o programa e depois abro ele com os dados guardados no arquivo, as opções ficaram com problema... inserir novo membro vem com codigo = 0, quando digita qualquer mes ele retorna dizendo q o mes é invalido mesmo estando entre 1 e 12 ;x

Quem souber como resolver, fico grato!