Program SortPostings;

{ Version 1.01: 04.08.91

  - Kickpascal 2.02 holte evtl. bestehende CustomScreens beim
    öffnen von Windows mit "Open_window" nach vorne:
    Durch Update auf KP 2.044 und erneutes compilieren beseitigt.

}


{ Mit diesem Programm kann man die Datenfiles anhand der Postings von
  Fred Fish auf den neusten Stand bringen. Diese Texte mit den Contents
  der jeweils neuesten Fishes kommen als Crossposting aus dem Usenet
  auch in viele deutsche/internationale Netze, bevor die neuen Fishdisks
  in Deutschland erhältlich sind.

  Diese Programm stammt von:

         Henrich Deppenmeier
         Turnerstr. 50
         4800 Bielefeld 1
         Germoney

  und wurde im Mai 1991 in Kick-Pascal 2.0 geschrieben.

  ACHTUNG: Ich empfehle definitiv, vor starten dieses Programmes ein Backup
  von den Datenfiles zu machen. Ich gebe absolut keine Garantie darauf,
  daß dieses Programm jeden Formatfehler im Posting abfängt. Es wird in
  den allermeisten Fällen unumgänglich sein, den aus der Mailbox gezogenen
  Text mit einem Editor so zu bearbeiten, daß er den
  Formatierrichtlinien,die in der Anleitung beschrieben sind, genügt.

  Es funktioniert sowohl mit den original Aquarium - Dateien als auch
  mit den durch 'Schrumpf_daten' generierten Dateien.

  Source und Programm sind 'FDS', d.h. frei kopierbare Software MIT
  COPYRIGHT des Autors.

  Dieses Programm darf beliebig genutzt und verteilt werden, aber es ist
  verboten, damit Gewinn zu erzielen.

  Diese Programm darf auf keinen Fall auf PD-Disketten vertrieben werden,
  die teurer als 4,- DM sind.

  Der Source darf verändert werden, um das Programm eigenen Wünschen
  anzupassen, es wäre jedoch nett, wenn ein Hinweis auf den ursprünglichen
  Autor (nämlich mich...:-) ) drinbleibt.

}


uses crt;

{$incl 'req.lib','exec/memory.h'}

type Indx = Record
               Class:Long;                 { Flags for Source,games,etc.}
               DiskNum:word;
               Offset:Long;                { for Datafile...}
               Desclength:word;            { length including those 56 '0's ..}
               rfu : word;                 { and some more wasted Bytes..}
             end;

     Progname=String[20];
     Directoryname = String[DSize];
     Filename      = String[Fchars];
     Pathname      = String[162];

     errormessage=string[255];

var Datafilename:String;
    DAtafile:file of char;
    Indexfilename:string;
    Indexfile:file of indx;
    index:indx;
    Namefilename:string;
    Namefile:file of progname;

    dirn:Directoryname;
    postingname:pathname;

    shrunkfile:boolean;
    button:long;

    NumRecords:integer;
    actualdisk:integer;

    errormsg:errormessage;


procedure exitserver;

begin
  Writeln;
  Writeln('Zum Beenden eine Taste drücken.');
  waitforkey;
end;


Procedure endit(endmsg:Errormessage);

{ gives the final message }

var result:long;

begin
  writeln('Fehler: ',endmsg);
  halt(10);
end;


Function TRequest(Titel,question,pos,middle,neg:str):long;

{ Requester with 1-3 Buttons from req.library }

Var Textreq : TRStructure;

  begin
    With Textreq do
      begin
        Text           := question;
        Controls       := nil;
        Window         := NIL;
        MiddleText     := middle;
        PositiveText   := pos;
        NegativeText   := neg;
        Title          := Titel;
        Keymask        := $FFFF;
        textcolor      := 1;
        detailcolor    := 2;
        blockcolor     := 1;
        versionnumber  := 0;
        rfu1           := 0;
        rfu2           := 0;
      end;
    openlib(reqbase,'req.library',0);
    TRequest:=Textrequest(^Textreq);
    closelib(reqbase);
  end;


Procedure FileReq (Windowtitel : Str; Var Dir:Directoryname;
                   Var Filename: Pathname);

