Code: Alles auswählen
;/ Rechtschreibkontrolle
;/ *** Dictionary aus Wörterliste erzeugnen ***
;/ by Thorsten Hoeppner (Juli 2011)
; Format: wortstamm # endung1 | endung2 | ... # Großschreibung
; (Wortstamm muss mind. 4 Buchstaben haben, falls Endungen angegeben sind)
; Beispiel: kontrolliert#e|em|en|er|es#0
; Beispiel: kontrolle#n#1
; Beispiel: kontrollieren##0
#Source = 0
#Target = 1
Procedure.s GetProgramDirectory() ; Program Path
Protected ProgDir.s, TempDir.s
TempDir = GetTemporaryDirectory()
ProgDir = GetPathPart(ProgramFilename())
If ProgDir = #PB_Compiler_Home+"Compilers\" Or UCase(ProgDir) = UCase(TempDir)
ProgDir = GetCurrentDirectory()
EndIf
ProcedureReturn ProgDir
EndProcedure
ProgDir$ = GetProgramDirectory()
Structure WortStructure
Stamm.s
Endung.s
Art.s
EndStructure
NewList worte.WortStructure()
If ReadFile(#Source, ProgDir$+"Woerterliste.txt")
While Eof(#Source) = 0
wort$ = Trim(ReadString(#Source))
AddElement(worte())
worte()\Stamm = LCase(StringField(wort$,1,"#"))
worte()\Endung = StringField(wort$,2,"#")
worte()\Art = StringField(wort$,3,"#")
Wend
CloseFile(#Source)
SortStructuredList(worte(), #PB_Sort_Ascending, OffsetOf(WortStructure\Stamm), #PB_Sort_String)
If CreateFile(#Target, ProgDir$+"deutsch.dic")
WriteByte(#Target, 0)
ForEach worte()
WriteString(#Target, worte()\Stamm + "#" + worte()\Endung + "#" + worte()\Art)
WriteByte(#Target, 0)
Next
CloseFile(#Target)
EndIf
EndIfCode: Alles auswählen
;/ Rechtschreibkontrolle
;/ basiert auf einem Algorithmus von "netmaestro" (lexicon_pb.dll)
;/ by Thorsten Hoeppner (Juli 2011)
#File = 0
#RegExpr = 0
Procedure.s GetProgramDirectory() ; Program Path
Protected ProgDir.s, TempDir.s
TempDir = GetTemporaryDirectory()
ProgDir = GetPathPart(ProgramFilename())
If ProgDir = #PB_Compiler_Home+"Compilers\" Or UCase(ProgDir) = UCase(TempDir)
ProgDir = GetCurrentDirectory()
EndIf
ProcedureReturn ProgDir
EndProcedure
Procedure.s ReplaceRegExpr(text.s, replacetext.s, RegExpr.s)
If CreateRegularExpression(#RegExpr, RegExpr)
result$ = ReplaceRegularExpression(#RegExpr, text, replacetext)
FreeRegularExpression(#RegExpr)
EndIf
ProcedureReturn result$
EndProcedure
Procedure LoadDic(File.s) ; Wörterliste einlesen (Speicher)
Global *StartDicMem, *EndDicMem
If ReadFile(#File, File)
FileLen = Lof(#File)
*StartDicMem = AllocateMemory(FileLen)
If *StartDicMem
DicLen = ReadData(#File, *StartDicMem, FileLen)
*EndDicMem = *StartDicMem + DicLen
EndIf
CloseFile(0)
ProcedureReturn DicLen
EndIf
EndProcedure
Procedure FreeDic() ; Speicher freigeben
If *StartDicMem
FreeMemory(*StartDicMem)
EndIf
EndProcedure
Procedure.l WordExists(word$)
Define.b SetLoMem = #False
search$ = LCase(word$)
*loMem = *StartDicMem
*hiMem = *EndDicMem
While (*hiMem-*loMem) > 0
;{ Mitte des aktuellen Speicherbereichs ermitteln & Wortanfang suchen (Byte: 0)
If SetLoMem
*Mem = *loMem + 1
*loMem = *Mem + MemoryStringLength(*Mem)
SetLoMem = #False
Else
*Mem = *loMem + (*hiMem-*loMem) >> 1
While PeekB(*Mem-1) <> #Null
*Mem-1
Wend
EndIf ;}
check$ = StringField(PeekS(*Mem), 1, "#")
If search$ = check$ ;{ direkter Treffer
If StringField(PeekS(*Mem), 3, "#") = "1" ; Großschreibung nötig
If Left(UCase(check$),1) = Left(word$,1)
ProcedureReturn #True
EndIf
Else
ProcedureReturn #True
EndIf
;}
ElseIf Left(search$, Len(check$)) = check$ ;{ Wortstamm + Endungen
ending$ = StringField(PeekS(*Mem), 2, "#")
If ending$
For e=1 To CountString(ending$, "|")+1
If search$ = check$+StringField(ending$, e, "|")
If StringField(PeekS(*Mem), 3, "#") = "1" ; Großschreibung nötig
If Left(UCase(check$),1) = Left(word$,1)
ProcedureReturn #True
EndIf
Else
ProcedureReturn #True
EndIf
EndIf
Next
EndIf
;}
EndIf
;{ kein Treffer
If Left(search$, 4) = Left(check$, 4) ; mind. Wortstamm gleich
Debug "-> "+search$+" = "+check$
SetLoMem = #True
ElseIf search$ < check$
*hiMem = *Mem - 1 ; Wort und Speicherbereich darüber abschneiden
Else
*loMem = *Mem + MemoryStringLength(*Mem) ; Wort und Speicherbereich darunter abschneiden
EndIf
;}
Wend
ProcedureReturn #False
EndProcedure
Procedure SpellCheck(Text$, Name$, List unknown.s()) ; Rechtschreibung überprüfen
Protected result$, wort$
; Text$: Text zum Überprüfen
; Name$: Eigenname der ignoriert werden soll
; unknown.s(): LinkedList für unbekannte Worte
Text$ = ReplaceString(Text$, "- und", Chr(172)+" und") ; Bindestriche ersetzen
Text$ = ReplaceString(Text$, "- oder", Chr(172)+" oder") ; Bindestriche ersetzen
Text$ = ReplaceString(Text$, "- bzw", Chr(172)+"= bzw") ; Bindestriche ersetzen
Text$ = ReplaceString(Text$, "- ", Chr(166)) ; Trennungen ersetzen
Text$ = ReplaceString(Text$, Chr(172), "-") ; Bindestriche zurücksetzen
Text$ = Trim(ReplaceRegExpr(Text$+" ", " ", "[\(\)'/,;!:&\x22\r\n\xB6\x22]|(\. )|(·/·)"))
For w = 1 To CountString(Text$, " ")+1
wort$ = RTrim(StringField(Text$, w, " "), ".") ; wortweise auslesen
If wort$ = StringField(Name$, 1, " ") Or wort$ = StringField(Name$, 1, " ")+"s" Or wort$ = "" ; Eigenname ignorieren
Continue
EndIf
; Wort (ohne Trennung) überprüfen
If WordExists(RemoveString(wort$, Chr(166))) = #False
AddElement(unknown())
unknown() = ReplaceString(wort$, Chr(166), "- ")
EndIf
Next
If ListSize(unknown())
ProcedureReturn #True
EndIf
ProcedureReturn #False
EndProcedure
;- Testen der Rechtschreibkontrolle
NewList ErrorRS.s()
If LoadDic(GetProgramDirectory()+"deutsch.dic")
Text$ = "Fred verwendete seine volle aufmerksamkeit nicht immer auf das Unterrichtsge- schehen. Er ließ sich leicht ablenken und konte sich teilweise nur kurze Zeit auf eine Sa- che konsentrieren."
Name$ = "Fred"
If SpellCheck(Text$, Name$, ErrorRS())
Debug "=== Unbekannte Worte ==="
ForEach ErrorRS()
Debug "-> "+ErrorRS()
Next
EndIf
FreeDic()
EndIfDie fehlerhaften bzw. unbekannten Wörter werden in Form einer LinkedList zurückgeliefert.
Meine (schulbezogene) Wörterliste: Woerterliste.txt (130KB)
[EDIT]Problem behoben, dass einzelne Wörter nicht gefunden wurden[/EDIT]
