fork download
copy 
  1. {$APPTYPE CONSOLE}
  2. {$IFDEF FPC}
  3. {$MODE DELPHI}
  4. {$ENDIF}
  5. procedure FileCopy(sFrom, sTo: String);
  6.   const 
  7.     iRecSize = 16384;
  8.   var
  9.     fFrom, fTo: file;
  10.     pBlock: Pointer;
  11.     iToRead, iActualSize: Integer;
  12.   begin
  13.     Assign(fFrom, sFrom);
  14.     Assign(fTo, sTo);
  15.     try
  16.       Reset(fFrom, 1); 
  17.       Rewrite(fTo, 1);
  18.       GetMem(pBlock, iRecSize);
  19.       iToRead := FileSize(fFrom);
  20.       Repeat
  21.         BlockRead(fFrom, pBlock^, iRecSize, iActualSize);
  22.         if iActualSize > 0 then BlockWrite(fTo, pBlock^, iActualSize);
  23.         Dec(iToRead, iActualSize)
  24.       Until (iToRead <= 0) or (iActualSize = 0)
  25.     finally
  26.       FreeMem(pBlock, iRecSize);
  27.       Close(fTo);
  28.       Close(fFrom)
  29.     end
  30.   end;
  31.  
  32. function IntToWct(iValue: LongInt): string;
  33.   var
  34.     bTmp: Byte;
  35.   begin
  36.     Result := '';
  37.     Repeat
  38.       bTmp := iValue and 7;
  39.       Result := Chr($41 + bTmp + 8*Ord(bTmp > 6)) + Result;
  40.       iValue := iValue shr 3
  41.     Until iValue = 0
  42.   end;
  43.  
  44. function WctToInt(sValue: string): LongInt;
  45.   var
  46.     bTmp: Byte;
  47.   begin
  48.     Result := 0;
  49.     Repeat
  50.       bTmp := ord(sValue[1]) - $41;
  51.       Result := (Result shl 3) + bTmp - 8*Ord(bTmp > 6);
  52.       sValue := Copy(sValue, 2, Length(sValue) - 1)
  53.     Until sValue = ''
  54.   end;
  55.  
  56. function GetRandomName: string;
  57.   begin
  58.     Result := IntToWct(Random(MaxLongInt))
  59.   end;
  60.  
  61. procedure PokeLabel(sName, sLabel: string);
  62.   var fFile: file;
  63.   begin
  64.     try
  65.       Assign(fFile, sName);
  66.       Reset(fFile, 1);
  67.       BlockWrite(fFile, sLabel[1], Length(sLabel));
  68.       Truncate(fFile)
  69.     finally
  70.       Close(fFile)
  71.     end
  72.   end;
  73.  
  74. function PeekLabel(sName: string): string;
  75.   var tFile: text;
  76.   begin
  77.     try
  78.       Assign(tFile, sName);
  79.       Reset(tFile);
  80.       Read(tFile, Result)
  81.     finally
  82.       Close(tFile)
  83.     end
  84.   end;
  85.  
  86. procedure VanTooz(sName: string);
  87.   var fFile: file;
  88.   begin
  89.     try
  90.       Assign(fFile, sName);
  91.       Rewrite(fFile, 1);
  92.     finally
  93.       Close(fFile);
  94.       Erase(fFile)
  95.     end
  96.   end;
  97.  
  98.  
  99. var
  100.   sFName, sSName: string;
  101. begin
  102.   Randomize;
  103.   if (not (ParamCount in [1..2]) or (ParamStr(1) = '-h') or (ParamCount = 2) and (ParamStr(1) <> '-d')) then
  104.     begin
  105.       Writeln('Usage: ');
  106.       Writeln(ParamStr(0) + ' file_name_to_pack');
  107.       Writeln(ParamStr(0) + ' -d file_name_to_unpack');
  108.       Halt(1)
  109.     end;
  110.   case ParamCount of
  111.     1: begin
  112.          sFName := ParamStr(1);
  113.          sSName := GetRandomName;
  114.          FileCopy(sFName, sFName + ':' + sSName);
  115.          PokeLabel(sFName, sSName)
  116.        end;
  117.     2: begin
  118.          sFName := ParamStr(2);
  119.          sSName := PeekLabel(sFName);
  120.          FileCopy(sFName + ':' + sSName, sFName);
  121.          VanTooz(sFName + ':' + sSName)
  122.        end;
  123.   end
  124. end.
  125.  
Runtime error #stdin #stdout 0s 284KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
Usage: 
 file_name_to_pack
 -d file_name_to_unpack
https://ideone.com/UPPBhH
language:
Pascal (fpc 3.0.4)
created:
11 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!