Jump to content

Ajuda em Pascal base de Dados


Cardozo12
 Share

Recommended Posts

Boas.

Sou novo neste forum e venho por este meio pedir uma pequena ajuda.  :wallbash:

Tenho um projecto para fazer até dia 14 de Janeiro, e ja tenho grande parte trabalhada(Utilizo o Turbo Pascal for Windows), o objectivo do trabalho é fazer uma base de dados escolar.

Onde é presiso 4 procedimentos:

1-Adicionar Registos(Tem de ter Nome,Ano, Turma, Nº Bi, Ano lectivo, Nº Processo..)

2-Consultar Registos(Consultar pelo nº de processo e nome)

3-Alterar Registos

4-Eliminar Registos

Neste momento só presiso de ajuda no nº 2 e no nº 4.

Pois sou um bocado mau (muito ?) a Pascal

Podiam me dar Ideias como fazer estes dois topicos

Agradeço a ajuda

Link to comment
Share on other sites

program projecto;
uses wincrt;
type registo=Record
     nome:string[15];
     morada:string[30];
     idade:integer;
     bi:integer;
     processo:integer;
     ano:integer;
     turma:string[1];
     lectivo:integer;
     activo:integer;
end;
var fich1:file of registo;
    aluno:registo;
    op:char;

{------------------------------------MENU-------------------------------------------------}

procedure menu;
begin
     clrscr;
     writeln('<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<Menu>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>');
     writeln;
     writeln('                   Prima tecla 1 para introduzir registos.');
     writeln;
     writeln('                   Prima tecla 2 para consultar os registos.');
     writeln;
     writeln('                   Prima tecla 3 para alterar registos.');
     writeln;
     writeln('                   Prima tecla 4 para eliminar registos.');
     writeln;
     writeln('                   Prima tecla 0 para terminar o programa.');
     repeat
           op:=readkey
     until op in ['0'..'4']
end;


{-----------------------------TESTA A EXISTENCIA DE FICHEIRO------------------------------}
function existeficheiro:boolean;
begin
     assign(fich1, 'Pessoas.dat');
     {§I-};
     reset(fich1); close(fich1);
     {§I+};
     existeficheiro:=(IoResult=0);
end;


{---------------------------------INTRODUÇÃO DE REGISTOS-------------------------------------}

procedure introduzir;
var c,n:integer;
    esc,op:char;
begin
     clrscr;
     write('<<<<<<<<<<<<<<<<<<<<<<<<<<<<<Introdução de Registos>>>>>>>>>>>>>>>>>>>>>>>>>>>>>');
     writeln;
     if existeficheiro then
        reset(fich1)
     else
         rewrite(fich1);
     writeln;
     esc:='s';
     while esc='s' do                             
     begin
          write('Nome do Aluno: ');readln(aluno.nome);
          write('Idade: ');readln(aluno.idade);
          write('Morada: ');readln(aluno.morada);
          write('Número do Bilhete de Identidade: ');readln(aluno.bi);
          write('Número do Processo: ');readln(aluno.processo);
          write('Ano: ');readln(aluno.ano);
          write('Turma: ');readln(aluno.turma);
          write('Ano Lectivo: ');readln(aluno.lectivo);
          writeln;
          seek(fich1, filesize(fich1));
          writeln('Confirma o registo?');
          readln(op);
          if op='s' then
          write(fich1, aluno);
          writeln('Pretende introduzir um novo registo?');
          readln(esc);
     end;
     close(fich1);
end;

{--------------------------------CONSULTAR REGISTOS--------------------------------------}

procedure consultar;
begin
  ExisteFicheiro;
  reset(fich1);
  while not eof(fich1) do
   begin
    clrscr;
     read(fich1,aluno);
     writeln('Nome: ',aluno.nome);
     writeln('Idade: ',aluno.idade);
     writeln('Morada: ',aluno.morada);
     writeln('BI: ',aluno.bi);
     writeln('Nº do Processo: ',aluno.processo);
     writeln('Ano: ',aluno.ano);
     writeln('Turma: ',aluno.turma);
     writeln('Ano Lectivo: ',aluno.lectivo); 
     writeln(aluno.activo);
     readln;
   end;
   close(fich1);
end;

{------------------------------------ALTERAR REGISTOS------------------------------------}

