// Datensatz
TDataSetLic1 =
record
PurchaseOption :
string;
TypeOfPlatform :
string;
TypeOf_License :
string;
Clients_name :
string;
Contact_person :
string;
Clients_email :
string;
Clients_phone :
string;
Expiration :
string;
Price :
string;
server :
string;
note :
string;
license_user :
string;
license_pass :
string;
folder :
string;
art :
string;
subject :
string;
from :
string;
end;
TMail =
record
body :
string;
from :
string;
subject :
string;
folder :
string;
time:
string;
end;
var
Form1: TForm1;
// für Outlook-Zugriff
Outlook: _Application;
// OutlookApplication; for D5 users
NmSpace: NameSpace;
//der aktuelle Order in Outlook
Folder: MAPIFolder;
// keine großen Arrays, max. 20 Felder
folderStrings:
array of string;
forbiddenFolders:
array of string;
// großes Array, bisher liegen hier all Datensätze
licenseSet1:
array of TDataSetLic1;
//Unwichtig
testbereich: boolean;
// Für die Statistik
start_global_timer: boolean;
st_timerAll, st_counterAll : integer;
st_timerFolder, st_counterFolder : integer;
st_speedFolder, st_speedAll, st_ETA : real;
st_lastMailTime, st_last100MailTime : integer;
implementation
uses Math;
{$R *.dfm}
// Outlook-Zugriff
procedure initializeOutlookAccess();
var
Unknown: IUnknown;
Result: HResult;
begin
{$IFDEF VER120} // Delphi 4
Outlook := CoApplication_.Create;
{$ELSE} // Delphi 5
Outlook := CoOutlookApplication.Create;
{$ENDIF}
NmSpace := Outlook.GetNamespace('
MAPI');
NmSpace.Logon('
', '
', False, False);
Folder := NmSpace.GetDefaultFolder(olPublicFoldersAllPublicFolders);
Application.ProcessMessages
end;
//Testoutput, zeigt den Inhalt des aktuellen Ordners ("Folder") an
procedure listFolder(output:TStrings);
var i: integer;
begin
output.Clear;
output.Add('
FOLDER: ' + Folder.
Name + '
enthält:' + #13#10 + '
~~~~~~~~~~~~~~~~~~~~~~~~');
For i := 1
To Folder.Folders.Count
do
begin
output.Add(Folder.Folders.Item(i).
Name);
end;
end;
// bessere Funktion zum Suchen von Zeichenfolgen
function pos2(dortsuchen, suchtext:
string; suchbeginn: integer) : integer;
var i, stelle:integer;
teiltext:
string;
begin
stelle := suchbeginn;
result := -1;
For i:=suchbeginn
To Length(dortsuchen)
do
begin
teiltext := AnsiMidStr(dortsuchen, i, Length(suchtext));
if (suchtext = teiltext)
then
begin
stelle := i;
result:=stelle;
break;
end;
end;
end;
// AnsiMidStr etwas umgemodelt
function stringbetween(input:
string; beginn, ende: integer):
string;
begin
result := AnsiMidStr(input, beginn, ende-beginn);
end;
// Test. ob der aktuelle Ordner zulässig ist.
function isInForbiddenList(
name:
string): boolean;
var i: integer;
begin
result := false;
for i := 0
To Length(forbiddenFolders)-1
do if forbiddenFolders[i] =
name then result := true;
end;
//Eine Angabe der Form "Ordner_1\Ordner_1_1\xy" in ["Ordner_1", "Ordner_1_1", "xy"] umwandeln.
procedure getFolderStrings(inputP:
string);
var i, beginn, ende: integer;
act_name, input:
string;
done: boolean;
begin
SetLength(folderStrings, 0);
done := false;
input := '
\' + inputP;
i := 1;
while not done
do
begin
beginn := pos2(input, '
\', i);
ende := pos2(input, '
\', beginn+1);
done := false;
if ende > 0
Then
begin
act_name := stringbetween(input, beginn+1, ende);
SetLength(folderStrings, Length(folderStrings)+1);
folderStrings[Length(folderStrings)-1] := act_name;
end;
i := ende;
if i > 10000
Then done := true;
if ende = -1
Then
begin
act_name := stringbetween(input, beginn+1, Length(input)+1);
SetLength(folderStrings, Length(folderStrings)+1);
folderStrings[Length(folderStrings)-1] := act_name;
done := true;
end;
end;
end;
//den aktuellen Ordner (Folder) wechseln, mmithilfe getFolderStrings
procedure changeFolder(absolut: boolean; path:
string);
var act_name, temp_name:
string;
i, k: integer;
changed: boolean;
begin
getFolderStrings(path);
i := 0;
if absolut
Then Folder := NmSpace.GetDefaultFolder(olPublicFoldersAllPublicFolders);
for i := 0
To Length(folderStrings)-1
do
begin
changed := false;
if folderStrings[i] = '
..'
Then
begin
Folder := (Folder.Parent
as MAPIFolder)
end
else
begin
for k := 1
To Folder.Folders.Count
do
begin
temp_name := Folder.Folders.Item(k).
Name;
if temp_name = folderStrings[i]
Then
begin
Folder := Folder.Folders.Item(k);
changed := true;
break;
end;
end;
if not changed
Then ShowMessage('
Ordner ''
' + FolderStrings[i] + '
''
nicht gefunden!');
end;
end;
end;
// Welche Art Mail ist es? Per Subject und ausgewählten Teilen aus dem Mail-Body entscheiden
function characterizeMail(input: TMail): integer;
var possibility1, possibility2, possibility3, best: integer;
begin
possibility1 := 0;
possibility2 := 0;
possibility3 := 0;
if pos2(stringbetween(input.subject, 1, 16), '
ESET LLC', 1) <> -1
Then possibility1 := possibility1 + 2;
if pos2(stringbetween(input.subject, 1, 16), '
ESET - NOD32', 1) <> -1
Then possibility2 := possibility2 + 2;
if pos2(stringbetween(input.subject, 1, 16), '
Registrierung NOD32', 1) <> -1
Then possibility3 := possibility3 + 2;
if pos2(stringbetween(input.body, 320, 500), '
TypeOf_License', 1) <> -1
Then possibility1 := possibility1 + 2;
if pos2(stringbetween(input.body, 85, 145), '
has been used to register', 1) <> -1
Then possibility2 := possibility2 + 2;
if pos2(stringbetween(input.body, 1, 50), '
Schritt:', 1) <> -1
Then possibility3 := possibility3 + 2;
if ( possibility1 = 4 )
or ( possibility2 = 4 )
or ( possibility3 = 4 )
Then
begin
if possibility1 = 4
Then result := 1;
if possibility2 = 4
Then result := 2;
if possibility3 = 4
Then result := 3;
end
else result := 4;
(*
Mail-Art 1 - Andere sind noch nicht eingebaut.
---------------------------------------------------
SUBJECT: ESET LLC Order - NOD32 Xxxxxxx Xxxx
--------------------------------------------------
ESET's Partner/Reseller: DATSEC, DEUTSCH
Thank you!
Your order, pursuant to the below specification was received and processed.
Please, double check the information received to ensure timeliness of our services and customers satisfaction.
UserName:Password=AV-626xxxx:xxxxxxxxx
PurchaseOption: License renewal (1 year update/upgrade)
TypeOfPlatform: NOD32 for Win9x/Me/NT/2000/XP/2003+DOS
TypeOf_License: 1
Clients_name: Xxxxxxx Xxxx
Contact_person: Xxxxxxx Xxxx
Clients_email: [email]xxxxxxxx@gmx.net[/email]
Clients_phone:
Expiration: 08/14/2008
Price: xx,xx
Servers: 0
Note:
*)
end;
// Leerzeichen Uund vllt auch noch was anderes löschen
function purgeString(input_P:
string):
string;
var input:
string;
begin
input := input_P;
input := StringReplace(input, '
', '
', [rfReplaceAll]);
Result := input;
//input := StringReplace(input, ' ', '', [rfReplaceAll]);
end;
// Aus einer Mail den Wert einer bestimmten Zeile lesen, zB bei obigem Beispiel:
// getValueOf(Beispiel.Body, 'Expiration', ':') = '08/14/2008'
function getValueOf(input_P,
name, separator:
string):
string;
var pos, nextbr, separatorpos: integer;
done: boolean;
input, line, tempName, value:
string;
begin
pos := 0;
input := input_P + #13#10;
done := false;
while not done
do
begin
nextbr := pos2(input, #13#10, pos);
if nextbr <> -1
Then
begin
line := stringbetween(input, pos, nextbr);
if pos2(line, separator, 1) <> -1
Then
begin
separatorpos := pos2(line, separator, 1);
tempName := purgeString(stringbetween(line, 1, separatorpos));
if ( LowerCase(tempName) = LowerCase(
name) )
or ( ( LowerCase(tempName)=LowerCase('
Nr.Servers') )
and ( LowerCase(
name) = LowerCase('
Servers') ) )
or ( ( LowerCase(tempName)=LowerCase('
Price(USD)') )
and ( LowerCase(
name) = LowerCase('
Price') ) )
Then
begin
value := stringbetween(line, separatorpos+1, Length(line)+1);
done := true;
end;
end;
end
else
begin
ShowMessage('
NICHT GEFUNDEN: ' + #13#10 + '
getValueOf: ' +
name + #13#10 + '
IN:' + #13#10 + input);
break;
end;
pos := nextbr+2;
end;
if done
Then result := value
else result := '
$$not found$$';
end;
//wandelt ein TMail in ein TDataSetLic1 um, mit getValueOf
function progressMail_1(input: TMail): TDataSetLic1;
var body, lic, licUser, licPass:
string;
begin
body := input.body;
result.PurchaseOption := getValueOf(body, '
PurchaseOption', '
:');
result.TypeOfPlatform := getValueOf(body, '
TypeOfPlatform', '
:');
result.TypeOf_License := getValueOf(body, '
TypeOf_License', '
:');
result.Clients_name := getValueOf(body, '
Clients_name', '
:');
result.Contact_person := getValueOf(body, '
Contact_person', '
:');
result.Clients_email := getValueOf(body, '
Clients_email', '
:');
result.Clients_phone := getValueOf(body, '
Clients_phone', '
:');
result.Expiration := getValueOf(body, '
Expiration', '
:');
result.Price := getValueOf(body, '
Price', '
:');
result.server := getValueOf(body, '
Servers', '
:');
result.note := getValueOf(body, '
Note', '
:');
lic := getValueOf(body, '
UserName:Password', '
=');
licUser := stringbetween(lic, 1, pos2(lic, '
:', 1));
licPass := getValueOf(lic, licUser, '
:');
licPass := StringReplace(licPass, #13, '
', [rfReplaceAll]);
licPass := StringReplace(licPass, #10, '
', [rfReplaceAll]);
result.license_user := licUser;
result.license_pass := licPass;
result.folder := input.folder;
result.art := '
not yet supported';
result.subject := input.subject;
result.from := input.from;
end;
//Statistiken
procedure printstatistics(folderLength, progress: integer);
var tick: integer;
timeFolder, timeAll: integer;
begin
tick := GetTickCount;
with Form1
do
begin
timeFolder := tick - st_timerFolder;
timeAll := tick - st_timerAll;
Label17.Caption := IntToStr(timeFolder
div 1000) + '
s';
Label18.Caption := IntToStr(timeAll
div 1000) + '
s';
Label19.Caption := IntToStr(st_counterFolder);
Label20.Caption := IntToStr(st_counterAll);
st_speedFolder := (st_counterFolder*1000) / (tick-st_timerFolder);
st_speedAll := (st_counterAll*1000) / (tick-st_timerAll);
Label15.Caption := FloatToStr(RoundTo(st_speedFolder, -2)) + '
M/s';
Label16.Caption := FloatToStr(RoundTo(st_speedAll, -2)) + '
M/s';
st_ETA := folderLength/st_speedFolder - progress/st_speedFolder;
Label23.Caption := FloatToStr(Round(st_ETA) ) + '
s';
end;
end;
//~~~~~~~~~~~~~~~~~~~~~
// HAUPTPROZEDUR
// REKURSIV - durchsucht alle Unterordner des aktuellen Folder (MAPIFolder)
//~~~~~~~~~~~~~~~~~~~~~
procedure getFolderMails(folderName:
string);
var i, modulo: integer;
tempmail: TMail;
//Lokale Statistik
stloc_mailcounter, stloc_mailcounter100, stloc_mailtime, stloc_mail100time: integer;
begin
TRY
//Statistik:
if start_global_timer
Then
begin
st_timerAll := GetTickCount;
start_global_timer := false;
end;
st_timerFolder := GetTickCount;
st_counterFolder := 0;
Form1.Label1.Caption := '
0 / ' + IntToStr(Folder.Items.Count);
Form1.ProgressBar1.Max := Folder.Items.Count;
Form1.ProgressBar1.Position := 0;
Form1.Label2.Caption := '
Processing: ';
Form1.Label4.Caption := '
Folder: ' + folderName;
Application.ProcessMessages;
//----
modulo := Folder.Items.Count
div 400;
if modulo < 4
Then modulo := 4;
for i := 1
To Folder.Items.Count
do
begin
//Statistik
stloc_mailtime := GetTickCount-stloc_mailcounter;
stloc_mailcounter := GetTickCount;
if st_counterFolder
mod 100 = 1
Then stloc_mailcounter100 := GetTickCount;
if st_counterFolder
mod 100 = 0
Then stloc_mail100time := GetTickCount-stloc_mailcounter100;
//Auslesen einer Mail, umwandeln von MailItem in TMail
try
tempmail.subject := (Folder.Items.Item(i)
as MailItem).Subject;
tempmail.from := (Folder.Items.Item(i)
as MailItem).SenderName;
tempmail.body := (Folder.Items.Item(i)
as MailItem).Body;
tempmail.folder := folderName;
tempmail.time := DateTimeToStr((Folder.Items.Item(i)
as MailItem).ReceivedTime);
except
Form1.Memo2.Lines.Add('
FOLDER: ' + folderName + '
: Fehler in Item ' + IntToStr(i));
end;
// Wenn sich herausstellt, dass die Mail Lizenzdaten enthält:
if characterizeMail(tempmail) = 1
Then
begin
//Statistik
inc(st_counterAll);
inc(st_counterFolder);
//Hinzufügen der Mail zu den anderen Daten
SetLength(licenseSet1, Length(licenseSet1)+1);
licenseSet1[High(licenseSet1)] := progressMail_1(tempmail);
// Fortschrittsausgabe
if i
mod modulo = 0
Then
begin
Form1.Label1.Caption := IntToStr(i)+ '
/ ' + IntToStr(Folder.Items.Count);
Form1.ProgressBar1.Position := i;
Form1.Label3.Caption := IntToStr(Round((i*100)/Folder.Items.Count)) + '
%';
Application.ProcessMessages;
Form1.Label2.Caption := '
Processing: ' + licenseSet1[High(licenseSet1)].license_user
+ '
<-> ' + licenseSet1[High(licenseSet1)].license_pass + '
| ' + licenseSet1[High(licenseSet1)].Clients_name;
printstatistics(Folder.Items.Count, st_counterFolder);
Form1.Label21.Caption := IntToStr(stloc_mailtime) + '
ms';
Form1.Label22.Caption := IntToStr(stloc_mail100time
div 1000) + '
s';
end;
end;
end;
Form1.Label1.Caption := IntToStr(i-1)+ '
/ ' + IntToStr(Folder.Items.Count);
Form1.ProgressBar1.Position := i-1;
// Nachdem alle Mails aus dem Ordner ausgelesen wurden, werden
// nun die Unterordner rekursiv durchsucht
for i:=1
To Folder.Folders.Count
do
begin
if not isInForbiddenList(Folder.Folders.Item(i).
Name)
Then
begin
Folder := Folder.Folders.Item(i);
getFolderMails(folderName + '
\' + Folder.
Name);
Folder := (Folder.Parent
as MAPIFolder);
end;
end;
EXCEPT
//Fehlermeldung, wahrscheinlich Out Of Memory
//Diese Daten vom letzten Abschnitt stehen unten
on E:SysUtils.Exception
do
begin
Form1.Memo1.Lines.Add('
OOMemory!');
Form1.Memo1.Lines.Add('
Folder: ' + folderName);
Form1.Memo1.Lines.Add('
Step: ' + IntToStr(st_counterFolder));
Form1.Memo1.Lines.Add('
Array: ' + IntToStr(Length(licenseSet1)) + '
Felder');
Form1.Memo1.Lines.Add('
Exception: ' + E.
Message + '
| ' + E.ClassName);
Form1.Memo1.Lines.Add('
############');
Form1.Memo1.Lines.Add('
EXCEPTION');
Form1.Memo1.Lines.Add('
#Ergebnisse:#');
Form1.Memo1.Lines.Add('
############');
Form1.Memo1.Lines.Add(IntToStr(st_counterAll) + '
Datensätze');
Form1.Memo1.Lines.Add(IntToStr(GetTickCount-st_timerAll) + '
millisekunden');
Form1.Memo1.Lines.SaveToFile('
C:\log' + IntToStr(Random(4000)) + '
.txt');
end;
END;
end;
//Testbereich ausklappen
procedure TForm1.Button1Click(Sender: TObject);
begin
if testbereich
then testbereich := false
else testbereich := true;
if testbereich
then
begin
Form1.Height := 860;
GroupBox1.Visible := true;
end
else
begin
Form1.Height := 660;
GroupBox1.Visible := false;;
end;
end;
// Testbutton
procedure TForm1.Button3Click(Sender: TObject);
var i: integer;
begin
(*getFolderStrings('Datsec\Einrichtung');
Memo1.Lines.Clear;
For i := 0 To Length(folderStrings)-1 do Memo1.Lines.Add(folderStrings[i]);*)
listFolder(Memo1.Lines);
end;
// gesamtes Auslesen starten!
procedure TForm1.Button2Click(Sender: TObject);
begin
start_global_timer := true;
st_counterAll := 0;
// Folder auswählen
changeFolder(true, '
_Zugangsdaten');
getFolderMails(Folder.
Name);
//Statistik
Memo1.Lines.Add('
############');
Memo1.Lines.Add('
Ende');
Memo1.Lines.Add('
#Ergebnisse:#');
Memo1.Lines.Add('
############');
Memo1.Lines.Add(IntToStr(st_counterAll) + '
Datensätze');
Memo1.Lines.Add(IntToStr(GetTickCount-st_timerAll) + '
millisekunden');
Memo1.Lines.SaveToFile('
C:\log' + IntToStr(Random(4000)) + '
.txt');
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
//changeFolder(true, Edit2.Text);
listFolder(Memo1.Lines);
end;
procedure TForm1.Button5Click(Sender: TObject);
var testmail: TMail;
begin
(*testmail.body := Memo1.Text;
testmail.subject := Edit4.Text;
Edit3.Text := IntToStr(characterizeMail(testmail));*)
//ShowMessage(IntToStr(pos2(Memo1.Text, #13#10, 1)));
//ShowMessage('|' + getValueOf(Memo1.Text, Edit3.Text, ':') + '|');
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
testbereich := false;
if testbereich
then
begin
Form1.Height := 860;
GroupBox1.Visible := true;
end
else
begin
Form1.Height := 660;
GroupBox1.Visible := false;;
end;
anz_liz1 := 0;
SetLength(forbiddenFolders, 30);
forbiddenFolders[0] := '
NFR';
forbiddenFolders[1] := '
reseller';
forbiddenFolders[2] := '
ct_renewal';
forbiddenFolders[3] := '
xxxxxxxxxxxxx';
forbiddenFolders[4] := '
xxxxx';
forbiddenFolders[5] := '
';
forbiddenFolders[6] := '
unklar';
forbiddenFolders[7] := '
Zugangsdaten_defekt';
forbiddenFolders[8] := '
Zugangsdaten_gesperrt';
forbiddenFolders[9] := '
';
forbiddenFolders[10] := '
';
forbiddenFolders[11] := '
';
forbiddenFolders[12] := '
';
forbiddenFolders[13] := '
';
forbiddenFolders[14] := '
';
forbiddenFolders[15] := '
';
forbiddenFolders[16] := '
';
forbiddenFolders[17] := '
';
forbiddenFolders[18] := '
';
forbiddenFolders[19] := '
';
initializeOutlookAccess;
end;
end.