Hra na utek

Kategória: KMP (Klub mladých programátorov)
Autor: Ivan Rebo
Program: Utek.pas,  Readme.txt,  Ed.pas,  Hp.pas,  Hpu.pas,  Ivo.pas,  Pismo.pas,  Pouzi.pas,  Prezri.pas,  Rutins.pas,  Setup.pas,  Txtp.pas,  Unpack.pas,  Utek.pas,  Vezmi.pas,  Instal.pas,  Makeins.pas,  Xla.pas,  Riki.txt,  Uvod.txt
Súbor exe: Utek.exe,  Ed.exe,  Setup.exe
Potrebné: Mods.obj,  Utek-working-dos.7z

{ HPU.PAS                                   Copyright (c) Ivan Rebo }
{ Depakovac.                                                        }
{ https://github.com/IRebo/utek/tree/master/old-199x-version        }
{                                                                   }
{ Author: Ivan Rebo                                                 }
{ Datum: 20.01.1995                           http://www.trsek.com  }
 
program hoedepack;
uses crt;
type ras=array[0..65534] of byte;
 
var f,f2:file;
    p,p2:pointer;
    a,a2:^ras;
    c,d:byte;
    meno:string;
    size,sizes:word;
    e,ff:word;
 
procedure depack(siz:word);
begin
 blockread(f2,a2^,siz);
 e:=0;
 ff:=0;
 while ff<size do
 begin
  if a2^[ff]=a2^[ff+1] then
  begin
   c:=a2^[ff];
   inc(ff);
   inc(ff);
   d:=a2^[ff];
   inc(ff);
   for d:=1 to d do
   begin
    a^[e]:=c;
    inc(e);
   end;
  end
  else
  begin
   a^[e]:=a2^[ff];
   inc(ff);
   inc(e);
  end;
 end;
 blockwrite(f,a^,e);
end;
 
begin
 writeln('HoeSoft''s beta-de-packer 1995 Ver 0.00.01');
 if paramstr(2)='' then begin writeln;
  writeln('Neboli zadane parametre: 1. Meno suboru na de-packovanie');
  writeln('                         2. Pripona buduceho suboru');
  writeln;halt(1);end;
 write('De-packing...');
 getmem(p,65535);
 getmem(p2,65535);
 a:=p;
 a2:=p2;
 meno:=copy(paramstr(1),1,length(paramstr(1))-4);
 assign(f2,paramstr(1));
 reset(f2,1);
 assign(f,meno+'.'+paramstr(2));
 rewrite(f,1);
 size:=filesize(f2);
 repeat
  if size>65535 then
  begin
   size:=size-65535;
   sizes:=65535;
  end
  else sizes:=size;
  depack(sizes);
 until size=sizes;
 close(f2);close(f);
 freemem(p,65535);freemem(p2,65535);
 writeln; writeln;
 writeln('Vela stastia a uspechov v DOSe.');
end.