procedure TfmMain.rdUCEFile(sDirectory:
String; sr: TSearchRec);
var
sl : TStringList;
st : TMemoryStream;
i : Integer;
iIdx : Integer;
sFileName :
String;
sAtDomain :
String;
sIndexName :
String;
sXSCL :
String;
bFound : Boolean;
bCheckOk : Boolean;
sLevel :
String;
iLevel : Integer;
sReceived :
String;
begin
sIndexName := tbUCE.IndexName;
tbUCE.IndexName := '
FileName';
bFound := tbUCE.FindKey([sr.
Name]);
tbUCE.IndexName := sIndexName;
// Mail noch nicht in der Datenbank?
if not bFound
then begin
sl := TStringList.Create;
st := TMemoryStream.Create;
Try
Try
sFileName := sr.FindData.cFileName;
sl.LoadFromFile(sDirectory + '
\' + sFileName);
sl.Add('
');
sl.Add('
.');
sl.Add('
');
sl.Add('
');
sl.Add('
');
sl.SaveToStream(st);
st.Position := 0;
Try
IdMessage.LoadFromStream(st);
except
on e :
Exception do Begin
IDMessage.NoEncode :=
Not IDMessage.NoEncode;
IDMessage.NoDecode :=
Not IDMessage.NoDecode;
st.Position := 0;
Try
IdMessage.LoadFromStream(st);
except
on e :
Exception do Begin
WriteToLogFile(FormatFileName(sFileName) + '
| Verarbeitungsfehler (IdMessage.LoadFromStream(st)): ' + e.
Message);
end;
end;
IDMessage.NoEncode :=
Not IDMessage.NoEncode;
IDMessage.NoDecode :=
Not IDMessage.NoDecode;
end;
end;
bCheckOk := False;
sXSCL := FormatXSCL(IdMessage.Headers.Values['
X-SCL']);
sLevel := Copy(Trim(sXSCL),1,1);
iLevel := StrToIntDef(sLevel,0);
// IP des absendenden Host (IP) holen.
sReceived := GetReceived(IdMessage.Headers.Values['
Received']);
// Hier muss die Überprüfung der Mails anhand der Kriterien in den Eingabefeldern
// geprüft werden
// Muss die Mail zugestellt werden?
iIdx := slZustellen.IndexOf(IdMessage.Headers.Values['
X-Sender']);
If iIdx = -1
Then begin
sAtDomain := Copy(IdMessage.Headers.Values['
X-Sender'],Pos('
@',IdMessage.Headers.Values['
X-Sender']),255);
iIdx := slZustellen.IndexOf(sAtDomain);
If iIdx = -1
Then begin
// Hier müssen wir dann noch einen(?) Exoten abarbeiten.
sAtDomain := '
xxx.xxx.xxx';
// <- den muss keiner wissen ;-)
If Pos(sAtDomain,IdMessage.Headers.Values['
X-Sender']) <> 0
then begin
iIdx := slZustellen.IndexOf(sAtDomain);
end;
end;
End;
If iIdx > -1
Then Begin
WriteToLogFile(FormatFileName(sFileName) + '
| ' + sXSCL + '
| zugestellt: ' + slZustellen[iIdx] + '
| ' + IdMessage.Subject + '
| ' + sReceived + '
| ' + IdMessage.From.Address + '
| ' + IdMessage.Headers.Values['
TO']);
RenameFile(sDirectory + '
\' + sFileName,edPickUp.Text + '
\' + sFileName);
bCheckOk := True;
End;
if Not bCheckOk
then begin
iIdx := slZustellen.IndexOf(IdMessage.From.Address);
If iIdx = -1
Then begin
sAtDomain := Copy(IdMessage.From.Address,Pos('
@',IdMessage.From.Address),255);
iIdx := slZustellen.IndexOf(sAtDomain);
End;
If iIdx > -1
Then begin
WriteToLogFile(FormatFileName(sFileName) + '
| ' + sXSCL + '
| zugestellt: ' + slZustellen[iIdx] + '
| ' + IdMessage.Subject + '
| ' + sReceived + '
| ' + IdMessage.From.Address + '
| ' + IdMessage.Headers.Values['
TO']);
RenameFile(sDirectory + '
\' + sFileName,edPickUp.Text + '
\' + sFileName);
bCheckOk := True;
end;
end;
if Not bCheckOk
then begin
iIdx := slZustellen.IndexOf(IdMessage.Recipients.EMailAddresses);
If iIdx > -1
Then begin
WriteToLogFile(FormatFileName(sFileName) + '
| ' + sXSCL + '
| zugestellt: ' + slZustellen[iIdx] + '
| ' + IdMessage.Subject + '
| ' + sReceived + '
| ' + IdMessage.From.Address + '
| ' + IdMessage.Headers.Values['
TO']);
RenameFile(sDirectory + '
\' + sFileName,edPickUp.Text + '
\' + sFileName);
bCheckOk := True;
end;
end;
if Not bCheckOk
then begin
i := 0;
iIdx := -1;
If slZustellBetreff.Count > 0
then Repeat
iIdx := Pos(slZustellBetreff[i],IdMessage.Subject);
Inc(i);
Until (i > slZustellBetreff.Count - 1)
or (iIdx > 0);
If iIdx > 0
Then begin
WriteToLogFile(FormatFileName(sFileName) + '
| ' + sXSCL + '
| zugestellt: ' + slZustellBetreff[i - 1] + '
| ' + IdMessage.Subject + '
| ' + sReceived + '
| ' + IdMessage.From.Address + '
| ' + IdMessage.Headers.Values['
TO']);
RenameFile(sDirectory + '
\' + sFileName,edPickUp.Text + '
\' + sFileName);
bCheckOk := True;
end;
end;
if not bCheckOk
Then Begin
// Haben wir einen Absender, der immer ignoriert wird?
iIdx := slIgnore.IndexOf(IdMessage.From.Address);
If iIdx > -1
Then Begin
WriteToLogFile(FormatFileName(sFileName) + '
| ' + sXSCL + '
| gelöscht (abzulehnender Absender): ' + slIgnore[iIdx] + '
| ' + IdMessage.Subject + '
| ' + sReceived + '
| ' + IdMessage.From.Address + '
| ' + IdMessage.Headers.Values['
TO']);
RenameFile(sDirectory + '
\' + sFileName,edDeleted.Text + '
\' + sFileName);
bCheckOk := True;
End;
If Not bCheckOk
Then begin
iIdx := slIgnore.IndexOf(IdMessage.Headers.Values['
X-Sender']);
If iIdx > -1
Then Begin
WriteToLogFile(FormatFileName(sFileName) + '
| ' + sXSCL + '
| gelöscht (abzulehnender Absender): ' + slIgnore[iIdx] + '
| ' + IdMessage.Subject + '
| ' + sReceived + '
| ' + IdMessage.From.Address + '
| ' + IdMessage.Headers.Values['
TO']);
RenameFile(sDirectory + '
\' + sFileName,edDeleted.Text + '
\' + sFileName);
bCheckOk := True;
End;
End;
// Haben wir einen Betreff, der zum Löschen führt?
If Not bCheckOk
Then begin
iIdx := slSubject.IndexOf(IdMessage.Subject);
If iIdx > -1
Then Begin
WriteToLogFile(FormatFileName(sFileName) + '
| ' + sXSCL + '
| gelöscht (Betreff): ' + IdMessage.Subject + '
| ' + IdMessage.Subject + '
| ' + sReceived + '
| ' + IdMessage.From.Address + '
| ' + IdMessage.Headers.Values['
TO']);
RenameFile(sDirectory + '
\' + sFileName,edDeleted.Text + '
\' + sFileName);
bCheckOk := True;
End;
end;
// Gibt es irgendeine Phrase aus der Wortliste?
If Not bCheckOk
Then begin
sl.Clear;
sl.Add('
');
sl.Add(IdMessage.Headers.Text);
sl.Add('
');
sl.Add(idMessage.Body.Text);
sl.Add('
');
for i := 0
To IDMessage.MessageParts.Count - 1
Do Begin
If IdMessage.MessageParts.Items[i]
Is TIDText
Then with IdMessage.MessageParts.Items[i]
As TIDText
do Begin
sl.Add('
');
// ContentType: text/html
if AnsiContainsText(IdMessage.MessageParts.Items[i].ContentType,'
html')
Then Begin
WebIndex.MaxLineSize := 80;
WebIndex.HTML.Text := Body.Text;
WebIndex.PrepareHtmlText;
sl.Add(AnsiReplaceText(WrapText(WebIndex.HTML.Text, 80),#13#10#13#10,#13#10));
End else Begin
sl.Add(Body.Text);
end;
End;
End;
// Hier wird noch nicht der Teil mit den Message-Informationen berücksichtigt,
// dies könnte aber wesentlich für die Erkennung von Spam mit Anhängen sein.
// Wie z. B.: Sperrung.zip, Hinweis.zip...
sl.Add('
');
for i := 0
To IdMessage.MessageParts.Count - 1
Do Begin
sl.Add('
');
sl.Add('
StoredPathName: ' + IdMessage.MessageParts.Items[i].StoredPathName);
sl.Add('
ContentTransfer: ' + IdMessage.MessageParts.Items[i].ContentTransfer);
sl.Add('
ContentType: ' + IdMessage.MessageParts.Items[i].ContentType);
sl.Add('
Headers.Text: ' + IdMessage.MessageParts.Items[i].Headers.Text);
end;
For iIdx := 0
To slWortliste.Count - 1
Do begin
bCheckOk := AnsiContainsText(sl.Text,slWortliste[iIdx]);
if bCheckOk
Then Begin
WriteToLogFile(FormatFileName(sFileName) + '
| ' + sXSCL + '
| gelöscht (Wortliste): ' + slWortliste[iIdx] + '
| ' + IdMessage.Subject + '
| ' + sReceived + '
| ' + IdMessage.From.Address + '
| ' + IdMessage.Headers.Values['
TO']);
RenameFile(sDirectory + '
\' + sFileName,edDeleted.Text + '
\' + sFileName);
Break;
End;
end;
end;
// Ist ein regulärer Ausdruck in der Mail zu finden?
If Not bCheckOk
Then Begin
For iIdx := 0
To slRegular.Count - 1
Do begin
Try
bCheckOk := FindRegExpr(sl.Text,slRegular[iIdx]);
if bCheckOk
Then Begin
WriteToLogFile(FormatFileName(sFileName) + '
| ' + sXSCL + '
| gelöscht (regulärer Ausdruck): ' + slRegular[iIdx] + '
| ' + IdMessage.Subject + '
| ' + sReceived + '
| ' + IdMessage.From.Address + '
| ' + IdMessage.Headers.Values['
TO']);
RenameFile(sDirectory + '
\' + sFileName,edDeleted.Text + '
\' + sFileName);
Break;
end;
except
on e :
Exception Do begin
WriteToLogFile(FormatFileName(sFileName) + '
| ' + sXSCL + '
| Fehler im regulären Ausdruck: ' + slRegular[iIdx] + '
| ' + IdMessage.Subject + '
| ' + sReceived + '
| ' + IdMessage.From.Address + '
| ' + IdMessage.Headers.Values['
TO']);
end;
end;
end;
end;
If not bCheckOk
then Begin
tbUCE.Append;
for i := 0
To tbUCE.FieldCount - 1
Do begin
tbUCE.Fields[i].AsString := IdMessage.Headers.Values[tbUCE.Fields[i].FieldName];
end;
tbUCE.FieldByName('
FileName').AsString := sFileName;
tbUCE.FieldByName('
From').AsString := IdMessage.From.Address;
tbUCE.FieldByName('
CountParts').AsInteger := IdMessage.MessageParts.Count;
tbUCE.FieldByName('
BODY').AsString := sl.Text;
Case IdMessage.ReplyTo.Count
Of
0 : ;
else
tbUCE.FieldByName('
Reply-To').AsString := IdMessage.ReplyTo[0].Address;
End;
tbUCE.FieldByName('
FileSize').AsInteger := sr.Size;
tbUCE.Post;
end;
end;
Except
on e :
Exception Do begin
WriteToLogFile(FormatFileName(sFileName) + '
| Verarbeitungsfehler (rdUCEFile(sDirectory: String; sr: TSearchRec)): ' + e.
Message);
end;
End;
Finally
st.Free;
sl.Free;
end;
end;
end;