XProfan

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Passwortabfrage
Lauffähig ab Profan-Version 5.0
DEF GetStockObject(1) !GDI32,GetStockObject
DEF SetGUI(1) SendMessage(&(1),$30,Val(GetStockObject($11)),1)
FREEWARE FÜR ALLE PROFANer
COPYRIGHT BY MICHAEL STEINS
FÜR PROFAN² 6.6
BEI ANDEREN VERSIONEN MUSS ES UMGESCHRIEBEN WERDEN!!

Proc Passwort

    Parameters typ%, vorgabe$, pass$, mode%
    Declare passwort$, dlg%, edit%, ok%, abort%, del%, ende%

    If typ% = 0

        passwort$ = pass$

    Else

        passwort$ = @Date$(0)

    EndIf

    dlg% = createdialog(%Hwnd,Passwort,237,180,396,190)
    SetGUI (createtext(dlg%,Bitte geben Sie das Kennwort ein, um mit der Software arbeiten zu können.,10,10,500,15))
    SetGUI (createtext(dlg%,Wenn Sie nicht über dass Kennwort verfügen, klicken Sie bitte auf Abbrechen.,10,24,500,15))
    SetGUI (createtext(dlg%,Kennwort:,30,80,50,15))

    If mode% = 0

        edit% = createedit(dlg%,vorgabe$,90,80,200,20)

    Else

        edit% = createedit(dlg%,vorgabe$,90,80,200,(-20))

    EndIf

    SetGUI (edit%)
    ok% = createdefbutton(dlg%,&Ok,10,130,90,22)
    del% = createbutton(dlg%,&Löschen,300,80,70,22)
    SetGUI (del%)
    SetGUI (creategroupbox(dlg%, Kennworteingaben ,10,50,370,70))
    abort% = createbutton(dlg%,A&bbrechen,110,130,90,22)
    SetGUI (ok%)
    SetGUI (abort%)
    ende%=0

    WhileNot ende%

        WaitInput

        If GetFocus(abort%)

            ende%=1
            DestroyWindow (dlg%)
            return ABORT

        ElseIf GetFocus(ok%)

            EnableWindow dlg%,0

            if gettext$(edit%) = passwort$

                ende%=1
                DestroyWindow(dlg%)
                Return OK

            Else

                MessageBox Das von Ihnen eingegebene Passwort ist falsch.
                Bitte versuchen Sie es erneut.,Info,64

            EndIf

            EnableWindow dlg%,1
            SetActiveWindow (dlg%)

        ElseIf GetFocus(del%)

            Settext edit%,

        EndIf

    Wend

EndProc

Passwort 0, Das Passwort lautet SSE!!!,SSE,0

If @$(0)=ABORT

    MessageBox Eingabe wurde abgebrochen,Info,64
    End

EndIf

Case @$(0)=OK: MessageBox Alles ok,Info,64
MessageBox Bitte geben Sie das Passwort erneut ein.,Info,64
Passwort 0,,SSE,1

If @$(0)=ABORT

    MessageBox Eingabe wurde abgebrochen,Info,64
    End

EndIf

Case @$(0)=OK: MessageBox Alles ok,Info,64
MessageBox Bitte geben Sie nun das aktuelle Datum (+@DATE$(0)+) ein,Info,64
Passwort 1,Bitte aktuelles Datum eingeben.,,0

If @$(0)=ABORT

    MessageBox Eingaben wurde abgebrochen,Info,64
    End

EndIf

Case @$(0)=OK: MessageBox Alles ok,Info,64
MessageBox PASSWORT
Copyright by Michael Steins
www.sse.notricks.de,Info,64
End