Heslo - Pascal - Zdrojak - Surne

if heslo = kod then writeln('Zadane heslo je spravne')

else writeln('Zadal si nespravne heslo');

unit userA;

{*************************************************************}
{ meno a heslo uzivatela programu.                            }
{*************************************************************}

{$X+,D-,I-,S-,R-,O+,F+}

interface

uses Strings, Objects;

type
    { Administratorske heslo }
      TuserA = object(TObject)
      HesloA   : string15;
      procedure ZmenHesloA;
      function  ZadajHesloA:boolean;
      procedure NacitajA(var F:file);
      procedure UlozA(var F:file);
    end;

var
   AktuserA: TuserA;

procedure InituserA;
procedure DoneuserA;

implementation

uses Crt, Inputs, Drivers, HelpCtx, WinDia, Coding, Config,
     Dialogs, GDialogs, StdMess, Views, Global, App, GlobDef;

type
     { Editor, ktory neukazuje znaky ale xxxxx, v D je zadany string }
     PH2InputLine = ^TH2InputLine;
     TH2InputLine = object(TStrInputLine)
       D:string15;
       I:integer;
       procedure Reset;
       procedure HandleEvent(var Event:TEvent); virtual;
     end;

     { Dialog zmeny hesla }

     PHesloDialogA = ^THesloDialogA;
     THesloDialogA = object(TSoftDialog)
       H0:PH2InputLine;
       H1:PH2InputLine;
       H2:PH2InputLine;
       constructor Init;
       procedure HandleEvent(var Event:TEvent); virtual;
     end;

{ TH2InputLine }

{ Zachytava znaky a zobrazuje xxxxx, v D je zadany retazec }

procedure TH2InputLine.HandleEvent(var Event:TEvent);
begin
 if (Event.What=evKeyDown) and (Event.CharCode in AllChars)
    then begin
          D[0]:=chr(I+1);
          inc(I);
          D[i]:=Event.CharCode;
          Event.CharCode:='*';
         end;
 TStrInputLine.HandleEvent(Event);
end;

{ Inicializuje D a I pre zadavanie }

procedure TH2InputLine.Reset;
begin
 D:='               ';
 I:=0;
 D:='';
end;

{ THesloDialog }

constructor THesloDialogA.Init;
var R:Trect;
begin
 R.Assign(0,0,45,10);
 TSoftDialog.Init(R,'ADMIN Heslo');
 Options:=Options or ofCentered;
 InitWindow(@Self);
 PutText(2,2,'Zadajte heslo a potvrÔte ho:');
 PutText(2,3,'Star‚ heslo');
 PutText(2,4,'Nov‚  heslo');
 PutText(2,5,'Potvrdenie');
 R.Assign(14,3,33,4);
 H0:=new(PH2InputLine,Init(R,15));
 H0^.HelpCtx:=hc7;
 H0^.Reset;
 Insert(H0);
 R.Assign(14,4,33,5);
 H1:=new(PH2InputLine,Init(R,15));
 H1^.HelpCtx:=hc7;
 H1^.Reset;
 Insert(H1);
 R.Assign(14,5,33,6);
 H2:=new(PH2InputLine,Init(R,15));
 H2^.HelpCtx:=hc7;
 H2^.Reset;
 Insert(H2);
 PutButton(15,7,25,9,'~K~oniec',cmKoniec,bfNormal,hc4);
 SelectNext(false);
end;

{ Zadane aj potvrdene heslo musia byt rovnake, inak sprava }
{ Esc nemeni heslo                                         }

procedure THesloDialogA.HandleEvent(var Event:TEvent);
var HH0,HH1,HH2,HHE:String15;
begin
 TSoftDialog.HandleEvent(Event);
 if IsCommand(Event,cmKoniec) then
     begin
      HHE:='';
      HH0:=H0^.D;
      HH1:=H1^.D;
      HH2:=H2^.D;
      if (HH0=AktuserA.HesloA) and (HH1=HH2) then
         begin AktuserA.HesloA:=HH1;
               EndModal(cmKoniec);
         end
      else
      begin
         ShowMessage('Star‚ alebo nov‚ heslo/potvrdenie nebolo spr vne zadan‚');
         H0^.Reset; H0^.SetData(HHE);
         H1^.Reset; H1^.SetData(HHE);
         H2^.Reset; H2^.SetData(HHE);
         H0^.Select;
      end;
      ClearEvent(Event);
     end;
end;

{ TuserA }

function TuserA.ZadajHesloA:boolean;
label 1;
var i:integer; ch:char; Hes:string15;
    Windmaxsave:word;
    Windminsave:word;
begin
 Windmaxsave:=Windmax;
 Windminsave:=Windmin;
 

 TextAttr:=GetuserColor(3);

 Window(20,10,45,14); ClrScr;
 gotoxy(2,2); write('Heslo');
 gotoxy(2,3); Write('ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄż');
 gotoxy(2,4); Write('ł* Vlozte ADMIN HESLO *ł');
 gotoxy(2,5); Write('ŔÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŮ');
 TextAttr:=GetuserColor(3);
 TextAttr:=GetuserColor(4);
 gotoxy(8,2);  write('               ');
 gotoxy(9,2);
 Hes:='               ';
 i:=1; CH:=#0;
 while (CH<>#13) do
   begin
    CH:=readkey; if CH=#13 then goto 1;
    Hes[i]:=CH;
    gotoxy(8+i,2);write('*');
    i:=i+1; if i=17 then goto 1;
   end;
1:Hes[0]:=chr(i-1);
  {ZadajHesloA:=(AktuserA.HesloA=Hes);}
  if AktuserA.HesloA=Hes then ZadajHesloA:=true
  else begin
  ZadajHesloA:=false;
  showmessage('Neplatne Heslo. Pristup zamietnuty.'); { Male a velke su rozdielne pismena ! }
  end;
  Windmax:=Windmaxsave;
  Windmin:=Windminsave;
 end;

{ Dialog pre zmenu hesla uzivatela }

procedure TuserA.ZmenHesloA;
var HD:PHesloDialogA;
begin
   new(HD,Init);
  if DeskTop^.ExecView(HD)=cmKoniec then
     begin
      SaveConfiguration;
     end;
  dispose(HD,Done);
 UpClear;
end;

{ Nacitanie / ulozenie udajov }

procedure NacitajStrA(var F:file; var S:string15; L:integer);
begin
 BlockRead(F,S,L);
 S:=Dekoduj(S);
end;

procedure UlozStr(var F:file; S:string15;  L:integer);
begin
 S:=Koduj(S);
 BlockWrite(F,S,L);
end;

{ Ulozenie udajov }

procedure TuserA.UlozA(var F:file);
begin
 UlozStr(F,HesloA,sizeof(HesloA));;
end;

{ Nacitanie udajov }

procedure TuserA.NacitajA(var F:file);
begin
 NacitajStrA(F,HesloA,sizeof(HesloA));;
end;

{-------------------------------------------------------}

procedure InituserA;
begin
 AktuserA.Init;
end;

procedure DoneuserA;
begin
 AktuserA.Done;
end;

end.