ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/MISC/EDUCATIO/CATTEST.ZIP/INITGRAD.PAS

Pascal/Delphi Source File | 1991-04-02 | 4.9 KB | 184 lines

{$A+,B-,D+,E+,F-,I+,L+,N-,O-,R-,S+,V+}
{$M 16384,0,655360}

PROGRAM Init_Gradebook;
{v1.1 uuencode from Toad Hall Tweak, 9 May 90
 - Converted reserved, other word case to my preferred style.
 - Converted for Turbo Pascal v5.0 compilation ("Uses", etc.)

 - Program reads password from sysin, writes a temp file with it
   in ASCII, then uuencodes it into a file called GRADES.BK$.
}
Uses Dos,Crt;

CONST  {uue}
    OFFSET = 32;
    Header = 'begin';
    Trailer = 'end';
    DefaultMode = '644';
    DefaultExtension = '.uue';
    CHARSPERLINE = 60;
    BYTESPERHUNK = 3;
    SIXBITMASK = $3F;

TYPE
  Str80 = STRING[80];

VAR
  InFile_2 : TEXT;
  Infile: FILE OF Byte;
  TempFile,
  Outfile: TEXT;
  Outfilename, Mode: Str80;
  lineLength, numbytes, bytesInLine: INTEGER;
  Line_uud : Str80;
  Line: ARRAY [0..59] OF CHAR;
  hunk: ARRAY [0..2] OF Byte;
  chars: ARRAY [0..3] OF Byte;
  size,remaining : longint;  {v1.1 REAL;}
CONST
  TempFileName = 'PASSWORD.TMP';
  UUencoded_GRADE_file = 'GRADE.BK$';

VAR
  Password : STRING;
  Ch : Char;

PROCEDURE Abort (Msg : Str80);
  BEGIN
    WRITELN(Msg);
    {$I-}                 {v1.1}
    CLOSE(Infile);
    CLOSE(Outfile);
    {$I+}                 {v1.1}
    HALT
  END; {of Abort}
PROCEDURE FlushLine;

  VAR i: INTEGER;

  PROCEDURE WriteOut(Ch: CHAR);
    BEGIN
      IF Ch = ' '
        THEN WRITE(Outfile, '`')
                  ELSE WRITE(Outfile, Ch)
    END; {of WriteOut}
  BEGIN {FlushLine}
    {write ('.');}
    WRITE('bytes remaining: ',remaining:7,' (',
          remaining/size*100.0:3:0,'%)',CHR(13));
    WriteOut(CHR(bytesInLine + OFFSET));
    FOR i := 0 TO PRED(lineLength) DO
      WriteOut(Line[i]);
    WRITELN (Outfile);
    lineLength := 0;
    bytesInLine := 0
  END; {of FlushLine}

PROCEDURE FlushHunk;

  VAR i: INTEGER;
  BEGIN
    IF lineLength = CHARSPERLINE
      THEN FlushLine;
    chars[0] := hunk[0] ShR 2;
    chars[1] := (hunk[0] ShL 4) + (hunk[1] ShR 4);
    chars[2] := (hunk[1] ShL 2) + (hunk[2] ShR 6);
    chars[3] := hunk[2] AND SIXBITMASK;
    {debug;}
    FOR i := 0 TO 3 DO
      BEGIN
        Line[lineLength] := CHR((chars[i] AND SIXBITMASK) + OFFSET);
      {write(line[linelength]:2);}
        Inc(lineLength);
      END;
    {writeln;}
    Inc(bytesInLine,numbytes);
    numbytes := 0
  END; {of FlushHunk}

PROCEDURE Encode1;
  BEGIN
    IF numbytes = BYTESPERHUNK
      THEN FlushHunk;
    READ (Infile, hunk[numbytes]);
    Dec(remaining);
    Inc(numbytes);
  END; {of Encode1}
  BEGIN {Init_Gradebook}
      ClrScr;
      {$I-}
      ASSIGN (TempFile, TempFileName ); {temp grade file, to be erased}
      REWRITE (Tempfile);
      {$I+}
      WriteLn('Enter the desired password (less than 10 chars).');
      ReadLn(Password);
      WriteLn(TempFile,Password);
      Close(Tempfile);

      {$I-}
      ASSIGN (Infile, TempFileName ); {temp grade file, to be erased}
      RESET (Infile);
      {$I+}
      IF IOResult > 0
        THEN Abort (CONCAT ('Can''t open file ', Tempfilename));
      size := FileSize(Infile);
{     IF size < 0 THEN size:=size+65536.0; }
      remaining := size;
      WRITE('Uuencoding file ', Tempfilename);
      Mode := DefaultMode;
      { Process 2d cmdline arg (if any).
        It could be a new mode (rather than default "644")
        or it could be a forced output name (rather than
        "infile.uue")
      }
      ASSIGN (Outfile,UUencoded_GRADE_file);
      WRITELN (' to file ', UUencoded_GRADE_file, '.');
      {$I-}
      RESET(Outfile);
      {$I+}
      IF IOResult = 0
         THEN BEGIN          {output file exists!}
               WRITE ('Overwrite current ', UUencoded_GRADE_file, '? [Y/N] ');
               REPEAT
                 Ch := Upcase(ReadKey);
               UNTIL Ch IN ['Y', 'N'];
               WRITELN (Ch);
               IF Ch = 'N'
                 THEN Abort(CONCAT (UUencoded_GRADE_file, ' not overwritten.'))
          END;
      {$I-}
      CLOSE(Outfile);
      IF IOResult <> 0
        THEN ;  {v1.1 we don't care}
      REWRITE(Outfile);
      {$I+}
      IF IOResult > 0
        THEN Abort(CONCAT('Can''t open ', UUencoded_GRADE_file));
    bytesInLine := 0;
    LineLength := 0;
    numbytes := 0;
    WriteLn(Outfile,Header,' ',Mode,' ',UUencoded_GRADE_file);
         { Force the header to reflect future name, not old name}
    WHILE NOT EOF (Infile) DO
    Encode1;
    if numbytes > 0 then Flushhunk;
    if lineLength > 0 then BEGIN
      Flushline;
      Flushline;
    end else
    flushline;
    writeLn(Outfile,Trailer);

    Close(Infile);
    Close(Outfile);
    WRITELN('Finished uuencoding password into GRADE.BK$');
    {$I-}
    ASSIGN (TempFile, TempFileName ); {temp grade file, to be erased}
    REWRITE (Tempfile);
    Erase(TempFile);
    {$I+}
    IF IoResult <> 0
      THEN WriteLn('Erase Failed, do it manually.');
  END. {uuencode}