{ The glourious Filerequester of the req.library }

  Var Freq        : ^FileRequester;
      Path        : Pathname;
      returnvalue : long;

  Label EndFileReq;

  begin
      openlib(reqbase,'req.library',0);
      Freq:=Ptr(allocmem(sizeof(Filerequester),Memf_Public));
      if Freq=Nil then
        begin
         errormsg:='No Memory for Filerequester !'+chr(10);
         endit(errormsg);
        end;

      FReq^:=Filerequester(
            0,                { VersionNumber     }
            Windowtitel,      { Title             }
            ^Dir,             { Dir               }
            ^Filename,        { File              }
            ^Path,            { PathName          }
            NIL,              { Window            }
            0,                { MaxExtendedSelect }
            12,               { numlines          }
            35,               { numcolumns        }
            10,               { devcolumns        }
            FRQLoading,       { Flags             }
            3,                { dirnamescolor     }
            1,                { filenamescolor    }
            3,                { devicenamescolor  }
            3,                { fontnamescolor    }
            1,                { fontsizescolor    }
            2,                { detailcolor       }
            1,                { blockcolor        }
            1,                { gadgettextcolor   }
            1,                { textmessagecolor  }
            1,                { stringnamecolor   }
            1,                { stringgadgetcolor }
            1,                { boxbordercolor    }
            1,                { gadgetboxcolor    }
            chr(0),           { RFU_Stuff         }
            datestamp(0,0,0), { DirDateStamp      }
            0,                { WindowLeftEdge    }
            0,                { WindowTopEdge     }
            0,                { FontYSize         }
            0,                { FontStyle         }
            nil,              { ExtendedSelect    }
            '',               { Hide              }
            '',               { Show              }
            0,                { FileBufferPos     }
            0,                { FileDispPos       }
            0,                { DirBufferPos      }
            0,                { DirDispPos        }
            0,                { HideBufferPos     }
            0,                { HideDispPos       }
            0,                { ShowBufferPos     }
            0,                { ShowDispPos       }
            nil,              { Memory            }
            nil,              { Memory2           }
            nil,              { Lock              }
            '',               { PrivateDirBuffer  }
            nil,              { FileInfoBlock     }
            0,                { NumEntries        }
            0,                { NumHiddenEntries  }
            0,                { filestartnumber   }
            0                 { devicestartnumber }
            );

    returnvalue:=fileRequest(Freq);
    IF returnvalue<>0 then
      Filename:=Path
    else
      Filename:='';
    freemem(long(Freq),Sizeof(FileRequester));
    EndFileReq:
    closelib(reqbase);
  end;




Procedure getconfig;

{ gets the right Filenames }

var f:text;

begin
  reset(f,'S:FischersFreund.config');
  if IOresult=0 then
    begin
      readln(f,indexfilename);
      readln(f,namefilename);
      readln(f,datafilename);
      close(f);
    end
  else
    begin
      errormsg:='Das Konfigurationsfile s:FischersFreund.config'+chr(10)+
                'konnte nicht geöffnet werden. Du mußt erst'+chr(10)+
                'FischersFreund starten !'+chr(10);
      endit(errormsg);
    end;
end;


function lookdatafile:boolean;

{ returns True if the Datafileformat is the short one produced by shrink_datas }

var f:file of char;
    i:integer;
    b:char;

begin
  lookdatafile:=false;
  reset(datafile,datafilename);
  seek(datafile,index.offset);
  if index.desclength > 56 then
    begin
      for i:=1 to index.desclength-56 do
        read(datafile,b);
      for i:=1 to 50 do
        begin
          read(datafile,b);
          if b<>'' then
            begin
              lookdatafile:=true;
            end;
        end;
    end
  else
    lookdatafile:=true;
end;


Function getlength(name:Filename):Long;

{returns length of file}

var f:text;

begin
  reset(f,name);
  if ioresult<>0 then
    begin
      errormsg:='Kann File nicht öffnen: '+name;
      endit(errormsg);
    end
  else
    begin
      getlength:=filesize(f);
      close(f);
    end;
end;




Procedure Scancontents;

{ Upgrades all Data-Files with the new Entries and Descriptions }

Type line=string[100];

var i:integer;
    f:text;
    s,t:line;
    name:progname;
    c:char;
    length:integer;
    endposition:long;
    disknumfound:boolean;
    startdisk:integer;
    saved:boolean;

