home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 10 / tricks / password.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1990-11-09  |  8.9 KB  |  375 lines
  1. (* ------------------------------------------------------ *)
  2. (*                      PASSWORD.PAS                      *)
  3. (*            (c) 1990 Thomas Reimann & TOOLBOX           *)
  4. (*                                                        *)
  5. (* Update 11'90: Compilerschalter in Quelltext eingefügt, *)
  6. (*               Position des Paßworts im EXE-File        *)
  7. (*               korrigiert, manuelle Pfadeingabe durch   *)
  8. (*               "ParamStr(0)"-Konstrukt ersetzt     (ga) *)
  9. (* ------------------------------------------------------ *)
  10. (*      Achtung: Bitte lesen Sie die zusätzlichen         *)
  11. (*        Hinweise in der Datei "PASSWORD.DOC"!           *)
  12. (* ------------------------------------------------------ *)
  13. {$A-,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V-}
  14. {$M 4096,0,655360}
  15.  
  16. PROGRAM PassWord;
  17.  
  18. USES
  19.   Crt, Dos;
  20.  
  21. CONST
  22.   ZV   = #13#10;
  23.       (* WICHTIG: 20 Zeichen Platzhalter für das PassWord *)
  24.   Code : ARRAY [1..20] OF CHAR =
  25.          #0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0;
  26. VAR
  27.   f     : FILE OF BYTE;
  28.   Regs  : REGISTERS;
  29.   ok    : BOOLEAN;
  30.   CWord : String;
  31.   xPos  : INTEGER;
  32.   yPos  : INTEGER;
  33.   x     : BYTE;
  34.   y     : BYTE;
  35.   z     : INTEGER;
  36.   ch    : CHAR;
  37.   st    : STRING;
  38.   Done  : BOOLEAN;
  39.  
  40.   FUNCTION Right(s : STRING; L : WORD) : STRING;
  41.   { Stellt die l-ten Stellen eines Strings von rechts dar }
  42.   BEGIN
  43.     Right := Copy(s, Length(s) - L + 1, Length(s));
  44.   END;
  45.  
  46.   FUNCTION Fill(c : CHAR; L : WORD) : STRING;
  47.   { Fill ist ein String mit L-Mal dem Zeichen c }
  48.   VAR
  49.     x  : INTEGER;
  50.     st : STRING;
  51.   BEGIN
  52.     st := '';
  53.     FOR x := 1 TO L DO st := st + c;
  54.     Fill := st;
  55.   END;
  56.  
  57.   FUNCTION Upper(s : STRING) : STRING;
  58.   { Wandelt einen String in Großbuchstaben um }
  59.   VAR
  60.     x  : INTEGER;
  61.     st : STRING;
  62.   BEGIN
  63.     st := '';
  64.     FOR x := 1 TO Length(s) DO st := st + UpCase(s[x]);
  65.     Upper := st;
  66.   END;
  67.  
  68.   FUNCTION UhrZeit : STRING;
  69.   { Der String "UhrZeit" enthält die aktuelle Systemzeit }
  70.   VAR
  71.     a, b, c, d    : WORD;
  72.     Std, Min, Sek : STRING [4];
  73.   BEGIN
  74.     GetTime(a, b, c, d);
  75.     Str(a, Std);  Std := Right('00' + Std, 2);
  76.     Str(b, Min);  Min := Right('00' + Min, 2);
  77.     Str(c, Sek);  Sek := Right('00' + Sek, 2);
  78.     UhrZeit := Std + ':' + Min + ':' + Sek;
  79.   END;
  80.  
  81.   FUNCTION Datum : STRING;
  82.   { Der String "Datum" enthält das aktuelle Systemdatum }
  83.   VAR
  84.     a, b, c, d     : WORD;
  85.     Tag, Mon, Jahr : STRING [4];
  86.   BEGIN
  87.     GetDate(a, b, c, d);
  88.     a := a - 1900;
  89.     Str(a, Jahr);  Jahr := Right('00' + Jahr, 2);
  90.     Str(b, Mon);   Mon  := Right('00' + Mon, 2);
  91.     Str(c, Tag);   Tag  := Right('00' + Tag, 2);
  92.     Datum := Tag + '.' + Mon + '.' + Jahr;
  93.   END;
  94.  
  95.   PROCEDURE Normal;
  96.   { Normaler Darstellungsmodus }
  97.   BEGIN
  98.     TextColor(Yellow);
  99.     TextBackground(Blue);
  100.   END;
  101.  
  102.   PROCEDURE Invers;
  103.   { Inverse Zeichendarstellung }
  104.   BEGIN
  105.     TextColor(Blue);
  106.     TextBackground(Yellow);
  107.   END;
  108.  
  109.   FUNCTION Mono : BOOLEAN;
  110.   { Mono ist TRUE, wenn eine Mono-Grafikkarte benutzt wird }
  111.   BEGIN
  112.     Regs.ah := $F;
  113.     Intr($10, Regs);
  114.     Mono := (Regs.al = 7);
  115.   END;
  116.  
  117.   PROCEDURE CsrOff;
  118.   { Ausschalten des Cursors }
  119.   BEGIN
  120.     Regs.ah := $01;
  121.     Regs.ch := $26;
  122.     Regs.cl := $07;
  123.     Intr($10, Regs);
  124.   END;
  125.  
  126.   PROCEDURE CsrOn;
  127.   BEGIN
  128.     IF Mono THEN BEGIN
  129.       Regs.ch := $0C;
  130.       Regs.cl := $0D;
  131.     END ELSE BEGIN
  132.       Regs.ch := $06;
  133.       Regs.cl := $07;
  134.     END;
  135.     Regs.ah := $01;
  136.     Intr($10, Regs);
  137.   END;
  138.  
  139.   PROCEDURE GetCode;
  140.   { CodeWord aus dem Programm-Code in Variable CWord lesen }
  141.   BEGIN
  142.     CWord := '';
  143.     FOR x := 1 TO 20 DO IF Ord(Code[X]) <> 0 THEN
  144.       CWord := CWord + Code[X];
  145.   END;
  146.  
  147.   PROCEDURE CopyRight;
  148.   BEGIN
  149.     Write  ('  - PASSWORD - ');
  150.     WriteLn(' (c) 1990 Thomas Reimann & TOOLBOX');
  151.     WriteLn;
  152.   END;
  153.  
  154.   PROCEDURE Syntax;
  155.   { Syntax des Befehls anzeigen }
  156.   BEGIN
  157.     CopyRight;
  158.     WriteLn('Aktivieren: PASSWORD');
  159.     WriteLn('Generieren: PASSWORD G');
  160.   END;
  161.  
  162.   PROCEDURE PrintText(x, y : BYTE);
  163.   BEGIN
  164.     XPos := x;  (* XY-Koordinate sichern *)
  165.     YPos := y;
  166.     Invers;
  167.     GotoXY(XPos, YPos);
  168.     Write(' ╔', Fill('═', 38), '╗ ');
  169.     GotoXY(XPos, YPos + 1);
  170.     Write(' ║  Bitte geben sie das Password ein !  ║ ');
  171.     GotoXY(XPos, YPos + 2);
  172.     Write(' ║', #32:38, '║ ');
  173.     GotoXY(XPos, YPos + 3);
  174.     Write(' ║', #32:38, '║ ');
  175.     GotoXY(XPos, YPos + 4);
  176.     Write(' ╚', Fill('═', 38), '╝ ');
  177.     Normal;
  178.   END;
  179.  
  180.   PROCEDURE KopfText(st : STRING);
  181.   BEGIN
  182.     Invers;  GotoXY(23, 11);  Write(st);
  183.   END;
  184.  
  185.   PROCEDURE Meldung(st : STRING; bel : BOOLEAN);
  186.   BEGIN
  187.     x := Trunc((28 - Length(st)) / 2);
  188.     GotoXY(23, 13);
  189.     Invers;  Write(#32:34);  GotoXY(23 + x, 13);
  190.     Normal;  Write(#32:3, st, #32:3);
  191.     IF bel THEN Write(#7);
  192.     Delay(1000);
  193.   END;
  194.  
  195.   PROCEDURE ClrInput(L : BYTE);
  196.   { Input-Feld initialisieren }
  197.   BEGIN
  198.     x := Trunc((34 - L) / 2);
  199.     GotoXY(23, 13);
  200.     Invers;  Write(#32:34);  GotoXY(23 + X, 13);
  201.     Normal;  Write(#32:L);
  202.     GotoXY(23 + x, 13);
  203.   END;
  204.  
  205.   PROCEDURE Eingabe;
  206.  
  207.     PROCEDURE Kontrolle;
  208.     { Wenn CodeWord OK dann Done := TRUE }
  209.     BEGIN
  210.       IF (Length(st) >= Length(CWord)) OR
  211.          (ch = #13) OR (st = CWord) THEN
  212.         Done := TRUE;
  213.     END;
  214.  
  215.   BEGIN
  216.     ClrScr;
  217.     PrintText(19, 10);
  218.     ClrInput(Length(CWord));
  219.     Done := FALSE;
  220.     ch   := ReadKey;
  221.     IF (ch <> #0) THEN BEGIN
  222.       st := CH;
  223.       Write(#177);
  224.       Kontrolle;
  225.     END;
  226.     IF (NOT Done) THEN
  227.       REPEAT
  228.         ch := ReadKey;
  229.         IF ch <> #0 THEN BEGIN
  230.           st := st + ch;
  231.           Write(#177);
  232.           Kontrolle;
  233.         END;
  234.       UNTIL Done;
  235.     IF st <> CWord THEN BEGIN
  236.       GotoXY(21,13);
  237.       Meldung('F A L S C H', TRUE);
  238.     END ELSE BEGIN
  239.       Meldung('O K', FALSE);
  240.       ok := TRUE;
  241.     END;
  242.     Normal;
  243.     ClrScr;
  244.   END;
  245.  
  246.   FUNCTION TastenDruck : BOOLEAN;
  247.   { Auf Tastendruck warten, währenddessen Zeit anzeigen }
  248.   BEGIN
  249.     TastenDruck := FALSE;
  250.     FOR Z := 1 TO 1000 DO BEGIN
  251.       Invers;
  252.       GotoXY(XPos + 3, YPos + 3);
  253.       Write(UhrZeit);
  254.       GotoXY(XPos + 30, YPos + 3);
  255.       Write(Datum);
  256.       Normal;
  257.       IF KeyPressed THEN BEGIN
  258.         z := 1000;
  259.         TastenDruck := TRUE;
  260.       END;
  261.     END;
  262.   END;
  263.  
  264.   PROCEDURE Aktivieren;
  265.   BEGIN
  266.     Normal;  ClrScr;
  267.     Randomize;
  268.     ok := FALSE;
  269.     REPEAT
  270.       CsrOff;
  271.       PrintText(Random(36) + 1, Random(19) + 1);
  272.       IF TastenDruck THEN Eingabe;
  273.       ClrScr;
  274.     UNTIL ok;
  275.     Invers;  CopyRight;  Normal;
  276.   END;
  277.  
  278.   PROCEDURE Generieren;
  279.   VAR
  280.     st1, st2 : STRING;
  281.     Pfad     : STRING;
  282.   BEGIN
  283.     REPEAT
  284.       ClrScr;
  285.       CsrON;
  286.       st1  := '';
  287.       st2  := '';
  288.       Done := FALSE;
  289.       PrintText(19, 10);
  290.       ClrInput(20);
  291.       REPEAT
  292.         ch := ReadKey;
  293.         IF ch = #13 THEN
  294.           Done := TRUE
  295.         ELSE IF ch <> #0 THEN BEGIN
  296.           st1 := st1 + ch;
  297.           Write(#177);
  298.         END;
  299.         IF Length(st1) >= 20 THEN Done := TRUE;
  300.       UNTIL Done;
  301.       CsrOFF;
  302.       KopfText('  Dasselbe bitte noch einmal...   ');
  303.       ClrInput(Length(ST1));
  304.       Done := FALSE;
  305.       REPEAT
  306.         ch := ReadKey;
  307.         IF ch = #13 THEN
  308.           Done := TRUE
  309.         ELSE IF ch <> #0 THEN BEGIN
  310.           st2 := st2 + ch;
  311.           Write(#177);
  312.         END;
  313.         IF Length(st2) = Length(st1) THEN Done := TRUE;
  314.       UNTIL Done;
  315.     UNTIL st1 = st2;
  316.     CWord := st1;  Done := FALSE;
  317.  
  318.     Normal;
  319.     ClrScr;
  320.     Pfad := ParamStr(0);
  321.     Assign(f, Pfad);
  322.     {$I-}
  323.     Reset(f);
  324.     {$I+}
  325.     IF IOResult <> 0 THEN BEGIN
  326.       ClrScr;  CopyRight;  Normal;
  327.       Write('Programm nicht gefunden - Abbruch');
  328.       WriteLn('PASSWORD.EXE wurde nicht modifiziert.', ZV);
  329.       Halt(2);
  330.     END;
  331.  
  332.     Seek(f, FileSize(f) - 94);
  333.     FOR x := 1 TO 20 DO BEGIN
  334.       IF x <= Length(CWord) THEN
  335.         y := Ord(CWord[X])
  336.       ELSE
  337.         y := 0;
  338.       Write(f, y);
  339.     END;
  340.     Close(f);  ClrScr;  CopyRight;  Normal;
  341.     WriteLn('Das Password wurde installiert.', ZV);
  342.   END;
  343.  
  344.   FUNCTION GetParam : BYTE;
  345.   BEGIN
  346.     st := #0; CH := #0;            (* Parameter holen     *)
  347.     st := ParamStr(1);
  348.     ch := UpCase(st[1]);
  349.     GetCode;
  350.     IF ParamCount = 0 THEN
  351.       IF CWord = '' THEN
  352.         GetParam := 0              (* Syntax anzeigen     *)
  353.       ELSE
  354.         GetParam := 1              (* PassWord aktivieren *)
  355.     ELSE
  356.       IF ch = 'G' THEN
  357.         GetParam := 2              (* PassWord generieren *)
  358.       ELSE
  359.         GetParam := 0;             (* Syntax anzeigen     *)
  360.   END;
  361.  
  362. BEGIN
  363.   CheckBreak := FALSE;
  364.   CsrOFF;
  365.   CASE GetParam OF
  366.     0 : Syntax;
  367.     1 : Aktivieren;
  368.     2 : Generieren;
  369.   END;
  370.   CsrON;
  371.   CheckBreak := TRUE;
  372. END.
  373. (* ------------------------------------------------------ *)
  374. (*                 Ende von PASSWORD.PAS                  *)
  375.