Newsgroup: it.comp.lang.pascal
Titolo: aiuto...

Salve ragazzi!
Ho tra le mani un programma che sto facendo per un mio amico, ma c'e'
qualcosa che non va... ovvero, a parte il programma che funziona ma
che fa schifo perche' non serve a niente, esso gestisce degli articoli
di giornale...
il programma prevede che si debbano poter cercare gli articoli anche
tra un intervallo di date....
l'ho fatto (anche se le date posso essere dal 1960 in poi) ma non
funzia! (procedure ricerca_date)
Inoltre anche nella cancellazione c'e' un problema: se cancello il
primo dato inserito... non cancella!!!!  (procedure elimina)
Mi aiutate prima che potete please?
Ci sono ancora altri infiniti errori ma non mi interessano!
Grazie a tutti!
Ecco di seguito il programma:
Program Gestione_Archivio_Ritagli_di_Giornale;
Uses crt;
Type
 dat = record
        g: 1..31;
        m: 1..12;
        a:integer;
        end;
 racc = record
        nome : string;
        numero : integer;
        end;
 punt_raccoglitore = ^oggetto_raccoglitore;
 oggetto_raccoglitore = RECORD
        contenuto, giornale : string[50];
        data : dat;
        nome_rac : racc;
        ch1,ch2,ch3,ch4,ch5 : string;
        prossimo : punt_raccoglitore;
        end;
Var q, base : punt_raccoglitore;
    scelta : char;
    primo : boolean;
Procedure menu;
 begin
   clrscr;
   writeln('    Gestione Archivio di Ritagli di Giornale');
   writeln;
   writeln('Scegliere l''operazione da effettuare: ');
   writeln;
   writeln(' 1 - Inserimento Articolo di Giornale');
   writeln(' 2 - Ricerca Articolo');
   writeln(' 3 - Visualizza elenco Raccoglitori');
   writeln(' 4 - Eliminazione di un articolo');
   writeln(' 5 - Uscita');
   writeln;
   write('--> ');
   readln(scelta);
 end;
Procedure inserimento (var q,base : punt_raccoglitore);
Var inser_articolo : punt_raccoglitore;
    s,s1,s2,s3 : string;
    p : integer;
begin
 clrscr;
  new(inser_articolo);
  writeln('            Inserimento Articolo di Giornale');
  writeln;
  write('Inserire nome del raccoglitore: ');
  readln(inser_articolo^.nome_rac.nome);
  inser_articolo^.ch4:= inser_articolo^.nome_rac.nome;
  write('Inserire numero d''ordine: ');
  readln(inser_articolo^.nome_rac.numero);
  str(inser_articolo^.nome_rac.numero,s);
  inser_articolo^.ch5:=s;
  writeln('Inserire la data di pubblicazione: ');
  writeln('giorno: ');
  readln(inser_articolo^.data.g);
  str(inser_articolo^.data.g,s1);
  writeln('mese: ');
  readln(inser_articolo^.data.m);
  str(inser_articolo^.data.m,s2);
  writeln('anno: ');
  readln(inser_articolo^.data.a);
  str(inser_articolo^.data.a,s3);
  inser_articolo^.ch2:=concat(s1,s2,s3);
  write('Inserire nome del giornale: ');
  readln(inser_articolo^.giornale);
  inser_articolo^.ch3:=inser_articolo^.giornale;
  write('Inserire contenuto: ');
  readln(inser_articolo^.contenuto);
  p:=pos(' ',inser_articolo^.contenuto);
  inser_articolo^.ch1:=copy(inser_articolo^.contenuto,1,p-1);
  inser_articolo^.prossimo :=NIL;
  if primo then begin
                 base := inser_articolo;
                 primo := false;
                end;
  q^.prossimo :=inser_articolo;
  q := inser_articolo;
  writeln;
  writeln('...premi ENTER per continuare');
  readln;
  end;
