function GetNamePart(
const s:
string):
string;
var
I: integer;
begin
Result:= '
';
for I:= 1
to Length(S)
do
if S[I] = '
@'
then
begin
Result:= Copy(S, 1, I-1);
Break;
end;
end;
function GetDomainPart(
const s:
string):
string;
var
I: integer;
begin
Result:= '
';
for I:= 1
to Length(S)
do
if S[I] = '
@'
then
begin
Result:= Copy(S, I+1, Length(S)-I);
Break;
end;
end;
procedure QuickSort(
const Strings: TStrings; L, R: Integer);
var
I, J, K: Integer;
P:
string;
begin
repeat
I:= L;
J:= R;
K:= (L + R)
shr 1;
P:= AnsiLowerCase(Trim(Strings[K]));
repeat
while AnsiLowerCase(Trim(Strings[I])) < P
do Inc(I);
while AnsiLowerCase(Trim(Strings[J])) > P
do Dec(J);
if I <= J
then
begin
Strings.Exchange(I, J);
Inc(I);
Dec(J);
end;
until I > J;
if L < J
then QuickSort(Strings, L, J);
L:= I;
until I >= R;
end;
procedure EMailAddressesSort(
const Strings: TStrings;
const SortByDomain: boolean = false);
var
I, J: integer;
T1, T2, D1, D2:
string;
ExChange: boolean;
begin
Strings.BeginUpdate;
if not SortByDomain
then
QuickSort(Strings, 0, Strings.Count-1)
else
begin
for I:= 0
to Strings.Count-2
do
for J:= I+1
to Strings.Count-1
do
begin
T1:= AnsiLowerCase(Trim(Strings[I]));
T2:= AnsiLowerCase(Trim(Strings[J]));
ExChange:= false;
if T1 > T2
then
ExChange:= true
else
begin
D1:= GetDomainPart(T1);
D2:= GetDomainPart(T2);
if D1 > D2
then
ExChange:= true
else
if D1 = D2
then
if GetNamePart(T1) > GetNamePart(T2)
then ExChange:= true;
end;
if ExChange
then Strings.Exchange(I,J);
end;
end;
Strings.EndUpdate;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
SL: TStringList;
begin
SL:= TStringList.Create;
SL.Assign(Memo1.Lines);
EmailAddressesSort(SL);
Memo1.Lines.Assign(SL);
SL.Free;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
EmailAddressesSort(Memo1.Lines);
end;