> FUNCTION getfield$(field$,nr%,div$) ! 1.1 130902 $F% ' --------- ' Hole Feld ' --------- ' ' Parameter : Field$ (Gesamtfeld) ' Nr% (Nummer des Feldes) ' Div$ (Feld-Trenner) ' PreProc : - ' InlineProc: - ' InlineFunc: - ' Konstante : - ' Variable : - ' Ergebnis : Gibt den Inhalt des gew］schten Feldes zur…k. ' Beispiel : "AA|BB|CC",3,"" -> "CC" ' Bemerkung : - ' LOCAL entry$,q%,v%,w%,nr.old% ' IF div$="" div$="|" ENDIF ' field$=field$+div$ nr.old%=nr% w%=0 REPEAT v%=SUCC(w%) w%=INSTR(field$,div$,v%) IF w%=0 entry$=MID$(field$,v%,MAX(SUB(LEN(field$),PRED(v%)),0)) ELSE DEC nr% IF nr%<=0 entry$=MID$(field$,v%,MAX(SUB(w%,v%),0)) ENDIF ENDIF EXIT IF w%=0 UNTIL nr%<=0 RETURN entry$ ENDFUNC > FUNCTION rfield$(field$,nr%,div$) ! 1.1 130902 $F% ' -------------------- ' Hole Feld von rechts ' -------------------- ' ' Parameter : Field$ (Gesamtfeld) ' Nr% (Nummer des Feldes) ' Div$ (Feld-Trenner) ' PreProc : - ' InlineProc: - ' InlineFunc: Cfield, Getfield$ ' Konstante : - ' Variable : - ' Ergebnis : Gibt von rechts den Inhalt des gew］schten Feldes zur…k. ' Beispiel : "AA|BB|CC",1,"" -> "CC" ' Bemerkung : Nr. 1 ist das letzte Feld ' LOCAL max%,entry$,q%,v%,w% ' max%=@cfield(field$,div$) IF nr%<=max% entry$=@getfield$(field$,SUCC(SUB(max%,nr%)),div$) ENDIF ' RETURN entry$ ENDFUNC > FUNCTION cfield(field$,div$) ! 1.2 130602 $F% ' ----------------- ' Anzahl der Felder ' ----------------- ' ' Parameter : Field$ (Gesamtfeld) ' Div$ (Feld-Trenner) ' PreProc : - ' InlineProc: - ' InlineFunc: - ' Konstante : - ' Variable : - ' Ergebnis : Gibt die Anzahl der verf“baren Felder zur…k ' oder "0", falls das Gesamtfeld leer ist. ' Beispiel : "AA|BB|CC","" -> 3 ' Bemerkung : - ' LOCAL count%,w%,l% ' IF div$="" div$="|" ENDIF ' l%=LEN(field$) count%=ABS(l%>0) ' REPEAT w%=INSTR(field$,div$,SUCC(w%)) EXIT IF w%=0 INC count% UNTIL w%=l% ' RETURN count% ENDFUNC > FUNCTION infield(field$,string$,nr%,div$,part!) ! 1.0 130902 $F% ' ---------- ' Finde Feld ' ---------- ' ' Parameter : Field$ (Gesamtfeld) ' String$ (Gesuchter Feldinhalt) ' Nr% (Feld ab dem gesucht werden soll) ' Div$ (Feld-Trenner) ' Part! (= True -> String nur Teil eines Feldes) ' PreProc : - ' InlineProc: - ' InlineFunc: Adrfield, Cfield, Nrfield ' Konstante : - ' Variable : - ' Ergebnis : Gibt die Nummer des gefundenen Feldes zur…k oder "0", ' falls der Suchstring nicht im Gesamtfeld vorhanden ist. ' Beispiel : "AA|BB|CC|BB","BB",0,"",0 -> 2 ' "AA|BB|CC|BB","B",0,"",0 -> 0 ' "AA|BB|CC|BB","B",0,"",-1 -> 2 ' "AA|BB|CC|BB","BB",3,"",0 -> 4 ' Bemerkung : - ' LOCAL q%,adr%,lfield$,rfield$,lfield%,result% ' IF div$="" div$="|" ENDIF ' IF nr%<=1 ! Suche von Beginn an adr%=1 ! 1. Stringoffset lfield$="" ! Kein Feld ignorieren rfield$=field$ ! Alle Felder beachten ELSE ! Suche ab Feld Nr% adr%=@adrfield(field$,nr%,div$) ! Stringoffset ermitteln lfield$=LEFT$(field$,PRED(adr%)) ! Zu ignorierende Felder rfield$=MID$(field$,adr%) ! Zu beachtende Felder ENDIF ' IF lfield$<>"" ! Anzahl der Felder, in denen lfield%=PRED(@cfield(lfield$,div$)) ! nicht gesucht wird ENDIF ' IF part! ! Wenn Suche eines Teiles, Suche q%=INSTR(rfield$,string$) ! des Strings ｜er das Gesamtfeld ELSE ! Sonst inkl. der Trenner suchen q%=INSTR(div$+rfield$+div$,div$+string$+div$) ENDIF ' IF q%=0 result%=0 ELSE result%=@nrfield(rfield$,q%,div$)+lfield% ENDIF ' RETURN result% ENDFUNC > FUNCTION setfield$(field$,nr%,string$,div$) ! 1.0 140902 $F% ' ------------- ' Schreibe Feld ' ------------- ' ' Parameter : Field$ (Gesamtfeld) ' Nr% (Nummer des Feldes) ' String$ (Neuer Feldinhalt) ' Div$ (Feld-Trenner) ' PreProc : - ' InlineProc: - ' InlineFunc: Adrfield, Cfield ' Konstante : - ' Variable : - ' Ergebnis : Gibt neues Gesamtfeld zur…k. ' Beispiel : "AA|BB|CC",2,"XX","" -> "AA|XX|CC" ' "AA|BB|CC",5,"XX","" -> "AA|BB|CC||XX" ' Bemerkung : Noch nicht existente (Zwischen-)Felder werden erstellt ' LOCAL count%,adr%,len%,lfield$,rfield$ ' IF div$="" div$="|" ENDIF ' count%=@cfield(field$,div$) ! Anzahl der vorhandenen Felder ' IF nr%<=count% ! Zu nderndes Feld existiert adr%=@adrfield(field$,nr%,div$) ! Feldoffset ermitteln und lfield$=LEFT$(field$,PRED(adr%)) ! vorherige & folgende Felder rfield$=MID$(field$,ADD(adr%,LEN(@getfield$(field$,nr%,div$)))) ! trennen field$=lfield$+string$+rfield$ ! Neues Gesamtfeld erstellen ELSE ! Feld mu neu angelegt werden field$=@addfield$(field$,nr%,string$,div$) ! indem es angehngt wird ENDIF ' RETURN field$ ENDFUNC > FUNCTION addfield$(field$,nr%,string$,div$) ! 1.0 140902 ' ------------ ' Ergnze Feld ' ------------ ' ' Parameter : Field$ (Gesamtfeld) ' Nr% (Nummer des neuen Feldes) ' String$ (Neues Feld) ' Div$ (Feld-Trenner) ' PreProc : - ' InlineProc: - ' InlineFunc: Adrfield, Cfield ' Konstante : - ' Variable : - ' Ergebnis : Neues Gesamtfeld ' Beispiel : "AA|BB|CC",2,"XX","" -> "AA|XX|BB|CC" ' "AA|BB|CC",5,"XX","" -> "AA|BB|CC||XX" ' Bemerkung : Noch nicht existente Zwischenfelder werden ebenfalls erstellt ' LOCAL count%,adr%,lfield$,rfield$ ' IF div$="" div$="|" ENDIF ' count%=@cfield(field$,div$) ! Anzahl existierender Felder ' IF nr%<=count% ! Neues Feld einf“en? IF nr%>0 ! Neue Feldnummer > 0 adr%=@adrfield(field$,nr%,div$) ! Feldoffset ermitteln lfield$=LEFT$(field$,PRED(adr%)) ! Vorherige Felder und rfield$=div$+MID$(field$,adr%) ! folgende Felder trennen ELSE ! Neue Feldnummer = 0 lfield$="" rfield$="" ENDIF ELSE ! Neues Feld anhngen? IF count%>0 ! Wenn Gesamtfeld existiert, lfield$=field$+STRING$(SUB(nr%,count%),div$) ! mit Leerfeldern f〕len, rfield$="" ! und keine folgenden Felder! ELSE ! Gesamtfeld existiert nicht, lfield$=STRING$(PRED(nr%),div$) ! also aus Leerfeldern bilden, rfield$="" ! und keine folgenden Felder! ENDIF ENDIF field$=lfield$+string$+rfield$ ! Neues Gesamtfeld erstellen ' RETURN field$ ENDFUNC > FUNCTION delfield$(field$,nr%,div$) ! 1.0 140902 ' ------------- ' Entferne Feld ' ------------- ' ' Parameter : Field$ (Gesamtfeld) ' Nr% (Nummer des Feldes) ' Div$ (Feld-Trenner) ' PreProc : - ' InlineProc: - ' InlineFunc: Getfield$, Adrfield, Cfield ' Konstante : - ' Variable : - ' Ergebnis : Neues Gesamtfeld ' Beispiel : "AA|BB|CC",2,"" -> "AA|CC" ' Bemerkung : - ' LOCAL count%,adr%,lfield$,rfield$ ' IF div$="" div$="|" ENDIF ' count%=@cfield(field$,div$) ! Anzahl existierender Felder ' IF nr%<=count% ! Feld existiert? adr%=@adrfield(field$,nr%,div$) ! Feldoffset ermitteln lfield$=LEFT$(field$,PRED(adr%)) ! Vorherige & folgende Felder rfield$=MID$(field$,ADD(adr%,LEN(@getfield$(field$,nr%,div$)))) ! trennen ' IF RIGHT$(lfield$)=div$ ! Vorheriges Feld leer? lfield$=LEFT$(lfield$,PRED(LEN(lfeld$))) ! Korrektur! ELSE IF LEFT$(rfield$)=div$ ! Folgendes Feld leer? rfield$=RIGHT$(rfield$,PRED(LEN(rfield$))) ! Korrektur! ENDIF ' field$=lfield$+rfield$ ! Neues Gesamtfeld erstellen ENDIF ' RETURN field$ ENDFUNC > FUNCTION adrfield(field$,nr%,div$) ! 1.0 130902 ' ----------------------- ' Adressoffset des Feldes ' ----------------------- ' ' Parameter : Field$ (Gesamtfeld) ' Nr% (Nummer des Feldes) ' Div$ (Feld-Trenner) ' PreProc : - ' InlineProc: - ' InlineFunc: - ' Konstante : - ' Variable : - ' Ergebnis : Gibt den Stringoffset des Feldes im Gesamtfeld zur…k ' oder "0" falls das Feld nicht existiert ' Beispiel : "AA|BB|CC",2,"" -> 4 ' "AA|BB|CC",3,"" -> 7 ' Bemerkung : - ' LOCAL v%,w%,nr.old% ' IF div$="" div$="|" ENDIF ' field$=field$+div$ nr.old%=nr% w%=0 REPEAT v%=SUCC(w%) w%=INSTR(field$,div$,v%) IF w%=0 CLR v% ELSE DEC nr% ENDIF EXIT IF w%=0 UNTIL nr%<=0 ' RETURN v% ENDFUNC > FUNCTION nrfield(field$,adr%,div$) ! 1.0 130902 ' ----------------- ' Nummer des Feldes ' ----------------- ' ' Parameter : Field$ (Gesamtfeld) ' Adr% (Adressoffset im Gesamtfeld) ' Div$ (Feld-Trenner) ' PreProc : - ' InlineProc: - ' InlineFunc: Cfield ' Konstante : - ' Variable : - ' Ergebnis : Gibt die Nummer des Feldes zur…k ' Beispiel : "AA|BB|CC",4,"" -> 2 ' "AA|BB|CC",5,"" -> 2 ' "AA|BB|CC",7,"" -> 3 ' Bemerkung : - ' ' LOCAL nr% ' IF div$="" div$="|" ENDIF ' nr%=@cfield(LEFT$(field$,adr%),div$) ' IF MID$(field$,adr%,1)=div$ DEC nr% ENDIF ' RETURN nr% ENDFUNC ' ' ========== Bonus ========== ' > FUNCTION iblock$(field$,nr%,ldiv$,rdiv$,border!) ! 1.0 130902 ' ------------------------ ' Hole umschlossenen Block ' ------------------------ ' LOCAL left%,right%,entry$,q%,v%,w% ' left%=@cfield(field$,ldiv$) right%=@cfield(field$,rdiv$) IF left%>0 AND right%>0 entry$=@getfield$(@getfield$(field$,SUCC(nr%),ldiv$),1,rdiv$) IF border! AND entry$<>"" entry$=ldiv$+@getfield$(@getfield$(field$,SUCC(nr%),ldiv$),1,rdiv$)+rdiv$ ENDIF ENDIF ' RETURN entry$ ENDFUNC > FUNCTION oblock$(field$,nr%,ldiv$,rdiv$,opened!) ! 1.0 130902 ' --------------------------- ' Hole ausgeschlossenen Block ' --------------------------- ' Sind offene Begrenzer m波lich, dann Opened!=True. Beispiel: ' "size=+1>Text" liefert bei '1<>' "Text" (sonst "size=+1") ' Sind offene Begrenzer unm波lich, dann Opened!=False. Beispiel: ' "Satzende; Meier & Co." liefert bei '1&;' "Satzende" (sonst " Meier ") ' Mu noch korrigiert werden!! LOCAL left%,right%,entry$,q%,v%,w% ' IF opened! entry$=@iblock$(field$+ldiv$,nr%,rdiv$,ldiv$,FALSE) ELSE entry$=@iblock$(rdiv$+field$+ldiv$,nr%,rdiv$,ldiv$,FALSE) ENDIF ' RETURN entry$ ENDFUNC > FUNCTION delblocks$(text$,ldiv$,rdiv$,opened!) ! 1.0 140902 ' ---------------- ' Entferne IBlocks ' ---------------- ' LOCAL q%,q$,result$ ' REPEAT INC q% q$=@oblock$(@rm$(text$,rdiv$+ldiv$),q%,ldiv$,rdiv$,opened!) result$=result$+q$ UNTIL (q$="" AND q%>1) RETURN result$ ENDFUNC > FUNCTION deltags$(html$,unix!) ' LOCAL newline$,result$ IF unix! newline$=CHR$(&HA) ELSE newline$=CHR$(&HA)+CHR$(&HD) ENDIF @rtag("/title",newline$+newline$,html$) @rtag("/h1",newline$+newline$,html$) @rtag("/h2",newline$+newline$,html$) @rtag("/h3",newline$+newline$,html$) @rtag("/h4",newline$+newline$,html$) @rtag("/h5",newline$+newline$,html$) @rtag("/h6",newline$+newline$,html$) @rtag("br",newline$,html$) @rtag("div",newline$,html$) @rtag("p",newline$+newline$,html$) @rtag("dl",newline$+newline$,html$) @rtag("dd",newline$,html$) @rtag("dt",newline$,html$) @rtag("ol",newline$+newline$,html$) @rtag("ul",newline$+newline$,html$) @rtag("li",newline$,html$) @rtag("table",newline$+newline$,html$) @rtag("/tr",newline$,html$) @rtag("hr",newline$+STRING$(75,"-")+newline$,html$) @rc(newline$+newline$+newline$+newline$,newline$+newline$,html$) @rc(" "," ",html$) @rc(" "+newline$,newline$,html$) html$=@delblocks$(html$,"<",">",TRUE) RETURN TRIM$(@rc$(html$," "," ")) ENDFUNC > PROCEDURE rtag(element$,text$,VAR html$) ' ----------------- ' Ersetze HTML-Tags ' ----------------- ' Element$ in Kleinschrift! ' @rc("<"+element$+">",text$,html$) @rc("<"+element$+" ",text$+"",text$,html$) @rc("<"+element$+" ",text$+" PROCEDURE rc(char$,newchar$,VAR s$) ! 1.1 130602 ' ------------------------------- ' Charakter(e) in String ersetzen ' ------------------------------- LOCAL rc_q%,len_c%,len_n% ' len_c%=LEN(char$) len_n%=LEN(newchar$) rc_q%=INSTR(s$,char$) WHILE rc_q%>0 s$=LEFT$(s$,PRED(rc_q%))+newchar$+RIGHT$(s$,SUB(SUB(LEN(s$),rc_q%),PRED(len_c%))) rc_q%=INSTR(s$,char$,ADD(rc_q%,len_n%)) WEND ' RETURN > FUNCTION rc$(s$,char$,newchar$) ! 1.0 130602 ' ------------------------------------------ ' Charakter(e) in String ersetzen (Funktion) ' ------------------------------------------ ' @rc(char$,newchar$,s$) RETURN s$ ENDFUNC > FUNCTION rm$(s$,char$) ! 1.0 200603 ' ----------------------------------------- ' Charakter(e) in String l敗chen (Funktion) ' ----------------------------------------- ' @rc(char$,"",s$) RETURN s$ ENDFUNC