XProfan

Source wurde am 26.06.2006 in die Babyklappe auf XProfan.Com abgelegt:
Die Funktion: CheckChars gibt einen String nur dann zurück wenn alle Zeichen darin erlaubt sind!
Sind ein oder mehrere Zeichen nicht erlaubt wird ein Leerstring das erste falsche Zeichen
oder alle falschen Zeichen zurückgegeben!
!!! Achtung: Dies gilt auch für Leerzeichen (Space) !!!

Proc CheckChars

    Parameters CC_I$,CC_Rg&
    Declare CC_O$,CC_ZW$,CC_ZW2$,CC_Erlaubt$,CC_Erg&
    Clear CC_O$,CC_ZW$,CC_ZW2$,CC_Erg&
    CC_Erlaubt$ = abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ .!?  <-- Erlaubte Zeichen

    WhileLoop 1,Len(CC_I$),1

        CC_ZW$ = Mid$(CC_I$,&Loop,1)

        IfNot Instr(CC_ZW$,CC_Erlaubt$)

            CC_Erg& = (CC_Erg& + 1)

            If (CC_Rg& > 0)

                If (CC_Erg& > 1)

                    CC_ZW2$ = CC_ZW2$ +  |  + Str$(&Loop) + / + CC_ZW$

                Else

                    CC_ZW2$ = Str$(&Loop) + / + CC_ZW$
                    Case (CC_Rg& > 1): Break

                EndIf

            Else

                Break

            EndIf

        EndIf

    EndWhile

    CaseNot CC_Erg&: CC_O$ = CC_I$

    If (CC_Rg& = 1)

        Case CC_Erg&: CC_O$ = (Str$(CC_Erg&) +  ||  + CC_ZW2$)

    ElseIf (CC_Rg& = 2)

        Case CC_Erg&: CC_O$ = CC_ZW2$

    EndIf

    Return CC_O$

EndProc

**** Start- Testprogramm ****
Declare Test$
Test$ = Dies+ ist ein- Test!ÄÖÜ                                         Hier sind fünf falsche Zeichen untergebracht
Cls
Print (test1$         :  + Test$)
Print
Print (CheckChars (1) :  + CheckChars(Test$,0))                         Fehler werden nicht zurüchgegeben
Print
Print (CheckChars (2) :  + CheckChars(Test$,1))                         Alle Fehler werden zurüchgegeben
Print
Print (CheckChars (3) :  + CheckChars(Test$,2))                         Nur der erste Fehler wird zurüchgegeben
WaitInput
End
**** Ende- Testprogramm *pan class=s2>***