{
I found this source on my *old* red hat linux partition.
Compiles under Free Pascal and Delphi. Make sure the file

ends with .dpr if you intend to compile it in Deplhi.

David Grundberg 2005-10-02
}

program Lista;

{$IFDEF MSWINDOWS}
  { Delphi }
  {$APPTYPE console}

{$ELSE}
  { DOS/Free Pascal on Linux }
  uses crt;
{$ENDIF}

type
  PField = ^TField;
  TField = record

             Name, Address, Postal, Telephone : string;
             next,prev : PField;
           end;

var
  svar : char;
  first, last : PField;

  temp,temp2 : PField;

function NewField : PField;
var

  ny : PField;
begin
  new(ny);
  ny^.name:='';
  ny^.address:='';
  ny^.postal:='';
  ny^.telephone:='';
  ny^.prev:=last;
  ny^.next:=nil;
  if last = nil then

    first:=ny
  else
    last^.next:=ny;
  last:=ny;

  NewField:=ny;
end;

procedure DeleteField(field:PField);
begin
  if field = nil then exit;
  if field^.next <> nil then

    field^.next^.prev:=field^.prev;
  if field^.prev <> nil then
    field^.prev^.next:=field^.next;
  if last = first then first:=nil;
  if last = field then last:=field^.prev;
  dispose(field);

end;

begin
  last:=nil;
  first:=nil;
  repeat
    Writeln('***** Turboadressboken! *****');
    Writeln('Meny: 1. Skriv in ny uppgift');
    Writeln('      2. Visa alla uppgifter');
    Writeln('      3. Ta bort vissa uppgift(er)');
    Writeln('      q. Avsluta');
    repeat

      {$IFDEF MSWINDOWS}
        readln(svar);
      {$ELSE}
        svar:=readkey;
      {$ENDIF}
    until (svar in ['1','2','3','q','Q']);
    if svar = '1' then

    begin
      temp:=NewField;
      writeln('Namn:');
      readln(temp^.name);
      writeln('Adress:');
      readln(temp^.address);
      writeln('Postnummer:');
      readln(temp^.postal);
      writeln('Telefon:');
      readln(temp^.telephone);
    end

    else if svar = '2' then
    begin
      temp:=first;
      while temp <> nil do

      begin
        Writeln('Namn:', temp^.name);
        temp:=temp^.next;
      end;
    end
    else if svar = '3' then

    begin
      temp:=first;
      while temp <> nil do
      begin
        temp2:=temp^.next;
        Writeln('Ta bort ',temp^.name,'? J/N ');
        repeat

          {$IFDEF MSWINDOWS}
            readln(svar);
          {$ELSE}
            svar:=readkey;
          {$ENDIF}
        until (svar in ['J','j','N','n']);
        if svar in ['j','J'] then

          DeleteField(temp);
        temp:=temp2;
      end;
    end;

  until (svar in ['q','Q']);
  while last <> nil do

  begin
    DeleteField(last);
  end;
  Writeln('Tack för att du valde Turboadressboken!');
end.