XProfan

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Zeichenkettenfunktionen und -prozeduren
Lauffähig ab Profan-Version 5.0
Testet, ob eine ZK aus nur Leerzeichen besteht oder  ist
Syntax: Empty$(<cZeichenkette>)
Parameter: <cZeicchenkette> ist die ZK, die überprüft werden soll
Rückgabe: 1, wenn die Zeichenkette nur aus Leerzeichen besteht oder leer ist, sonst 0
DEF Empty$(1) if(trim$($(1))=,1,0)
Testet, ob das erste Zeichen der übergebenen ZK eine Zahl ist
Syntax: IsDigit%(<cZeichenkette>)
Parameter: <cZeichenkette> ist die ZK, die überprüft werden soll
Rückgabe: 1, wenn das 1. Zeichen der Zeichenkette eine Zahl ist, sonst 0
DEF IsDigit%(1) (ord($(1))>47) and (ord($(1))<58)
Anzahl des Auftretens einer Sequenz in einer Zeichenkette
Syntax (<cZeichenfolge>,<cSuchfolge>)
Parameter: <cZeichenfolge> gibt die Zeichenkette an, in der die Sequenz <cSuchfolge>
gesucht werden soll
<cSuchfolge> ist die Zeichenfolge, die in der Zeichenkette <cZeichenfolge> gesucht wird
Rückgabe: Die Funktion liefert einen Wert, der angiebt, wie häufig die Sequenz <cSuchfolge>
in der Zeichenkette <cZeichenfolge> gefunden wurde
DEF NumAt(2) (Len($(1))-Len(Translate$($(1),$(2),)))/Len(§(2))
Wandelt in Zeichenketten, die eine Floatzahl darstellen das Dezimakomma in einen
Dezimalpunkt um oder umgekehrt, je nach übergebener Zeichenkette
Syntax: FloatZK$(<cZeichenkette>) z. B. 4711,1 oder 4711.1
Parameter: <cZeichenkette> ist eine ZK, die eine Floatzahl darstellt, in der als Dezimal-
trennzeichen entweder ein Punkt oder ein Komma vorhanden ist
Rückgabe: Die ZK <cZeichenkette>, in der entweder das Dezimaltrennzeichen Komma durch
einen Punkt ersetzt wurde, oder der Punkt durch ein Komma
Enthält die Zeichenfolge weder Komma noch Punkt, geschieht nichts
DEF FloatZK$(1) if(Instr(,,$(1))<>0,Translate$($(1),,,.),Translate$($(1),.,,))

Proc Rtrim$

    ----------
    Löscht alle rechten Leerzeichen
    Syntax: RTrim$ <cZeichenkette>
    Parameter: <cZeichenkette> ist die ZK, in der alle rechten Leerzeichen gelöscht
    werden sollen
    Rückgabe: Die übergebene ZK <cZeichenkette> ohne führende Leerzeichen
    parameters zk$
    declare lg%,rc$
    lg%=len(zk$)

    While Mid$(zk$,lg%,1)=

        dec lg%
        case lg%=0 : break

    EndWhile

    if lg%>0

        rc$=Left$(zk$,lg%)

    else

        rc$=

    endif

    return rc$
    EndProc  RTrim$

    Proc LTrim$

        ----------
        Löscht alle linken Leerzeichen
        Syntax: LTrim$ <cZeichenkette>
        Parameter: <cZeichenkette> ist die ZK, in der alle linken Leerzeichen gelöscht
        werden sollen
        Rückgabe: Die übergebene ZK <cZeichenkette> ohne nachfolgende Leerzeichen
        parameters zk$

        While Left$(zk$,1)=

            zk$=Del$(zk$,1,1)

        EndWhile

        Return zk$
        EndProc  LTrim$

        Proc ZulZ

            --------
            Testet eine ZK auf zulässige Zeichen
            Syntax ZulZ <cZeichenkette>,<nAuswahl>
            Parameter:
            <cZeichenkette> ist die ZK, die auf zul. Zeichen geprüft werden soll
            <nAuswahl> ist eine bitweise zusammengesetzte Zahl,
            die die zulässigen Zeichen definiert.
            Folgende Werte sind möglich
            2=A..Z
            4=a..z
            8=0..9
            16=Punkt,Komma als Dezimaltrennzeichen
            32=+,- als Vorzeichen
            64=Leerzeichen
            128=_ Unterstrich
            256=Ä,Ö,Ü
            512=ä,ö,ü
            1024=ß,+,-,Punkt,Komma als normale Textzeichen
            Rückgabe
            rc%=1, wenn alle Zeichen zulässig und an der richtigen Stelle (+,-)
            und nicht doppelt(../,,/,./.,)
            rc%=0, wenn Fehler
            parameters zk$,was%
            declare GB$,KB$,SondZ$,Z$,SZ$,Alles$
            declare z%,rc%,test$,z$
            declare lgpar%,kopie$,ort%
            GB$=ABCDEFGHIJKLMNOPQRSTUVWXYZ/
            KB$=abcdefghijklmnopqrstuvwxyz/
            Z$=0123456789/
            SZ$=.,/+-/ /_/
            SondZ$=ÄÖÜ/äöü/ß+-.,/
            Alles$=GB$+KB$+Z$+SZ$+SondZ$
            rc%=1
            test$=
            z%=1
            zulässige Zeichen zusammenstellen

            WhileNot z%>11

                if Testbit(was%,z%)

                    test$=test$+SubStr$(Alles$,z%,/)

                endif

                inc z%

            EndWhile

            lgpar%=len(zk$)
            z%=1
            Test auf zul. Zeichen

            WhileNot z%>lgpar%

                z$=Mid$(zk$,z%,1)

                if Instr(z$,test$)=0

                    rc%=0
                    break

                endif

                inc z%

            EndWhile

            If rc% and TestBit(was%,4)  Dezimalzahl?

                kopie$=zk$
                ort%=Instr(,,kopie$)  Test auf mehrere Dez.-Kommas

                if ort%<>0

                    kopie$=Del$(kopie$,ort%,1)
                    case Instr(,,kopie$)<>0 : rc%=0

                endif

                if rc%

                    kopie$=zk$
                    ort%=Instr(.,kopie$)  Test auf mehrere Dez.-Punkte

                    if ort%<>0

                        kopie$=Del$(kopie$,ort%,1)
                        case Instr(.,kopie$)<>0 : rc%=0

                    endif

                endif

                if rc%

                    kopie$=zk$
                    ort%=Instr(.,kopie$)  Test auf Dez.-Punkt+Dez.-Komma

                    if ort%<>0

                        case Instr(,,kopie$)<>0 : rc%=0

                    endif

                endif

                if rc%

                    case Instr(+,zk$)>1 : rc%=0  Vorzeichen an 1. Stelle?
                    case Instr(-,zk$)>1 : rc%=0  Vorzeichen an 1. Stelle?

                endif

            endif

            return rc%
            EndProc  ZulZ