PROGRAM TdbHdr;

{ met dit programma kan een header in een .TDB file worden aangemaakt, }
{ worden bekeken en worden gewijzigd.                                  }

USES Tdb;

VAR TmpFile,
    TdbFile   : FILE;
    IORes     : BYTE;
    Header    : TdbHeaderString;
    Buffer    : ARRAY[1..10000] OF BYTE;
    Lp        : BYTE;
    BytesRead : WORD;

BEGIN
     WriteLn ('TdbHdr v1.0');
     WriteLn ('(c) Ramon van der Winkel ''93');
     WriteLn;

     IF (ParamCount <> 1) THEN
     BEGIN
          WriteLn ('Usage: TDBHDR <filename>.TDB');
          Halt;
     END;

     { open file }
     Assign (TdbFile,ParamStr (1));
     {$I-} Reset (TdbFile,1); {$I+} IORes:=IOResult;
     IF (IORes = 2) THEN
     BEGIN
          WriteLn ('File not found');
          Halt;
     END;

     IF (IORes <> 0) THEN
     BEGIN
          WriteLn ('Error opening file '+ParamStr (1));
          Halt;
     END;

     { check if header exists }
     Seek (TdbFile,0);
     BlockRead (TdbFile,Header,TdbHeaderLen+1);
     IF (Header[0] <> Chr (TdbHeaderLen)) AND (Header[Length (Header)+1] <> #26) THEN
     BEGIN
          WriteLn (ParamStr (1),' does not contain a header');
          WriteLn ('Enter a new header, or just press enter to not create a header');
          WriteLn;
          Write ('Header (max ',TdbHeaderLen,' characters): ');
          ReadLn (Header);

          IF (Header = '') THEN
          BEGIN
               WriteLn ('No header installed');
               Close (TdbFile);
               Halt;
          END;

          IF (Length (Header) < TdbHeaderLen) THEN
             FOR Lp:=Length (Header)+1 TO TdbHeaderLen DO
                 Header[Lp]:=#26; { ctrl-z }

          { insert data }
          Assign (TmpFile,'TDBHDR.$$$');
          {$I-} ReWrite (TmpFile,1); {$I+} IORes:=IOResult;
          IF (IORes <> 0) THEN
          BEGIN
               WriteLn ('Cannot create temporary file (IORes=',IORes,')');
               Close (TdbFile);
               Halt;
          END;

          Seek (TdbFile,0);
          Seek (TmpFile,0);
          BlockWrite (TmpFile,Header,TdbHeaderLen+1);

          REPEAT
                BlockRead (TdbFile,Buffer,10000,BytesRead);
                IF (BytesRead > 0) THEN
                   BlockWrite (TmpFile,Buffer,BytesRead);
          UNTIL (BytesRead = 0);

          Close (TdbFile);
          Erase (TdbFile);

          Close (TmpFile);
          Rename (TmpFile,ParamStr (1));

          WriteLn ('Header installed');
          Halt;
     END; { has no header }

     WriteLn ('Current header: ',Header);
     WriteLn;
     Write ('Enter a new header tekst (enter to leave as is): ');
     ReadLn (Header);

     IF (Header = '') THEN
     BEGIN
          WriteLn ('Header not modified');
          Halt;
     END;

     IF (Length (Header) < TdbHeaderLen) THEN
        FOR Lp:=Length (Header)+1 TO TdbHeaderLen DO
            Header[Lp]:=#26; { ctrl-z }

     Seek (TdbFile,0);
     BlockWrite (TdbFile,Header,TdbHeaderLen+1);
     Close (TdbFile);

     WriteLn ('Header modified');
     Halt;
END.

