[Back to ENCRYPT SWAG index] [Back to Main SWAG index] [Original]

    uses
       crt,
       dos;

    var
      key:string[8];

    { decode file ---------------------------------------------------------------}
    {your code here}
    procedure decode(infname:pathstr);
    var
      infile,outfile:file;
      fdir:dirstr; fname:namestr; fext:extstr;
      dbuf,sbuf:pointer;
      idx,i,j,srcseg,srcofs,dstseg,dstofs,start,csize:word;
      src,rep:byte;
    begin
      if maxavail<2*65500 then Begin
         Writeln(#13#10,'No Memory');
         halt;
      End;
      getmem(dbuf,65500);
      getmem(sbuf,65500);
      srcseg:=seg(sbuf^); srcofs:=ofs(sbuf^);
      dstseg:=seg(dbuf^); dstofs:=ofs(dbuf^); start:=dstofs;
      assign(infile,infname);
      {$i-} reset(infile,1); {$i+}
      if ioresult<>0 then Begin
         Writeln(#13#10'File I/O!');
         halt;
      End;
      if filesize(infile)>65500 then halt;
      blockread(infile,sbuf^,filesize(infile));
      csize:=filesize(infile);
      close(infile);
      randseed:=ord(key[length(key)]); j:=0;
      for i:=0 to csize do begin
        mem[srcseg:srcofs+i]:=mem[srcseg:srcofs+i] xor
    (ord(key[j])+random(ord(key[j])));
        j:=1+j mod 8;
      end;
      idx:=0;
      while idx<csize do begin
        src:=mem[srcseg:srcofs+idx];
        if (src and $f0)=$f0 then begin
          rep:=src and $f;
          src:=mem[srcseg:srcofs+idx+1];
          fillchar(mem[dstseg:dstofs],rep,src);
          inc(dstofs,rep);
          inc(idx,2);
        end
        else begin
          mem[dstseg:dstofs]:=src;
          inc(dstofs);
          inc(idx);
        end;
      end;
      csize:=dstofs-start;
      fsplit(infname,fdir,fname,fext);
      assign(outfile,fdir+fname+'.org');
      {$i-} reset(outfile,1); {$i+}
      {$i-} seek(outfile,FileSize(outfile)); {$i+} {append to 1 long output!}
      if ioresult<>0 then Begin
         Writeln(#13#10'Output Error!');
         halt(4);
      End;
      blockwrite(outfile,key[1],length(key)); {so I know which key did it!}
      blockwrite(outfile,dbuf^,csize);        {un encoded}
      close(outfile);
      freemem(sbuf,65500);
      freemem(dbuf,65500);
    end;

    { main ----------------------------------------------------------------------}

    Procedure ShowFile(FName:String); {just a test ... not used in live version!}
    Var
       T:Text;
       S:String;

    Begin
       Assign(T,FName);
       ReSet(T);
       While not eof(t) do begin
    {$I-}      Readln(t,s); {$I+}
          Writeln(s);
       End;
       Close(T);
    End;

    Var
       Cnt1:Integer;        {character 1}
       Cnt2:Integer;        {2}
       Cnt3:Integer;        {3}
       Cnt4:Integer;        {4}
       Cnt5:Integer;        {5}
       Cnt6:Integer;        {6}
       Cnt7:Integer;        {7}
       Cnt8:Integer;        {8}
       Ch:Char;             {did I press a local key?}
       outfile:file;        {just for making an empty file to append to}
       Dumb:Byte;           {dumb!}
       done:boolean;        {tried from '' to #255#255#255#255#255#255#255#255}

    begin
       assign(outfile,'hack.org');
       {$i-} rewrite(outfile,1); {$i+}
       Close(outfile); {made a 0 byte file to append to}
    {init}
       Cnt1:=0;
       Cnt2:=0;
       Cnt3:=0;
       Cnt4:=0;
       Cnt5:=0;
       Cnt6:=0;
       Cnt7:=0;
       Cnt8:=0;
       done:=false;
       While not done do begin
    {not I inc 1 char at a time}
          Inc(Cnt1);
          If Cnt1>255 then Begin
      Cnt1:=0;
      Inc(Cnt2);
          End;
          If Cnt2>255 then Begin
      Cnt2:=0;
      Inc(Cnt3);
          End;
          If Cnt3>255 then Begin
      Cnt3:=0;
      Inc(Cnt4);
          End;
          If Cnt4>255 then Begin
      Cnt4:=0;
      Inc(Cnt5);
          End;
          If Cnt5>255 then Begin
      Cnt5:=0;
      Inc(Cnt6);
          End;
          If Cnt6>255 then Begin
      Cnt6:=0;
      Inc(Cnt7);
          End;
          If Cnt7>255 then Begin
      Cnt7:=0;
      Inc(Cnt8);
          End;
          If Cnt8>255 then Halt;
          Key:='';
          If Cnt1<>0 then key:=key+chr(cnt1);
          If Cnt2<>0 then key:=key+chr(cnt2);
          If Cnt3<>0 then key:=key+chr(cnt3);
          If Cnt4<>0 then key:=key+chr(cnt4);
          If Cnt5<>0 then key:=key+chr(cnt5);
          If Cnt6<>0 then key:=key+chr(cnt6);
          If Cnt7<>0 then key:=key+chr(cnt7);
          If Cnt8<>0 then key:=key+chr(cnt8);
    {call your decode method}
          Decode('HACK.DAT');
          {ShowFile('HACK.ORG');}
    {so I can see its running:}
          Writeln('KEY: ',Key);
          If Keypressed then Begin
      Ch:=Readkey;
      if ch=#27 then halt;
          End;
       End;
    (*  if (paramcount<>2) or (pos('?',paramstr(1))>0) then begin
        writeln('Syntax: DECODE <filename> <key>');
        writeln('Both parameters are required!');
        halt;
      end;
      key:=paramstr(2);
      decode(paramstr(1));
      writeln('File successfully decoded!'); *)
    end.

[Back to ENCRYPT SWAG index] [Back to Main SWAG index] [Original]