DataMuseum.dk

top - download

    Length: 3968 (0xf80)
    Types: TextFile
    Names: »SPMERGE.PAS«

└─⟦a1337913c⟧ Bits:30002679 PGM1 - indeholder forskellige undervisningsprogrammer
    └─ ⟦this⟧ »SPMERGE.PAS« 

TextFile

program merge_skema;
(***************************************************************************
*       Et hjælpeprogram til spskema-programmet. Dette program bruges      *
* til at flette indtastede data sammen til en fil. Dette gør det muligt    *
* at indtaste data på alle 8 maskiner.                                     *
*                                                                          *
*      OBS!  programmet må kun anvendes 1 gang på hver undersøgelse.       *
*                                                                          *
****************************************************************************)
const   maxsp=30;maxvalg=20;
type    svartype = array(.1..maxsp.) of 0..maxvalg;
        skematype = record
          nr  : integer;
          svar : svartype;
        end;
var     diska,diskb         : file of skematype;
        skema               : skematype;
        navn                : string(.8.);
        fila,filb           : string(.14.);
        fejla,fejlb         : integer;
        svar                : char;
procedure copy_a_til_b;
begin
  reset(diska);
  while not eof(diska) do begin
    read(diska,skema);
    write(diskb,skema);
    write('.');
  end;
  writeln;
  close(diska);close(diskb);  
end;  
        
begin
  write(clrhom,'   Program til overførsel af data i forbindelse med ');
  writeln('spørgeskemaundersøgelser.');
  writeln;
  writeln('HUSK, at programmet kun må anvendes 1 GANG pr undersøgelse.');
  writeln;
  writeln('Hvis det benyttes flere gange skal ALLE data indtastes igen.');
  writeln;
  writeln('Programmet skal benytte 2 disketter. Er det i orden? ');
  writeln;
  repeat
    write('     Ønsker du at fortsætte ?  (j/n)   ');
    read(kbd,svar);
  until svar in (.'J','j','N','n'.);
  writeln;
  if svar in (.'n','N'.) then halt; (* programmet standses *)
  repeat
    write('Hvad hedder undersøgelsen (max 8 tegn) ');
    readln(navn);
  until len(navn)>0;
  fila:='A:'+navn;
  filb:='B:'+navn;
  (*$i-*) assign(diska,fila+'.SPS');reset(diska); fejla:=iores;
          assign(diskb,filb+'.SPS');reset(diskb); fejlb:=iores;
  (*$i+*)
  if fejla<>0 then begin
    writeln('Den undersøgelse findes ikke!!!');
    writeln('Har du brugt et galt navn?? Programmet standses.');
    writeln('Du kan evt. skrive   DIR *.sps    for at få en oversigt.');    
    writeln('Når du har det rigtige navn kan du starte igen.');
    close(diska);close(diskb);
    halt;
  end;
  if (fejla=0) and (fejlb<>0) then begin
    writeln('Der er ikke nogen undersøgelse med det navn på diskette nr 2.');
    writeln('Hvis du har 2 diskettestationer ,og du ønsker at overføre data');
    writeln('fra station nr 1 til nr 2 ,kan du gøre det nu.');  
    write('    Ønsker du at fortsætte?   j/n ');
    repeat read(kbd,svar) until svar in (.'J','j','N','n'.);
    writeln;
    if svar in (.'N','n'.) then begin
      close(diska);close(diskb);
      halt;
    end;
    (*$i-*) rewrite(diskb); fejlb:=iores; (*$i+*)
    if fejlb<>0 then begin
      writeln('Der er stadig noget galt. Programmet stopper.');
      writeln('Du har nok overset, at der SKAL være to diskettestationer.');
      halt;
    end;
    copy_a_til_b;
   end
   else begin
     (* i dette tilfælde findes begge filer *)
     writeln('Nu kopieres. Det tager et øjeblik inden maskinen må slukkes.');
     seek(diska,length(diska));
     read(diskb,skema);
     while not eof(diskb) do begin
       read(diskb,skema);
       write(diska,skema);
     end;
     close( diskb);      
     rename(diskb,filb+'.bak');
     assign(diskb,filb+'.SPS');
     rewrite(diskb);
     copy_a_til_b;
     assign(diskb,filb+'.bak');
     erase(diskb);
     writeln('Data ligger nu på begge disketter.');
     writeln('Nu må maskinen slukkes.');
   end;  
  end.  
  «eof»