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;

[nailor]

Zitat:

Zitat von markusj

*motz* Fäkalien schreibt man mit Ä

mfG

Markus

wolln wir schimpfwörter diskutieren und interpretieren spielen?!?

[dahead]

was ist denn ein/eine hurre?

sicherlich nicht "PROSTITUIRTE". wie wärs, wenn du bevor du ein "zensurprogramm" schreibst, dich über rechtschreibung informierst?

edit2: schön, dass du das e eingefügt hast. du könntest außerdem noch ein r entfernen, allerdings in dem "bösen" wort.

[robinWie]

Zitat:

du könntest außerdem noch ein r entfernen, allerdings in dem "bösen" wort.

:wiejetzt:

[Khabarakh]

Erst einmal, warum setzt du nicht HawkEyes Vorschlag um? Außerdem solltest du wieder auf TStringList als Parameter umsteigen. Wenn dabei ein abstrakter Fehler kommt, hast du irgendwo einen Fehler gemacht ;) .
Und nenn mir einen triftigen Grund, warum du die Exception abfängst ;) .

[Martin K]

Zitat:

Zitat von robinWie

Zitat:

du könntest außerdem noch ein r entfernen, allerdings in dem "bösen" wort.

:wiejetzt:

Ohne Worte...

[robinWie]

Ich habe das Wort jetzt mit einem r hinzugefügt. Fall der Anwender das mit rr schreiben sollte, wird es auch zensirt :???:

[Martin K]

Zitat:

Zitat von robinWie

Ich habe das Wort jetzt mit einem r hinzugefügt. Fall der Anwender das mit rr schreiben sollte, wird es auch zensirt :???:

Dann bleibt noch Hurrensohn und Hurrentochter...

[Stefan Hueg]

Möchte hier nur mit einwerfen, dass es doch evtl. besser wäre das ganze mit regulären Ausdrücken zu machen, oder nicht?

Ich weiss nicht inwiefern das umsetzbar ist, habe mich damit noch nicht beschäftigt, aber wäre ein denkansatz wenn du ernsthafte Zensur betreiben willst da deine Methodik sehr ungenau ist.

[robinWie]

Könnt ihr nicht mal die Augen zu machen :?: Ich will nicht ständig was berichtigen :cry:

[fLaSh11]

wtf. ist ein Hurer im Word.gif

[bigg]

Hi,

jetzt muss ich auch mal draufhauen. Nein, Nein, es ist nicht bös gemeint, ich habe nur ein paar Anregungen für dich. Die Idee finde ich im übrigen Klasse. :mrgreen: :wink:

1. Könnte man soetwas sogar in "Echtzeit" realisieren. Ein Syntax-Highlighter funktioniert im Grunde genauso.
2. Ist dein Algorithmus relativ träge, jedoch keineswegs falsch.
3. Solltest du nicht jedes Wort einzeln ersetzen, sondern dir vielleicht eine Blacklist anlegen, in denen die Kraftausdrücke gespeichert sind und diese durchsuchen und bei Bedarf ersetzen bzw. anderes zeichnen.


PS: TStringList.Text ist im übrigen eine Funktion, die die einzelnen Zeilen zusammenkopiert. Ruft man diese Funktion mehrfach auf (grade in StringReplace), würde die gesamte Funktion noch langsamer werden, als sie jetzt schon ist.