Procedure elenco_articoli (var base : punt_raccoglitore);
var scan_ritagli : punt_raccoglitore;
begin
 clrscr;
 scan_ritagli :=base;
 writeln('           Elenco Raccoglitori');
 writeln;
 Repeat
  writeln(' Raccoglitore
',scan_ritagli^.nome_rac.nome,'/',scan_ritagli^.nome_rac.numero);
  writeln(' Nome del giornale: ',scan_ritagli^.giornale);
  writeln(' Data di pubblicazione:
',scan_ritagli^.data.g,'/',scan_ritagli^.data.m,'/',scan_ritagli^.data.a);
  writeln(' Contenuto: ',scan_ritagli^.contenuto);
  writeln;
  writeln('...premi ENTER per continuare');
  readln;
  scan_ritagli := scan_ritagli^.prossimo;
  Until scan_ritagli = NIL;
  writeln('...premi ENTER per continuare');
  readln;
  end;
Procedure ricerca;
 procedure menuricerca;
 begin
  clrscr;
  writeln('    Ricerca di un articolo');
  writeln;
  writeln('Scegliere il tipo di ricerca da effettuare: ');
  writeln;
  writeln(' 1 - Ricerca di un articolo per parola chiave');
  writeln(' 2 - Ricerca di articoli tra due date');
  writeln(' 3 - Ricerca di articoli date due parole chiave');
  writeln(' 4 - Ritorna al menu principale');
  writeln;
  write('--> ');
  readln(scelta);
 end;
 Procedure ricerca_1parola (base : punt_raccoglitore);
 var scelta : integer;
     cerca_ritagli1 : punt_raccoglitore;
 
   Procedure numero(base: punt_raccoglitore);
   var numero : integer;
   begin
    write('Inserisci la parola chiave: ');
    readln(numero);
    cerca_ritagli1 := base;
     repeat
      if cerca_ritagli1^.nome_rac.numero = numero
       then begin
      writeln(' Raccoglitore:
',cerca_ritagli1^.nome_rac.nome,'/',cerca_ritagli1^.nome_rac.numero);
      writeln(' Nome giornale: ',cerca_ritagli1^.giornale);
      writeln(' Data di pubblicazione: ',
cerca_ritagli1^.data.g,'/',cerca_ritagli1^.data.m,'/',cerca_ritagli1^.data.a);
      writeln(' Contenuto: ',cerca_ritagli1^.contenuto);
      writeln;
      writeln('...premi ENTER per continuare');
      readln;
       end;
    cerca_ritagli1 := cerca_ritagli1^.prossimo;
    Until cerca_ritagli1 = NIL;
    writeln('Fine elenco articolo data una parola chiave!');
    writeln('...premi ENTER per continuare');
    readln;
   end;
   Procedure parola(base:punt_raccoglitore);
   var parola : string;
   begin
    write('Inserisci la parola chiave: ');
    readln(parola);
    cerca_ritagli1 := base;
     repeat
      if (cerca_ritagli1^.ch1 = parola)
         or (cerca_ritagli1^.ch3 = parola)
         or (cerca_ritagli1^.ch4 = parola)
         or (cerca_ritagli1^.ch2 = parola)
         or (cerca_ritagli1^.ch5 = parola)             
         then begin
      writeln(' Raccoglitore:
',cerca_ritagli1^.nome_rac.nome,'/',cerca_ritagli1^.nome_rac.numero);
      writeln(' Nome giornale: ',cerca_ritagli1^.giornale);
      writeln(' Data di pubblicazione: ',
cerca_ritagli1^.data.g,'/',cerca_ritagli1^.data.m,'/',cerca_ritagli1^.data.a);
      writeln(' Contenuto: ',cerca_ritagli1^.contenuto);
      writeln;
      writeln('...premi ENTER per continuare');
      readln;
       end;
    cerca_ritagli1 := cerca_ritagli1^.prossimo;
    Until cerca_ritagli1 = NIL;
    writeln('Fine elenco articolo data una parola chiave!');
    writeln('...premi ENTER per continuare');
    readln;
   end;
 begin
  clrscr;
  writeln('           Ricerca articolo data una parola chiave');
  writeln('La parola chiave e'': ');
  writeln(' 1 - un numero');
  writeln(' 2 - una parola');
  writeln('scelta: ');
  readln(scelta);
  case scelta of
  1: numero(base);
  2: parola(base);
  end;
end; (*fine procedura ricerca_parola*)
Procedure ricerca_date (base : punt_raccoglitore);
 type numgiorni= 1..maxint;
 var data:dat;
     giorni1, giorni2, diff, diff2 : numgiorni;
     cerca_ritagli1 : punt_raccoglitore;
 Function differenza(m:integer;g:integer;a:integer): numgiorni;
  var giorni: 1..maxint;
  begin
  giorni := trunc(30.42*(data.m-1)) + data.g;
  if data.m=2 then giorni:= giorni+1;
  if (data.m>2) and (data.m<8) then giorni:=giorni-1;
  if (data.a mod 4 =0) and (data.m>2) then giorni:=giorni+1;
  if (data.a-1960) div 4>0 then giorni := giorni+1461*((data.a-1960)
div 4);
  if (data.a-1960) mod 4>0 then giorni := giorni+365*((data.a-1960)
mod 4) +1;
  differenza:=giorni;
  end;
 begin
  clrscr;
  writeln('           Ricerca articoli archiviati tra due date');
  writeln('Inserisci la prima data ');
  writeln('giorno: ');
  readln(data.g);
  writeln('mese: ');
  readln(data.m);
  writeln('anno: ');
  readln(data.a);
  giorni1:=differenza(data.m,data.g,data.a);
  writeln('Inserisci la seconda data ');
  writeln('giorno: ');
  readln(data.g);
  writeln('mese: ');
  readln(data.m);
  writeln('anno: ');
  readln(data.a);
  giorni2:=differenza(data.m,data.g,data.a);
  diff:=giorni2-giorni1;
  diff2:=diff;
    cerca_ritagli1 := base;
     repeat
      if
diff2<differenza(cerca_ritagli1^.data.m,cerca_ritagli1^.data.g,cerca_ritagli1^.data.a)-giorni1
         then begin
          writeln(' Raccoglitore:
',cerca_ritagli1^.nome_rac.nome,'/',cerca_ritagli1^.nome_rac.numero);
          writeln(' Nome giornale: ',cerca_ritagli1^.giornale);
          writeln(' Data di pubblicazione: ',
cerca_ritagli1^.data.g,'/',cerca_ritagli1^.data.m,'/',cerca_ritagli1^.data.a);
          writeln(' Contenuto: ',cerca_ritagli1^.contenuto);
          writeln;
          writeln('...premi ENTER per continuare');
          readln;
             end;
    cerca_ritagli1 := cerca_ritagli1^.prossimo;
    Until cerca_ritagli1 = NIL;
    writeln('Fine elenco articolo dato un intervallo di tempo!');
    writeln('...premi ENTER per continuare');
    readln;
end; (*fine procedura ricerca_date*)
 Procedure ricerca_2parole (base : punt_raccoglitore);
 var parola1,parola2:string;
     cerca_ritagli1 : punt_raccoglitore;
 begin
  clrscr;
  writeln('           Ricerca articolo date due parole chiavi');
  write('Inserisci la prima parola chiave: ');
  readln(parola1);
  write('Inserisci la seconda parola chiave: ');
  readln(parola2);
    cerca_ritagli1 := base;
     repeat
      if (cerca_ritagli1^.ch1 = parola1)
         or (cerca_ritagli1^.ch3 = parola1)
         or (cerca_ritagli1^.ch4 = parola1)
         or (cerca_ritagli1^.ch2 = parola1)
         or (cerca_ritagli1^.ch5 = parola1)
         then if (cerca_ritagli1^.ch1 = parola2)
         or (cerca_ritagli1^.ch3 = parola2)
         or (cerca_ritagli1^.ch4 = parola2)
         or (cerca_ritagli1^.ch2 = parola2)
         or (cerca_ritagli1^.ch5 = parola2)
         then begin
      writeln(' Raccoglitore:
',cerca_ritagli1^.nome_rac.nome,'/',cerca_ritagli1^.nome_rac.numero);
      writeln(' Nome giornale: ',cerca_ritagli1^.giornale);
      writeln(' Data di pubblicazione: ',
cerca_ritagli1^.data.g,'/',cerca_ritagli1^.data.m,'/',cerca_ritagli1^.data.a);
      writeln(' Contenuto: ',cerca_ritagli1^.contenuto);
      writeln;
      writeln('...premi ENTER per continuare');
      readln;
       end;
    cerca_ritagli1 := cerca_ritagli1^.prossimo;
    Until cerca_ritagli1 = NIL;
    writeln('Fine elenco articolo date due parole chiavi!');
    writeln('...premi ENTER per continuare');
    readln;
end; (*fine procedura ricerca_parola*)
Begin
 repeat menuricerca;
 Case scelta of
 '1' : ricerca_1parola(base);
 '2' : ricerca_date(base);
 '3' : ricerca_2parole(base);
 '4' : end;
 until scelta ='4';
 menu;
end;
Procedure elimina (base:punt_raccoglitore);
var trovato : boolean;
    ricerca_ritagli, precede : punt_raccoglitore;
    nome : string;
    numero : integer;
begin
 trovato :=false;
 writeln;
 write('Inserisci raccoglitore da eliminare: ');
 readln(nome);
 write('Inserisci numero del raccoglitore: ');
 readln(numero);
 ricerca_ritagli := base;
 while (trovato = false) and (ricerca_ritagli <> NIL) do
 begin
  if (ricerca_ritagli^.nome_rac.nome = nome)
  and  (ricerca_ritagli^.nome_rac.numero = numero)
  then begin
          trovato := true;
       end
  else begin
          precede := ricerca_ritagli;
          ricerca_ritagli := ricerca_ritagli^.prossimo;
       end;
 end;
if trovato = true then
 begin
  if ricerca_ritagli = base
  then base :=ricerca_ritagli^.prossimo
  else precede^.prossimo := ricerca_ritagli^.prossimo;
  Dispose(ricerca_ritagli);
  writeln('Raccoglitore
',ricerca_ritagli^.nome_rac.nome,'/',ricerca_ritagli^.nome_rac.numero);
  write('eliminato!');
 end
else writeln('Raccoglitore non trovato');
writeln('...premi ENTER per continuare');
readln;
end;
Procedure svuotamemoria (var base : punt_raccoglitore);
var svuota_archivio : punt_raccoglitore;
begin
 if base <> NIL
    then begin
         while base^.prossimo <> NIL do
           begin
            svuota_archivio := base^.prossimo;
            dispose(base);
            base := svuota_archivio;
           end;
          end;
end;
(*********************************************************)
begin  (*Main Program*);
primo := true;
base:= NIL;
q := NIL;
repeat menu;
 case scelta of
  '1' : inserimento(q,base);
  '2' : ricerca;
  '3' : elenco_articoli(base);
  '4' : elimina(base);
  '5' : end;
until scelta ='5';
svuotamemoria(base);
writeln;
writeln('  Gestione archivio di ritagli di giornale');
writeln('                   Fine');
readln
end.
Arianna Microchip
ari...@softhome.net
Web: 
http://arianna.cjb.net
http://consolicarmen.cjb.net

 wrote in message
0bnfot82a3pc5kbda...@4ax.com...



Scusa se te lo dico... ma non è che puoi pretendere chissà che grandi aiuti
buttando giù un progetto da 370 righe e senza alcun commento.
Se ci avessi dato la procedura che non va o un problema specifico sarebbe
andato bene. Ma così no!
Ciao
Alex

Hai ragionissima!!
Cmq scusate!
Il problema e' risolto! Ho cambiato totalmente la procedura!


Arianna Microchip
