{$APPTYPE CONSOLE}
{$IFDEF FPC}
{$MODE DELPHI}
{$ENDIF}
procedure FileCopy(sFrom, sTo: String);
  const 
    iRecSize = 16384;
  var
    fFrom, fTo: file;
    pBlock: Pointer;
    iToRead, iActualSize: Integer;
  begin
    Assign(fFrom, sFrom);
    Assign(fTo, sTo);
    try
      Reset(fFrom, 1); 
      Rewrite(fTo, 1);
      GetMem(pBlock, iRecSize);
      iToRead := FileSize(fFrom);
      Repeat
        BlockRead(fFrom, pBlock^, iRecSize, iActualSize);
        if iActualSize > 0 then BlockWrite(fTo, pBlock^, iActualSize);
        Dec(iToRead, iActualSize)
      Until (iToRead <= 0) or (iActualSize = 0)
    finally
      FreeMem(pBlock, iRecSize);
      Close(fTo);
      Close(fFrom)
    end
  end;

function IntToWct(iValue: LongInt): string;
  var
    bTmp: Byte;
  begin
    Result := '';
    Repeat
      bTmp := iValue and 7;
      Result := Chr($41 + bTmp + 8*Ord(bTmp > 6)) + Result;
      iValue := iValue shr 3
    Until iValue = 0
  end;

function WctToInt(sValue: string): LongInt;
  var
    bTmp: Byte;
  begin
    Result := 0;
    Repeat
      bTmp := ord(sValue[1]) - $41;
      Result := (Result shl 3) + bTmp - 8*Ord(bTmp > 6);
      sValue := Copy(sValue, 2, Length(sValue) - 1)
    Until sValue = ''
  end;

function GetRandomName: string;
  begin
    Result := IntToWct(Random(MaxLongInt))
  end;

procedure PokeLabel(sName, sLabel: string);
  var fFile: file;
  begin
    try
      Assign(fFile, sName);
      Reset(fFile, 1);
      BlockWrite(fFile, sLabel[1], Length(sLabel));
      Truncate(fFile)
    finally
      Close(fFile)
    end
  end;

function PeekLabel(sName: string): string;
  var tFile: text;
  begin
    try
      Assign(tFile, sName);
      Reset(tFile);
      Read(tFile, Result)
    finally
      Close(tFile)
    end
  end;

procedure VanTooz(sName: string);
  var fFile: file;
  begin
    try
      Assign(fFile, sName);
      Rewrite(fFile, 1);
    finally
      Close(fFile);
      Erase(fFile)
    end
  end;


var
  sFName, sSName: string;
begin
  Randomize;
  if (not (ParamCount in [1..2]) or (ParamStr(1) = '-h') or (ParamCount = 2) and (ParamStr(1) <> '-d')) then
    begin
      Writeln('Usage: ');
      Writeln(ParamStr(0) + ' file_name_to_pack');
      Writeln(ParamStr(0) + ' -d file_name_to_unpack');
      Halt(1)
    end;
  case ParamCount of
    1: begin
         sFName := ParamStr(1);
         sSName := GetRandomName;
         FileCopy(sFName, sFName + ':' + sSName);
         PokeLabel(sFName, sSName)
       end;
    2: begin
         sFName := ParamStr(2);
         sSName := PeekLabel(sFName);
         FileCopy(sFName + ':' + sSName, sFName);
         VanTooz(sFName + ':' + sSName)
       end;
  end
end.