procedure alterar;
var n:integer;
    k:char;
begin
     clrscr;
     if not existeficheiro then
     begin
          writeln('Ficheiro inexistente');
          write('Tecle Enter para Menu');
          repeat until readkey=#13
     end
     else
     begin
          reset(fich1);
          writeln('<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<Alteração de Registos>>>>>>>>>>>>>>>>>>>>>>>>>>>>>');
          writeln;
          repeat
                write('Nº do registo a consultar');
                writeln(' entre 1 e ', filesize(fich1));
                read(n);
          until (n>0) and (n<=filesize(fich1));
          seek(fich1, n-1);
          read(fich1, aluno);
          writeln(aluno.nome:15, aluno.bi:8, aluno.processo:4, aluno.lectivo:4, aluno.idade:2, aluno.morada:30, aluno.turma:2,
aluno.ano:2);
          write('Alterar os dados? S/N -> ');
          repeat
                k:=upcase(readkey)
          until k in ['S','N'];
          writeln;
          if k='S' then
          begin
               write('Escreva o novo nome: ');
               repeat
                     readln(aluno.nome);
               until aluno.nome <>'';
               write('Escreva a nova idade: ');
               readln(aluno.idade);
               write('Escreva a nova morada: ');
               readln(aluno.morada);
               write('Escreva a novo nº do bilhete de identidade: ');
               readln(aluno.bi);
               write('Escreva o novo nº do processo: ');
               readln(aluno.processo);
               write('Escreva o novo ano: ');
               readln(aluno.ano);
               write('Escreva a nova turma: ');
               readln(aluno.turma);
               write('Escreva o novo ano lectivo: ');
               readln(aluno.lectivo);
               seek (fich1, n-1);
               write(fich1,aluno);
          end;
          close(fich1);
     end;
end;
         

{--------------------------------ELIMINAR REGISTOS-------------------------------------}
procedure eliminar;
var resp:char;
begin
     clrscr;
     reset(fich1);
        writeln('<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<Eliminação de Registos>>>>>>>>>>>>>>>>>>>>>>>>>>>>');
        writeln (' ');
        readln;
        write ('NUMERO INTERNO : ');
        readln (aluno.processo);
        clrscr;
        while not eof (fich1) do
        begin
                begin
                clrscr;
                writeln('Registo ',aluno.processo);
                writeln('Pretende eliminar este registo? S\N?');
                readln(resp);
                if (resp='s') or (resp='S') then
                {aluno.processo:='*';}
                write(fich1,aluno);
                clrscr;
               end;
        end;
end;


{-----------------------------------PROGRAMA PRINCIPAL--------------------------------}

begin
     repeat
           menu;
           case op of
                
                '1':introduzir;
                '2':consultar;
                '3':alterar;
                '4':eliminar;
           end;
     until op='0'

Ja me podem ajudar melhor agora?

Link to comment
Share on other sites

A consulta de registos pode ser feita da seguinte forma (a menos que te digam que deve ser feito de outra forma): lês o ficheiro de forma sequência e mostras os valores no ecrã. Por exemplo, avanças sempre que o utilizador pressionar "P"(próximo) ou a barra de espaços ou enter ou qualquer outra tecla.

Para eliminar um registo tens de carregar o ficheiro para memória, eliminar o registo em memória e depois escreveres o ficheiro de novo, já sem o registo que foi eliminado.

Podes, por exemplo, fazer uma cópia, registo a registo, do ficheiro actual para um ficheiro novo temporário (Podes fazer a leitura de forma igual à funcionalidade de consulta).

Quando chegares ao registo que queres eliminar, não o copias para o ficheiro temporário (ignoras esse registo). No final eliminadas o ficheiro actual e renomeias o ficheiro temporário para ser o teu novo ficheiro de dados.

10 REM Generation 48K!
20 INPUT "URL:", A$
30 IF A$(1 TO 4) = "HTTP" THEN PRINT "400 Bad Request": GOTO 50
40 PRINT "404 Not Found"
50 PRINT "./M6 @ Portugal a Programar."

 

Link to comment
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
 Share

×
×
  • Create New...

Important Information

By using this site you accept our Terms of Use and Privacy Policy. We have placed cookies on your device to help make this website better. You can adjust your cookie settings, otherwise we'll assume you're okay to continue.