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

{Here follow the two files to encode and decode files...}

>--- Begin of file ENCODE.PAS

{$v-,x+}

(*
** 'Encode' ASCII textfile to binary mess.
** Written by Bas van Gaalen.
**
** This is suposed to be unhackable...
*)

program _encode; { ENCODE.PAS }

uses
  dos;

var
  key:string[8];

{ encode file ---------------------------------------------------------------}

procedure encode(infname:pathstr);
var
  infile,outfile:file;
  fdir:dirstr; fname:namestr; fext:extstr;
  inbuf,outbuf:pointer;
  fsize:longint;
  srcseg,dstseg,
  srcofs,dstofs,
  nofbytes,idx,start,rep,outsize:word;
  i,src:byte;
begin
  assign(infile,infname);
  {$i-} reset(infile,1); {$i+}
  if ioresult<>0 then halt;
  fsize:=filesize(infile);
  if fsize>65500 then halt;
  getmem(inbuf,fsize);
  blockread(infile,inbuf^,fsize,nofbytes);
  close(infile);
  if nofbytes<>fsize then halt;
  if maxavail<fsize then halt;
  getmem(outbuf,fsize);
  srcseg:=seg(inbuf^); dstseg:=seg(outbuf^);
  srcofs:=ofs(inbuf^); dstofs:=ofs(outbuf^); start:=dstofs;
  idx:=0;
  while idx<fsize do begin
    src:=mem[srcseg:srcofs+idx];
    rep:=1;
    while (mem[srcseg:srcofs+idx+rep]=src) and (rep<$f) do inc(rep);
    if rep>1 then begin
      mem[dstseg:dstofs]:=$f0 or rep;
      mem[dstseg:dstofs+1]:=src;
      inc(dstofs,2);
    end
    else begin
      if src>=$f0 then begin mem[dstseg:dstofs]:=$f1; inc(dstofs); end;
      mem[dstseg:dstofs]:=src; inc(dstofs);
    end;
    inc(idx,rep);
  end;
  outsize:=dstofs-start;
  freemem(inbuf,fsize);
  randseed:=ord(key[length(key)]); i:=0;
  for idx:=0 to outsize do begin
    mem[dstseg:start+idx]:=mem[dstseg:start+idx] xor
(ord(key[i])+random(ord(key[i])));    i:=1+i mod 8;
  end;
  fsplit(infname,fdir,fname,fext);
  assign(outfile,fdir+fname+'.dat');
  rewrite(outfile,1);
  blockwrite(outfile,outbuf^,outsize);
  freemem(outbuf,fsize);
end;

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

begin
  if (paramcount<>2) or (pos('?',paramstr(1))>0) then begin
    writeln('Syntax: ENCODE <filename> <key>');
    writeln('Both parameters are required!');
    halt;
  end;
  key:=paramstr(2);
  encode(paramstr(1));
  writeln('File successfully encoded!');
end.

>--- End of file ENCODE.PAS

>--- Begin of file DECODE.PAS

{$v-}

(*
** 'Decode' Binary mess to textfile.
** Written by Bas van Gaalen.
**
** This is suposed to be unhackable...
*)

program _decode; { DECODE.PAS }

uses
  dos;

var
  key:string[8];

{ decode file ---------------------------------------------------------------}

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 halt;
  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 halt;
  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-} rewrite(outfile,1); {$i+}
  if ioresult<>0 then halt(4);
  blockwrite(outfile,dbuf^,csize);
  close(outfile);
  freemem(sbuf,65500);
  freemem(dbuf,65500);
end;

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

begin
  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.

>--- End of file DECODE.PAS

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