program ppe_protector;

uses crt;

function upper(s : string) : string;
var j : integer;
begin
  for j := 1 to ord(s[0]) do s[j] := upcase(s[j]);
  upper := s;
end;

const ppe_init  = 'PCBoard Programming Language Executable';

type actiontype = (protect,unprotect,info);

var fin,fout : file;
    nr,nw : word;
    buffer : array[1..2048] of char;
    newchar : char;
    fn,fn2,format,s : string;
    ppe_in : array[1..39] of char;
    act : actiontype;

procedure closeall;
begin
  if fn2 = 'tempy!' then
  begin
    fn2 := fn;
    erase(fin);
    rename(fout,fn);
  end else
  begin
    close(fin);
    close(fout);
  end;
end;

procedure error(i : shortint);
begin
  case i of
    1 : begin
          writeln('Usage:   pplp <command> <ppe_name> [<out_name>]');
          writeln('Example: pplp p test');
          writeln;
          writeln('<Commands>');
          writeln('  p: Protect ppe');
          writeln('  u: Unprotect ppe');
          writeln('  i: is it protected/unprotected?');
        end;
    2 : writeln('Error: reading input file');
    3 : writeln('Error: creating new file');
    4 : begin
          writeln('Error: ppe already protected');
          closeall;
        end;
    5 : begin
          writeln('Error: ppe not protected');
          closeall;
        end;
    6 : begin
          writeln('Error: not a valid ppe');
          close(fin);
        end;
  end;
  halt;
end;

begin
  writeln('PCBoard Programming Language Protector 1.10 freeware    Copyright 1997 Flux / pr');

  if paramcount < 2 then error(1);

  s := paramstr(1);
  if length(s) > 1 then error(1);
  case upcase(s[1]) of
    'P' : act := protect;
    'U' : act := unprotect;
    'I' : act := info;
    else error(1);
  end;

  fn := paramstr(2);
  if pos('.',fn) = 0 then fn := fn+'.PPE';

  assign(fin,fn);
  {$i-} reset(fin,1); {$i+}
  if ioresult <> 0 then error(2);

  if act <> info then
  begin
    if paramcount = 3 then fn2 := paramstr(3)
                      else fn2 := 'tempy!';
    assign(fout,fn2);
    {$i-} rewrite(fout,1); {$i+}
    if ioresult <> 0 then error(3);
  end;

  writeln('Reading ',upper(fn),'... ');
  repeat
    blockread(fin,buffer,sizeof(buffer),nr);
    if act <> info then blockwrite(fout,buffer,nr,nw);
  until (nr = 0) or (nw <> nr);
  reset(fin,1);
  blockread(fin,ppe_in,39);
  if ppe_in <> ppe_init then error(6);
  {seek(fin,39);} blockread(fin,newchar,1);
  if act <> info then
    case act of
      protect : begin
                  if newchar = #250 then error(4);
                  newchar := #250;
                end;
      unprotect : begin
                    if newchar <> #250 then error(5);
                    newchar := #20;
                  end;
    end;
  reset(fin,1);
  seek(fin,40);
  blockread(fin,format,5);
  writeln('Format : ',format);
  writeln;

  if act <> info then
  begin
    seek(fout,39); blockwrite(fout,newchar,1);
    closeall;
  end else close(fin);
  case act of
    protect   : writeln(upper(fn),' protected to ',upper(fn2),' !');
    unprotect : writeln(upper(fn),' unprotected to ',upper(fn2),' !');
    info      : case newchar of
                  #250 : writeln(upper(fn),' is protected');
                  else writeln(upper(fn),' is not protected');
                end;
  end;
end.