Eine Funktion zum Zensieren

[robinWie]

Hallo,
ich habe mal zwei Funktionen (eine für ein TMemo und eine für ein TRichEdit) geschrieben, mit den man Texte Zensieren kann. Sind bisjetzt nicht sehr viele Wörter, aber mehr sind mir nicht eingefallen. Ich bin halt gut erzogen :lol: . Einiger Wörter werden nicht zensiert sonder ersetzt.
Ihr könnt die Liste ja erweitern.

Delphi-Quellcode:

 // Funktion fuers Memo
function CensorMemo(Memo: TMemo): Boolean;
var
 S: string;
 i: integer;
begin
  try
    Assert(Assigned(Memo));
    for i := 0 to Memo.Lines.Count-1 do
      begin
        S := UpperCase(Memo.Lines.Strings[i]);

        //English Words
        S := StringReplace(S, 'FUCK',    'F**K',    [rfReplaceAll]);
        S := StringReplace(S, 'BITCH',   'B***H',   [rfReplaceAll]);
        S := StringReplace(S, 'FUCKER',  'F***ER',  [rfReplaceAll]);
        S := StringReplace(S, 'ASSHOLE', 'A**HOLE', [rfReplaceAll]);
        S := StringReplace(S, 'SHIT',    'S**T',    [rfReplaceAll]);
        S := StringReplace(S, 'NIGER',   'AFRICAN', [rfReplaceAll]);
        S := StringReplace(S, 'NIGGER',  'AFRICAN', [rfReplaceAll]);
        S := StringReplace(S, 'FUCKING', 'F***ING', [rfReplaceAll]);

        //German Words
        S := StringReplace(S, 'ARSCHLOCH',  'A****loch',                    [rfReplaceAll]);
        S := StringReplace(S, 'WIXER',      '<PIEP>',                       [rfReplaceAll]);
        S := StringReplace(S, 'SCHLAMPE',   'PROMISKE PERSON',              [rfReplaceAll]);
        S := StringReplace(S, 'PENNER',     'OBDACHLOSER',                  [rfReplaceAll]);
        S := StringReplace(S, 'KANAKE',     'UNSOZIALE PERSON',             [rfReplaceAll]);
        S := StringReplace(S, 'PARASIT',    'UNSOZIALE PERSON',             [rfReplaceAll]);
        S := StringReplace(S, 'HURRE',      'Prostituierte',                 [rfReplaceAll]);
        S := StringReplace(S, 'HURE',       'Prostituierte',                [rfReplaceAll]);
        S := StringReplace(S, 'HURRENSOHN', 'SOHN EINER Prostituierten',     [rfReplaceAll]);
        S := StringReplace(S, 'HURRENTOCHTER','TOCHTER EINER Prostituierten', [rfReplaceAll]);
        S := StringReplace(S, 'HURENSOHN', 'SOHN EINER Prostituierten',     [rfReplaceAll]);
        S := StringReplace(S, 'HURENTOCHTER','TOCHTER EINER Prostituierten', [rfReplaceAll]);
        S := StringReplace(S, 'KAKKE',      'FÄKALIEN',           [rfReplaceAll]);
        S := StringReplace(S, 'KAKE',       'FÄKALIEN',                     [rfReplaceAll]);
        S := StringReplace(S, 'KAGE',       'FÄKALIEN',                     [rfReplaceAll]);
        S := StringReplace(S, 'WIXE',       'EJAKULAT',           [rfReplaceAll]);
        S := StringReplace(S, 'WIX',        'EJAKULAT',           [rfReplaceAll]);
        S := StringReplace(S, 'SCHEISSE',   'FÄKALIEN',                     [rfReplaceAll]);
        S := StringReplace(S, 'SCHEISS',    'SCH***S',                      [rfReplaceAll]);
        S := StringReplace(S, 'ARSCH',      'A***H',                        [rfReplaceAll]);

        Memo.Lines.Strings[i] := LowerCase(S);
      end;
    Result := True;
  except
    Result := False;
  end;
end;

//Funktion fuers TRichEdit

