home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1989 / 11 / titel / cryptfil.mod < prev    next >
Encoding:
Text File  |  1989-08-30  |  11.1 KB  |  347 lines
  1. (* ------------------------------------------------------ *)
  2. (*                   CRYPTFIL.MOD                         *)
  3. (*         Verschlüsselt Files nach FEAL 2.0              *)
  4. (*        (c) 1989  Ralf Hensmann  &  TOOLBOX             *)
  5. (* ------------------------------------------------------ *)
  6. MODULE CryptFile;
  7.  
  8. FROM Lib    IMPORT Dos, Sound, Delay, NoSound, FatalError,
  9.                    Fill, ParamCount, ParamStr;
  10. FROM IO     IMPORT RdStr, WrChar, WrStr, WrLn, RdKey,
  11.                    KeyPressed;
  12. FROM FEAL   IMPORT KeyStr, SetKey, Crypt, DeCrypt;
  13. FROM Str    IMPORT Length, Caps, Slice, Concat, Compare;
  14. FROM FIO    IMPORT Open, Create, Close, Erase, Rename, Size,
  15.                    Seek, DirEntry, RdBin, WrBin, File,
  16.                    FileAttr, PathTail, readonly, system,
  17.                    ReadFirstEntry, ReadNextEntry;
  18.  
  19. FROM SYSTEM IMPORT Registers, Seg, Ofs, CarryFlag;
  20.  
  21. CONST StartK    = "F2";     (* Beginn des verschlüsselten *)
  22.                             (* Files zur Erkennung.       *)
  23.                             (* Beliebig lang              *)
  24.       StartLen  = SIZE(StartK) - 1;
  25.       Kennung   = "Fx";     (* 2 Buchstaben, um korrektes *)
  26.                             (* Passwort zu erkennen       *)
  27.       MaxBuf    = 5120;     (* Puffergröße = 8*MaxBuf     *)
  28.       Schreiben = 1;        (* Für Sattr *)
  29.       Lesen     = 0;        (*    "      *)
  30.  
  31. TYPE Bit64    = SET OF [0..63];
  32.                           (* [1..64] --> SIZE = 9 Bytes ! *)
  33.      THeader  = RECORD
  34.                   H    : ARRAY [1..2] OF CHAR;
  35.                                            (* Für Kennung *)
  36.                   date,
  37.                   time : CARDINAL;
  38.                   attr : FileAttr;
  39.                               (* Werte des Original-Files *)
  40.                   R    : SHORTCARD;
  41.                 (* Anzahl der überflüssigen Bytes am Ende *)
  42.                 END;
  43.  
  44. VAR  Buffer     : ARRAY [0..MaxBuf-1] OF Bit64;
  45.                                            (* Datenpuffer *)
  46.      Signature  : Bit64;           (* Quersumme als Check *)
  47.      Pass       : ARRAY [0..23] OF CHAR;      (* Passwort *)
  48.      Filename,
  49.      Pathname,
  50.      Outname    : ARRAY [1..80] OF CHAR;    (* Dateinamen *)
  51.      In, Out    : File;
  52.      Head,
  53.      HilfHead   : THeader;
  54.      Chk        : ARRAY [1..StartLen] OF CHAR;
  55.                                   (* Für StartK-Vergleich *)
  56.      Lauf,
  57.      Gelesen    : CARDINAL;
  58.      DoCrypt    : CHAR;
  59.      S, LongLauf: LONGCARD;
  60.      HilfBuf,
  61.      HilfB      : Bit64;    (* Für CBC-Modus als Übertrag *)
  62.      Dir        : DirEntry;
  63.      NoAttr,
  64.      SecAttr    : FileAttr;
  65.                 (* SecAttr: Attribute, die die geschützte *)
  66.                 (*          Datei tragen soll             *)
  67.                 (*          (am Anfang initialisiert)     *)
  68.      Done       : ARRAY [0..400] OF PathTail;
  69.      DoneLast   : CARDINAL;
  70.  
  71.   PROCEDURE Beep;
  72.   BEGIN
  73.     Sound(800);  Delay(100);  NoSound;  Delay(30);
  74.   END Beep;
  75.  
  76.   PROCEDURE GetKey(P1, P2, P3 : CHAR) : CHAR;
  77.   VAR
  78.     Ch : CHAR;
  79.   BEGIN
  80.     REPEAT
  81.       Ch := RdKey();  Caps(Ch);
  82.     UNTIL (Ch = P1) OR (Ch = P2) OR (Ch = P3);
  83.     WrChar(Ch);  WrLn;
  84.     RETURN Ch;
  85.   END GetKey;
  86.  
  87.   PROCEDURE Sattr(VAR Name : ARRAY OF CHAR;
  88.                   VAR attr : FileAttr;
  89.                   Set      : SHORTCARD );
  90.                        (* Liest/Setzt Attribute von Files *)
  91.   VAR
  92.     R : Registers;
  93.   BEGIN
  94.     R.DS := Seg(Name);
  95.     R.DX := Ofs(Name);
  96.     R.CX := VAL(CARDINAL, SHORTCARD(attr));
  97.     R.AL := Set;
  98.     R.AH := 43H;
  99.     Dos(R);
  100.     IF CarryFlag IN R.Flags THEN
  101.       FatalError("Fehler bei Attribut-Setzen");
  102.     END;
  103.     IF Set = 0 THEN
  104.       attr := FileAttr(R.CX);
  105.     END;
  106.   END Sattr;
  107.  
  108.   PROCEDURE dt( F             : File;
  109.                 VAR date,time : CARDINAL;
  110.                 Set           : SHORTCARD );
  111.                   (* Liest/Setzt Datum und Zeit von Files *)
  112.   VAR
  113.     R : Registers;
  114.   BEGIN
  115.     R.BX := F;
  116.     R.AL := Set;
  117.     R.AH := 57H;
  118.     R.CX := time;
  119.     R.DX := date;
  120.     Dos(R);
  121.     IF CarryFlag IN R.Flags THEN
  122.       FatalError("Falsche KanalNummer");
  123.     END;
  124.     IF Set = 0 THEN
  125.       time := R.CX;
  126.       date := R.DX;
  127.     END;
  128.   END dt;
  129.  
  130.   PROCEDURE RdKeyword(VAR Key : ARRAY OF CHAR);
  131.   VAR
  132.     Sp : CARDINAL;
  133.     Ch : CHAR;
  134.   BEGIN
  135.     Sp := 0;
  136.     LOOP
  137.       Ch := RdKey();
  138.       CASE Ch OF
  139.         0C       : WHILE KeyPressed() DO
  140.                     Ch := RdKey();
  141.                    END;
  142.       | CHR(8)   : IF Sp > 0 THEN   (* Buchstaben löschen *)
  143.                      DEC( Sp );
  144.                      WrStr(CHR(8) + " " + CHR(8));
  145.                    END;
  146.       | CHR(13)  : IF Sp >= 5 THEN
  147.                      Key[Sp] := 0C;
  148.                      WrLn;
  149.                      RETURN;
  150.                    ELSE
  151.                      Beep;
  152.                    END;
  153.       | " ".."~" : IF Sp <= HIGH(Key) THEN
  154.                      WrChar("*");
  155.                      Key[Sp] := Ch;
  156.                      INC(Sp);
  157.                    ELSE
  158.                      Beep;
  159.                    END;
  160.       END;
  161.     END;
  162.   END RdKeyword;
  163.  
  164.   PROCEDURE GetPassWord(V : BOOLEAN);
  165.   VAR
  166.     VerifyPass : ARRAY [0..23] OF CHAR;
  167.     Lauf, Hilf : CARDINAL;
  168.   BEGIN
  169.     LOOP
  170.       WrStr("Passwort (mind. 6 Buchstaben): ");
  171.       RdKeyword(Pass);
  172.       IF NOT V THEN EXIT END;
  173.       WrStr("Passwort verifizieren        : ");
  174.       RdKeyword(VerifyPass);
  175.       IF Compare(Pass, VerifyPass) = 0 THEN EXIT END;
  176.       Beep; WrStr("Passwörter sind verschieden");  WrLn;
  177.     END;
  178.     Hilf := Length(Pass) + 1;
  179.     FOR Lauf := Hilf TO 23 DO
  180.       Pass[Lauf] := Pass[Lauf-Hilf];
  181.                                     (* Passwort erweitern *)
  182.     END;
  183.                                 (* Passwort verschlüsseln *)
  184.     SetKey(KeyStr(Pass[16]));  Crypt(ADR(Pass[ 8]));
  185.     SetKey(KeyStr(Pass[ 8]));  Crypt(ADR(Pass[ 0]));
  186.     SetKey(KeyStr(Pass[ 0]));
  187.   END GetPassWord;
  188.  
  189. BEGIN (* Hauptprogramm *)
  190.   NoAttr  := FileAttr{};  SecAttr := FileAttr{readonly};
  191.   DoneLast := 0;
  192.  
  193.   WrStr(" FEAL 2.0 Verschlüsselungsprogramm "); WrLn;
  194.   WrStr(" 1989 Ralf Hensmann & TOOLBOX "); WrLn; WrLn;
  195.   WrStr(" Datei: ");
  196.   IF ParamCount() = 1 THEN
  197.     ParamStr(Filename, 1);  WrStr(Filename);
  198.   ELSE
  199.     RdStr(Filename);
  200.   END;
  201.   WrLn; WrLn;
  202.   WrStr("V(erschlüsseln, E(ntschlüsseln, Q(uit? ");
  203.   DoCrypt := GetKey("V", "E", "Q");
  204.   IF DoCrypt = "Q" THEN HALT END;
  205.  
  206.   IF DoCrypt = "V" THEN GetPassWord(TRUE);
  207.                    ELSE GetPassWord(FALSE) END;
  208.  
  209.   IF NOT ReadFirstEntry(Filename,
  210.                        FileAttr{readonly..system}, Dir) THEN
  211.     HALT END;
  212.   Done[0] := Dir.Name;
  213.   Lauf := Length(Filename);
  214.   WHILE (Lauf > 0) AND (Filename[Lauf] # "\") AND
  215.         (Filename[Lauf] # ":") DO
  216.     DEC(Lauf);
  217.   END;
  218.   Slice(Pathname, Filename, 0, Lauf);
  219.   Concat(Filename, Pathname, Dir.Name);
  220.  
  221.   LOOP
  222.     LOOP
  223.       WrStr(" Name des Files : ");  WrStr(Filename);  WrLn;
  224.       Concat(Outname, Pathname, "CRYPT$$$.TMP");
  225.  
  226.       Sattr(Filename, Head.attr, Lesen);
  227.       Sattr(Filename, NoAttr, Schreiben);
  228.  
  229.       In  := Open(Filename);
  230.       Out := Create(Outname);
  231.       S   := Size(In);
  232.       HilfBuf := Bit64{};
  233.  
  234.       IF DoCrypt = "V" THEN
  235.         LongLauf := S;
  236.         Head.H := Kennung;
  237.         Head.R := (8 - SHORTCARD(S MOD 8)) MOD 8;
  238.         dt(In, Head.date, Head.time, Lesen);
  239.         Crypt(ADR(Head));
  240.         WrBin(Out, StartK, StartLen);
  241.         WrBin(Out, Head, SIZE(Head));
  242.         WrBin(Out, Signature, SIZE(Signature));
  243.         Signature := Bit64{};
  244.         REPEAT
  245.           Gelesen := RdBin(In, Buffer, SIZE(Buffer));
  246.           DEC(S, LONGCARD(Gelesen));
  247.           Gelesen   := (Gelesen + 7) DIV 8;
  248.           Signature := Signature / Buffer[0];
  249.           Buffer[0] := Buffer[0] / HilfBuf;
  250.           Crypt(ADR(Buffer[0]));
  251.           FOR Lauf := 1 TO Gelesen-1 DO
  252.             Signature := Signature / Buffer[Lauf];
  253.             Buffer[Lauf] := Buffer[Lauf] / Buffer[Lauf-1];
  254.             Crypt(ADR(Buffer[Lauf]));
  255.           END;
  256.           HilfBuf := Buffer[Gelesen-1];
  257.           WrBin(Out, Buffer, 8 * Gelesen);
  258.         UNTIL S = 0;
  259.         Crypt(ADR(Signature));
  260.         Seek(Out, StartLen+SIZE(Head));
  261.         WrBin(Out, Signature, SIZE(Signature));
  262.         S := LongLauf;
  263.         Seek(In, 0);
  264.                       (* --- Altes File überschreiben --- *)
  265.         Fill(ADR(Buffer), SIZE(Buffer), 0F6H);
  266.         FOR LongLauf := 1 TO S DIV SIZE(Buffer) DO
  267.           WrBin(In, Buffer, SIZE(Buffer));
  268.         END;
  269.           WrBin(In, Buffer, CARDINAL(S MOD SIZE(Buffer)));
  270.       ELSE
  271.         Gelesen := RdBin(In, Chk, StartLen);
  272.         IF Compare(Chk , StartK) # 0 THEN
  273.           Close(In);  Close(Out);  Erase(Outname);
  274.           WrStr
  275.          ("Datei nicht mit diesem Programm verschlüsselt.");
  276.           WrLn; EXIT;
  277.         END;
  278.         Gelesen := RdBin(In, HilfHead, SIZE(Head));
  279.         REPEAT
  280.           Head := HilfHead;
  281.           DeCrypt(ADR(Head));
  282.           IF Compare(Head.H,Kennung) # 0 THEN
  283.             Beep;
  284.             WrStr("Passwort falsch !  Neuer Versuch ? ");
  285.             IF GetKey("J", "Y", "N") = "N" THEN
  286.               Close(In);  Close(Out);  Erase(Outname); EXIT;
  287.             END;
  288.             GetPassWord(FALSE);
  289.           END;
  290.         UNTIL Compare(Head.H,Kennung) = 0;
  291.         Gelesen := RdBin(In, Signature, SIZE(Signature));
  292.         DeCrypt(ADR( Signature));
  293.         DEC(S, SIZE(Signature) + SIZE(Head) + StartLen);
  294.         REPEAT
  295.           Gelesen := RdBin(In, Buffer, SIZE(Buffer));
  296.           DEC(S, LONGCARD(Gelesen));
  297.           FOR Lauf := 0 TO (Gelesen DIV 8) - 1 DO
  298.             HilfB := Buffer[Lauf];
  299.             DeCrypt(ADR(Buffer[Lauf]));
  300.             Buffer[Lauf] := Buffer[Lauf] / HilfBuf;
  301.             Signature    := Signature / Buffer[Lauf];
  302.             HilfBuf      := HilfB;
  303.           END;
  304.           IF S = 0 THEN
  305.             DEC(Gelesen, CARDINAL(Head.R));
  306.           END;
  307.           WrBin(Out, Buffer, Gelesen);
  308.         UNTIL S = 0;
  309.         dt(Out, Head.date, Head.time, Schreiben);
  310.         IF Signature # Bit64{} THEN
  311.           Beep; Beep; Beep;
  312.           WrStr( " **********************************" );
  313.           WrLn;
  314.           WrStr( " ***    Datei wurde geändert    ***" );
  315.           WrLn;
  316.           WrStr( " *** wahrscheinlich unbenutzbar ***" );
  317.           WrLn;
  318.           WrStr( " **********************************" );
  319.           WrLn;
  320.           Delay(400);
  321.           Beep; Beep; Beep;
  322.         END;
  323.       END;
  324.       Close(In);  Close(Out);
  325.      Erase(Filename);  Rename(Outname, Filename);
  326.      IF DoCrypt = "V" THEN
  327.        Sattr(Filename, SecAttr, Schreiben);
  328.      ELSE
  329.        Sattr(Filename, Head.attr, Schreiben);
  330.      END;
  331.      EXIT;
  332.    END;
  333.    REPEAT
  334.      IF NOT ReadNextEntry(Dir) THEN EXIT END;
  335.      Lauf := 0;
  336.      WHILE (Lauf<=DoneLast) AND
  337.            (Compare(Dir.Name, Done[Lauf]) # 0) DO
  338.        INC(Lauf);
  339.      END;
  340.    UNTIL Lauf > DoneLast;
  341.    INC(DoneLast);  Done[DoneLast] := Dir.Name;
  342.    Concat(Filename, Pathname, Dir.Name);
  343.  END;
  344. END CryptFile.
  345. (* ------------------------------------------------------ *)
  346. (*                Ende von CRYPTFIL.MOD                   *)
  347.