label endscan;

     Procedure Openfiles;

     { Will adjust the temperature to 23° Celsius :-* }

     begin
       numrecords:=getlength(namefilename) Div 20;
       Reset(indexfile,indexfilename);
       if IOresult=0 then
         begin
           seek(indexfile,numrecords-1);
           read(indexfile,index);
           close(indexfile);
         end
       else
         begin
           errormsg:='Kann Indexfile nicht öffnen !'+chr(10);
           endit(errormsg);
         end;
       endposition:=index.offset+index.desclength;
       index.offset:=endposition;
       reset(f,postingname);
       if IOresult<>0 then
         begin
           errormsg:='Kann Datei nicht öffnen: '+postingname+chr(10);
           endit(errormsg);
         end
       else
         buffer(f,4096);
       errormsg:='Kann Datei nicht öffnen : ';
       reset(indexfile,indexfilename);
       if IOresult <> 0 then
         begin
           errormsg:=errormsg+indexfilename+chr(10);
           endit(errormsg);
         end
       else
         buffer(indexfile,10000);
       seek(indexfile,numrecords);
       reset(namefile,namefilename);
       if IOresult <> 0 then
         begin
           errormsg:=errormsg+namefilename+chr(10);
           endit(errormsg);
         end
       else
         buffer(namefile,10000);
       seek(namefile,numrecords);
       reset(datafile,datafilename);
       if IOresult <> 0 then
         begin
           errormsg:=errormsg+datafilename+chr(10);
           endit(errormsg);
         end
       else
         buffer(datafile,10000);
       seek(datafile,endposition);
     end;


     procedure stripendblanks(var s:line);

     { removes blanks at end of line }

     var i,len:integer;

     begin
       while (strlen(s)>0) and (s[strlen(s)]=' ')  do
         s[strlen(s)]:=chr(0);
     end;


     procedure stripleadblanks(var s:line);

     { removes blanks at beginning of line }

     var i:integer;

     begin
       i:=1;
       while (ord(s[i])=9) or(s[i]=' ') do
         inc(i);
       delete(s,1,i-1);
     end;


     Function NewDisknumfound:boolean;

     { Returns True, if 'CONTENTS OF DISK '+ No. or
       'THIS IS DISK '+No. is found }

     var found:boolean;
         t,u:string;
         I:integer;

     begin
       found:=false;
       if s<>'' then
         begin
           u:='';
           for I:=1 to strlen(s) do
             u:=u+upcase(s[i]);
           t:='THIS IS DISK '+intstr(actualdisk);
           if pos(t,u)<>0 then
             found:=true;
           t:='CONTENTS OF DISK '+intstr(actualdisk);
           if pos(t,u)<>0 then
             found:=true;
         end;
         newdisknumfound:=found;
     end;



     function blankline:boolean;

     {Returns True, if Line is 'empty'}

     var blank:boolean;
         i:integer;

     begin
       blank:=true;
       i:=1;
       if strlen(s)>0 then
         begin
           repeat
             case ord(s[i]) of
               32,9,10,12:begin
                          end;
               otherwise  blank:=false;
             end;
             inc(i);
           until (i>strlen(s)) or (blank=false);
         end;
       blankline:=blank;
     end;



     Procedure Saveit;

     { Update the Datafiles }

     begin
       openfiles;
       repeat
         read(f,s)
       until newdisknumfound;
       repeat
         clrscr;
         inc(actualdisk);
         {read rest of Header}
         repeat
           read(f,s);
         until (blankline) or eof(f);
         {read blank Lines}
         repeat
           read(f,s)
         until (blankline=false) or eof(f);
         {get name & description of the program}
         while (newdisknumfound=false) and (not eof(f)) do
           begin
             clrscr;
             gotoxy(1,1);
             Writeln('Saving : Amigalibdisk:',actualdisk-1);
             { get name }
             name:='';
             i:=1;
             repeat
               name:=name+s[i];
               inc(i);
             until (ord(s[i])=9) or (ord(s[i])=32) or (i>strlen(s));
             repeat
               if name[strlen(name)]=' ' then
                 name[strlen(name)]:=chr(0);
             until (name[strlen(name)] <> ' ') or (strlen(name)=0);
             delete(s,1,strlen(name));
             if strlen(name)<19 then
               begin
                 For I:=strlen(name) to 19 do
                   name:=name+' ';
                 name[20]:=chr(0);
               end
             else
               begin
                 delete(name,19,strlen(name)-19);
                 name:=name+chr(0);
               end;
             gotoxy(1,3);
             Writeln('Name: ',name);
             Write(Namefile,name);
             { Get the rest of the first line }
             Writeln;
             Writeln('Beschreibung:');
             Writeln;
             length:=0;
             stripleadblanks(s);
             s:=s+chr(0);
             {get Rest of Description}
             repeat
               write(datafile,s,chr(0));
               writeln(s);
               length:=length+strlen(s)+1;
               readln(f,s);
               stripleadblanks(s);
                s:=s+chr(0);
             until (blankline) or eof(f);

             if eof(f) and (s<>'') then
               begin
                 write(datafile,s,chr(0));
                 length:=length+strlen(s)+1;
               end;
             if shrunkfile then
               begin
                 write(datafile,chr(0));
                 length:=length+1;
               end
             else
               begin
                 length:=length+56;
                 for I:=1 to 56 do
                   write(datafile,chr(0));
               end;

             index.class:=0;
             index.disknum:=actualdisk-1;
             index.desclength:=length;
             index.rfu:=0;
             write(indexfile,index);
             index.offset:=index.offset+length;

             {look for name of next program}
             repeat
               read(f,s)
             until (blankline=false) or eof(f);
           end;
       until eof(f);
       close(datafile);
       close(namefile);
       close(indexfile);
     end;