function CensorRichText(RTF: TRichEdit): Boolean;
var
 S: string;
 i: integer;
begin
  try
    Assert(Assigned(RTF));
    for i := 0 to RTF.Lines.Count-1 do
      begin
        S := UpperCase(RTF.Lines.Strings[i]);

        //English Words
        S := StringReplace(S, 'FUCK',    'F**K',    [rfReplaceAll]);
        S := StringReplace(S, 'BITCH',   'B***H',   [rfReplaceAll]);
        S := StringReplace(S, 'FUCKER',  'F***ER',  [rfReplaceAll]);
        S := StringReplace(S, 'ASSHOLE', 'A**HOLE', [rfReplaceAll]);
        S := StringReplace(S, 'SHIT',    'S**T',    [rfReplaceAll]);
        S := StringReplace(S, 'NIGER',   'AFRICAN', [rfReplaceAll]);
        S := StringReplace(S, 'NIGGER',  'AFRICAN', [rfReplaceAll]);
        S := StringReplace(S, 'FUCKING', 'F***ING', [rfReplaceAll]);

        //German Words
        S := StringReplace(S, 'ARSCHLOCH',  'A****loch',                    [rfReplaceAll]);
        S := StringReplace(S, 'WIXER',      '<PIEP>',                       [rfReplaceAll]);
        S := StringReplace(S, 'SCHLAMPE',   'PROMISKE PERSON',              [rfReplaceAll]);
        S := StringReplace(S, 'PENNER',     'OBDACHLOSER',                  [rfReplaceAll]);
        S := StringReplace(S, 'KANAKE',     'UNSOZIALE PERSON',             [rfReplaceAll]);
        S := StringReplace(S, 'PARASIT',    'UNSOZIALE PERSON',             [rfReplaceAll]);
        S := StringReplace(S, 'HURRE',      'Prostituierte',                 [rfReplaceAll]);
        S := StringReplace(S, 'HURE',       'Prostituierte',                [rfReplaceAll]);
        S := StringReplace(S, 'HURRENSOHN', 'SOHN EINER Prostituierten',     [rfReplaceAll]);
        S := StringReplace(S, 'HURRENTOCHTER','TOCHTER EINER Prostituierten', [rfReplaceAll]);
        S := StringReplace(S, 'KAKKE',      'FÄKALIEN',           [rfReplaceAll]);
        S := StringReplace(S, 'KAKE',       'FÄKALIEN',                     [rfReplaceAll]);
        S := StringReplace(S, 'KAGE',       'FÄKALIEN',                     [rfReplaceAll]);
        S := StringReplace(S, 'WIXE',       'EJAKULAT',           [rfReplaceAll]);
        S := StringReplace(S, 'WIX',        'EJAKULAT',           [rfReplaceAll]);
        S := StringReplace(S, 'SCHEISSE',   'FÄKALIEN',                     [rfReplaceAll]);
        S := StringReplace(S, 'SCHEISS',    'SCH***S',                      [rfReplaceAll]);
        S := StringReplace(S, 'ARSCH',      'A***H',                        [rfReplaceAll]);
        RTF.Lines.Strings[i] := LowerCase(S);
      end;
    Result := True;
  except
    Result := False;
  end;
end;

[edit] Rechtschreibfehler berichtigt [/edit]

[TurboMartin]

Dann würd ich da irgendwoh einen Punkt reintun. :mrgreen:
vielleicht kannst du das ja auch unterbinden. :)

[monta]

vielleicht irre ich mich ja auch, aber besitzt ein Memo nicht die Eigenschaft Text, die denn Inhalt als String zurückgibt, da bräuchte man doch nicht die einzelnen Zeilen durchgehen.

Die Idee ist nicht schlecht, aber wenn denk ich, sollte man es so machen, das die Wörter und ihre ersetzungen in einer ini oder so gespeichert werden, sodass man schnell welche hinzufügen kann.

[Stefan Hueg]

Worte wie "Weniger" oder "Barsch" würden dann auch ersetzt werden oder? ;)

[robinWie]

Zitat:

