home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / cpm / draco / draco-1.ark / CRYPT.DRC < prev    next >
Text File  |  1986-11-12  |  3KB  |  154 lines
  1. \util.g
  2.  
  3. channel input binary Chin;
  4. channel output binary Chout;
  5.  
  6. file() Fin, Fout;
  7.  
  8. [256] byte Key;
  9. [256] char CharKey @ Key;
  10. [256] byte StartKey;
  11.  
  12. [256] ushort Table1, Table2;
  13.  
  14. bool EnCrypt;
  15.  
  16. proc nonrec process()void:
  17.     [256] byte buffer1, buffer2;
  18.     [128] byte shortBuff;
  19.     ushort i;
  20.     bool done;
  21.  
  22.     done := false;
  23.     while not done do
  24.     if read(Chin; shortBuff) then
  25.         for i from 0 upto 128 - 1 do
  26.         buffer1[i] := shortBuff[i];
  27.         od;
  28.         if read(Chin; shortBuff) then
  29.         for i from 0 upto 128 - 1 do
  30.             buffer1[i + 128] := shortBuff[i];
  31.         od;
  32.         else
  33.         done := true;
  34.         fi;
  35.         for i from 0 upto 256 - 1 do
  36.         if EnCrypt then
  37.             buffer2[i] := buffer1[Table1[i]] >< Key[i];
  38.         else
  39.             buffer2[i] := buffer1[Table2[i]] >< Key[Table2[i]];
  40.         fi;
  41.         od;
  42.         if not write(Chout; buffer2) then
  43.         write(" bad write to output file.");
  44.         exit(1);
  45.         fi;
  46.         for i from 0 upto 256 - 1 do
  47.         Key[i] := Key[i] * 19 + 37;
  48.         od;
  49.     else
  50.         done := true;
  51.     fi;
  52.     od;
  53. corp;
  54.  
  55. proc nonrec fixKey()void:
  56.     ushort i, j, s;
  57.     byte b;
  58.  
  59.     s := 256 - 1;
  60.     while s ~= 0 and CharKey[s] = ' ' do
  61.     s := s - 1;
  62.     od;
  63.     i := s + 1;
  64.     j := 0;
  65.     while
  66.     CharKey[i] := CharKey[j];
  67.     if j = s then
  68.         j := 0;
  69.     else
  70.         j := j + 1;
  71.     fi;
  72.     i ~= 256 - 1
  73.     do
  74.     i := i + 1;
  75.     od;
  76.     b := 0;
  77.     for i from 1 upto s do
  78.     b := b + Key[i];
  79.     od;
  80.     for i from 0 upto 256 - 1 do
  81.     Key[i] := Key[i] >< b;
  82.     b := b * 13 + 59;
  83.     od;
  84.     StartKey := Key;
  85.     for i from 0 upto 256 - 1 do
  86.     Table1[i] := b;
  87.     Table2[b] := i;
  88.     b := b * 17 + 43;
  89.     od;
  90. corp;
  91.  
  92. proc nonrec main()void:
  93.     *char par;
  94.     FILENAME fnin, fnout;
  95.     [15] char namein, nameout;
  96.  
  97.     par := GetPar();
  98.     if par ~= nil and par* = '-' then
  99.     par := par + 1;
  100.     fi;
  101.     if par = nil or par* ~= 'D' and par* ~= 'E' or (par + 1)* ~= '\e' then
  102.     writeln("Use is: crypt -{d|e} f1.typ ... fn.typ");
  103.     else
  104.     EnCrypt := par* = 'E';
  105.     par := GetPar();
  106.     if par = nil then
  107.         writeln("Use is: crypt -{d|e} f1.typ ... fn.typ");
  108.     else
  109.         write("Key> ");
  110.         if readln(CharKey) then
  111.         fixKey();
  112.         while
  113.             write(par, ':');
  114.             SetFileName(fnin, par);
  115.             SetFileName(fnout, par);
  116.             if EnCrypt then
  117.             fnout.fn_type[0] := 'C';
  118.             fnout.fn_type[1] := 'R';
  119.             fnout.fn_type[2] := 'P';
  120.             else
  121.             fnin.fn_type[0] := 'C';
  122.             fnin.fn_type[1] := 'R';
  123.             fnin.fn_type[2] := 'P';
  124.             fi;
  125.             GetFileName(fnin, &namein[0]);
  126.             GetFileName(fnout, &nameout[0]);
  127.             if open(Chin, Fin, &namein[0]) then
  128.             if FileDestroy(fnout) then fi;
  129.             if FileCreate(fnout) then
  130.                 if open(Chout, Fout, &nameout[0]) then
  131.                 process();
  132.                 Key := StartKey;
  133.                 if not close(Chout) then
  134.                     write(" error closing output file");
  135.                 fi;
  136.                 else
  137.                 write(" can't open output file");
  138.                 fi;
  139.             else
  140.                 write(" can't create output file");
  141.             fi;
  142.             else
  143.             write(" can't open input file");
  144.             fi;
  145.             writeln();
  146.             par := GetPar();
  147.             par ~= nil
  148.         do
  149.         od;
  150.         fi;
  151.     fi;
  152.     fi;
  153. corp;
  154.