begin
  startdisk:=actualdisk;
  saved:=false;
  reset(f,postingname);
  if ioresult<> 0 then
    begin
      errormsg:='Datei nicht gefunden: '+postingname;
      endit(errormsg);
    end
  else
    buffer(f,4096);
  {get LibDisknumber}
  repeat
    read(f,s)
  until newdisknumfound or eof(f);
  if eof(f) then
    begin
      writeln;
      writeln('Ich kann den Einleitungstext für die nächste Disk nicht finden !');
      writeln('Behandelte Datei:',postingname);
      writeln('Gewünscht: AmigaLibDisk',actualdisk);
      goto endscan;
    end;
  repeat
    clrscr;
    inc(actualdisk);
    if eof(f) then
      begin
        writeln('Mir fehlen die Programmbeschreibungen nach dem Einleitungstext für');
        writeln('AmigaLibDisk',actualdisk,' (EOF erkannt)');
        goto endscan;
      end;
    {read rest of Header}
    repeat
      read(f,s);
    until (blankline) or eof(f);
    if eof(f) then
      begin
        writeln('Mir fehlen die Programmbeschreibungen nach dem Einleitungstext für');
        writeln('AmigaLibDisk',actualdisk,' (EOF erkannt)');
        goto endscan;
      end;
    {read blank Lines}
    repeat
      read(f,s)
    until (blankline=false) or eof(f);
    if eof(f) then
      begin
        writeln('Mir fehlen die Programmbeschreibungen nach dem Einleitungstext für');
        writeln('AmigaLibDisk',actualdisk,' (EOF erkannt)');
        goto endscan;
      end;
    {get name & description of the program}
    while (newdisknumfound=false) and (not eof(f)) do
      begin
        clrscr;
        gotoxy(1,1);
        Writeln('Amigalibdisk:',actualdisk-1);
        writeln;
        { get name }
        name:='';
        i:=1;
        repeat
          name:=name+s[i];
          inc(i);
        until (ord(s[i])=9) or (ord(s[i])=32) or (i>strlen(s));
        if i>strlen(s) then
          begin
            Writeln('Dies kann kein Programmname sein: ',s,' (Ende der Zeile erreicht)');
            goto endscan
          end;
        repeat
          if name[strlen(name)]=' ' then
            name[strlen(name)]:=chr(0);
        until (name[strlen(name)] <> ' ') or (strlen(name)=0);
        delete(s,1,strlen(name));
        if strlen(name)<19 then
          begin
            For I:=strlen(name) to 19 do
              name:=name+' ';
            name[20]:=chr(0);
          end
        else
          begin
            delete(name,19,strlen(name)-19);
            name:=name+chr(0);
          end;
        gotoxy(1,3);
        Writeln('Name: ',name);
        { Get the rest of the first line }
        Writeln;
        Writeln('Beschreibung:');
        Writeln;
        length:=0;
        stripleadblanks(s);
        s:=s+chr(0);
        {get Rest of Description}
        repeat
          {write(datafile,s,chr(0));}
          writeln(s);
          length:=length+strlen(s)+1;
          readln(f,s);
          stripleadblanks(s);
           s:=s+chr(0);
        until (blankline) or eof(f);

        Writeln;
        while keypressed do
         c:=readkey;
        write('Ist das so richtig ? (J/N) : ');
        Waitforkey;
        c:=readkey;
        Writeln(c);
        if not (c in ['j','J'])
          then goto endscan;
        {look for name of next program}
        repeat
          read(f,s)
        until (blankline=false) or eof(f);
        if eof(f) then
          begin
            writeln('Keine weiteren Beschreibungen in dieser Datei');
          end;
      end;
  until eof(f);
  close(f);
  { No Errors occured: SaveIt (The same once again)}
  actualdisk:=startdisk;
  clrscr;
  gotoxy(1,3);
  Writeln('Ende des Textes.');
  WRiteln;
  Writeln('Jetzt werden diese ganzen Einträge gespeichert.');
  Writeln;
  write('Soll ich speichern ? (J/N) : ');
  while keypressed do
    c:=readkey;
  Waitforkey;
  c:=readkey;
  Writeln(c);
  if (c in ['j','J']) then
   begin
     saveit;
     saved:=true;
   end;
  Writeln;
  Writeln ('Fertig Gespeichert.');