vielleicht irre ich mich ja auch, aber besitzt ein Memo nicht die Eigenschaft Text, die denn Inhalt als String zurückgibt, da bräuchte man doch nicht die einzelnen Zeilen durchgehen.

Oh, dass habe ich in meinen Arbeitseifer nicht bedacht

Ausrede eingefallen: Ich hatte ursprünglich vor nur eine Funktion zu schreiben. Und die mit TStrings, aber ich bekam immer die Fehlermeldung "Abstrakter Anwendungsfehler".

Zitat:

Worte wie "Weniger" oder "Barsch" würden dann auch ersetzt werden oder? Wink

Kennst du eine bessere Routine für StringReplace?. Ich habe keine gefunden

Zitat:

Die Idee ist nicht schlecht, aber wenn denk ich, sollte man es so machen, das die Wörter und ihre ersetzungen in einer ini oder so gespeichert werden, sodass man schnell welche hinzufügen kann.

Habe ich auch schon drüber nachgedacht. Nur mir fällt noch kein System ein, wie ich die Ini aufbauen soll.

[monta]

Ich würde einfach alles in eine Section schreiben

Code:

[Ersetzungen]
BITCH=B***H
FUCKER=F***ER
usw...

Und das könnte man ja dann in zwei Stringlisten einlesen, über ReadSection und ReadsectionValues und dann jeweils in Replace einsetzen:

Delphi-Quellcode:

for i := 0 to Stringlist.Count - 1 do
  S := StringReplace(S, Stringlist1[i],   Stringlist2[i],   [rfReplaceAll]);

Das wäre mein Ansatz.

[Hawkeye219]

Zitat:

Zitat von monta

Und das könnte man ja dann in zwei Stringlisten einlesen, über ReadSection und ReadsectionValues und dann jeweils in Replace einsetzen

Warum 2 Stringlisten? Wenn man auf TStrings.Values zurückgreift, dann reicht eine...

Gruß Hawkeye

[robinWie]

Zitat:

Ich würde einfach alles in eine Section schreiben

Code:

[Ersetzungen]
BITCH=B***H
FUCKER=F***ER
usw...

Und das könnte man ja dann in zwei Stringlisten einlesen, über ReadSection und ReadsectionValues und dann jeweils in Replace einsetzen:

Delphi-Quellcode:

for i := 0 to Stringlist.Count - 1 do
  S := StringReplace(S, Stringlist1[i],   Stringlist2[i],   [rfReplaceAll]);

Das wäre mein Ansatz.

Ich werde dann mal bei deinen Ansatz ansätzen :lol:

[markusj]

*motz* Fäkalien schreibt man mit Ä

mfG

Markus

[robinWie]

Zitat:

*motz* Fäkalien schreibt man mit Ä

Danke für den Hinweis.
__________________________________________________ ___________________
So. Jetzt kommt bei "WordList" der Dateiname der Ini rein.
[edit]Es gibt noch eine Freiheit: Man kann die Section angeben und das beste
jetzt funktioniert es :-D [/edit]

Delphi-Quellcode:

function CensorMemo(Memo: TMemo; WordList, Section: string): Boolean;
var
 S: string;
 i,i1: integer;
 F: TiniFile;
 List1, List2: TStringList;
begin
  try
    Assert(Assigned(Memo));
    List1 := TStringList.Create;
    List2 := TStringList.Create;
    F     := TIniFile.Create(WordList);
    F.ReadSection      (Section, List1);

     for i := 0 to List1.Count -1 do
      List2.Add(F.ReadString(Section, List1.Strings[i], '<PIEP>'));

    for i := 0 to Memo.Lines.Count -1 do
      begin
        S := UpperCase(Memo.Lines.Strings[i]);
        for i1 := 0 to List1.Count -1 do
          S := StringReplace(S, List1.Strings[i1], List2.Strings[i1], [rfReplaceAll]);
        Memo.Lines.Strings[i] := LowerCase(S);
      end;
    Result := True;
  except
    Result := False;
  end;
  List1.Free;
  List2.Free;
  F.Free;
end;