REM  *****  BASIC  *****
option explicit
'*------------------------------------------------------------------------------------------------------------------------------------------------
sub AlleFehlerErzeugen(oEvent)
dim oDoc, oSuche, oFound, txt,i
oDoc = thisComponent
oSuche = odoc.createsearchdescriptor()
oSuche.SearchCaseSensitive = true
dim txtUE(2)
dim oRec

Dim oDatabaseContext
Dim oDataSource
Dim oConnection
dim oStatement

oDatabaseContext = createUnoService("com.sun.star.sdb.DatabaseContext")
oDataSource 	 = oDatabaseContext.getByName("Orthografie")
oConnection 	 = oDataSource.connectWithCompletion(createUnoService("com.sun.star.sdb.InteractionHandler"))
oStatement 	 = oConnection.createStatement
oStatement.ResultSetType = com.sun.star.sdbc.ResultSetType.SCROLL_INSENSITIVE

oRec=oStatement.executeQuery(sSQL)

do while oRec.next
	oSuche.SearchRegularExpression = true
	if instr(oRec.getstring(3),"|") > 0 then
	    oSuche.setsearchstring(oRec.getstring(3))
	else
	    oSuche.setsearchstring("[^@]" & oRec.getstring(3) & "[^@]")
	end if
    oFound = oDoc.findfirst(oSuche)
    do while not IsNull(oFound)

        txt = oFound.getString()

        txtUE() = array(left(txt,1), mid(txt, 2,len(txt)-2), right(txt,1))

            if rnd > val(oRec.getstring(6)) then FehlerReplace(oFound,txtUE(), oRec.getint(2), oRec.getstring(3), oRec.getint(4), oRec.getstring(5), true) ' oFound.SetString(left(txt,a(i,0)) & "@" & a(i,3) & "@" & right(txt,a(i,2)))

        oFound = oDoc.findnext(oFound.end, oSuche)
    loop
loop

oSuche = odoc.createreplacedescriptor()
oSuche.setsearchstring("@")
oSuche.setreplacestring("")
oDoc.replaceall(oSuche)

end sub
'*------------------------------------------------------------------------------------------------------------------------------------------------
function FehlerReplace(oFund,stxt ,iVorn, sSearch, iHint, sRepl, bRegEx)

	if len(sRepl) >=6 then
	    select case left(sRepl,6)
	    case "LowerC"
	        oFund.SetString(stxt(0) & left(stxt(1),iVorn) & "@" & LCASE(stxt(1)) & "@" & right(stxt(1),iHint) & stxt(2))
	    case "UpperC"
	        oFund.SetString(stxt(0) & left(stxt(1),iVorn) & "@" & UCASE(stxt(1)) & "@" & right(stxt(1),iHint) & stxt(2))
	    case "INSERT"
	    	dim a()
	    	dim txt
	    	' "INSERT,-,1,h" .... ein h an vorletzter Stelle einsetzen
	    	a()=Split(sRepl,",")
	    	txt = join(stxt(),"")
	    	if a(1) = "-" then
	    		txt = left(txt,len(txt)-cint(a(2))) & a(3) & right(txt,cint(a(2)))
	    	else
	    		txt = left(txt,cint(a(2))) & a(3) & right(txt,len(txt)-cint(a(2)))
	    	end if
	        oFund.SetString("@" & txt & "@")
	    case else
	    end select
    else
       	if bRegEx then
	        oFund.SetString(stxt(0) & left(stxt(1),iVorn) & "@" & sRepl & "@" & right(stxt(1),iHint) & stxt(2))
	    else
		    oFund.SetString(stxt(0) & "@" & sRepl & "@" & stxt(2))
	    end if
    end if

end Function 
'*------------------------------------------------------------------------------------------------------------------------------------------------