endscan:
  close(f);
  if not saved then
    begin
      writeln;
      writeln;
      Writeln('Es sind Fehler aufgetreten. Die Datenfiles wurden noch nicht');
      Writeln('geändert. Falls Du diesen Text zum Laufen bekommen willst, mußt');
      writeln('Du mit einem TextEditor den Text so modifizieren, daß das Format');
      writeln('dem in der Anleitung erwähnten Format entspricht.');
      writeln
    end;
end;





begin
  addexitserver(exitserver);
  Windowtitles("SortPostings © by Henrich Deppenmeier '91",str(-1));
  getconfig;
  errormsg:='Dieses Programm könnte Deine Datenfiles beschädigen.'+chr(10)+chr(10)+
            'MACH EINE SICHERHEITSKOPIE DEINER DATENFILES, WENN '+CHR(10)+
            'DU DIESE PROGRAMM BENUTZEN WILLST !'+chr(10);
  button:=Trequest('Warnung:',errormsg,'Ende',nil,'Weiter!');
  if button= 1 then
    halt(5);
  numrecords:=getlength(namefilename) Div 20;
  Reset(indexfile,indexfilename);
  if IOresult=0 then
    begin
      seek(indexfile,numrecords-1);
      read(indexfile,index);
      close(indexfile);
    end
  else
    begin
      errormsg:='Kann Indexfile nicht öffnen'+chr(10);
      endit(errormsg);
    end;

  shrunkfile:=lookdatafile;
  if shrunkfile then
    begin
      errormsg:=' Du benutzt das kurze Datenformat. Alle neuen '+chr(10)+
                ' Einträge werden im kurzen Format gemacht.'+chr(10);
      button:=trequest('Hallo:',errormsg,'O.k',nil,nil);
    end
  else
    begin
      errormsg:='Du benutzt das originale Datenformat. Alle neuen '+chr(10)+
                'Einträge werden in dem langen Format gemacht,'+chr(10)+
                'aber Du könntest durch Anwendung von >Schrumpf_Daten<'+chr(10)+
                'schlappe '+intstr(long(numrecords)*55)+' Bytes sparen !'+chr(10);
      button:=trequest('Hallo:',errormsg,'O.k',nil,nil);
    end;

  actualdisk:=index.disknum+1;
  clrscr;
  Writeln('Der Text sollte mit den Contents von AmigaLibdisk',actualdisk, ' beginnen.');
  delay(50);
  dirn:='';
  postingname:='';
  Filereq('Name des Textes ?',dirn,postingname);
  if postingname='' then endit('Filerequester wurde gecancelt');
  clrscr;
  writeln('Suche in der Datei ',postingname,' nach Disk ',actualdisk);
  writeln;
  scancontents;
  Writeln;
  Writeln;
  Writeln;
  Writeln('Tschüssi !');
end.