delphi4arab منتديات دلفي للعرب

السلام عليكم اخواني الكرام Smile

واجهت صعوبة في انشاء برنامج فيه Memo1 مليءة بالاميلات [Emails] و كل ايمايل في سطر اي ليس هناك ايمايلان Big Grin

في سطر واحد
وهده الاميلات متنوعة اي توجد ايمايلات هوتمايل و جي مايل و ياهوو
و عند الضغط على الزر تفرق الايمايلات حسب نوعها اي ايمايلات ال هوتمايل تدهب الى Memo2 و ايميلات ال جي مايل تذهب الى Memo3 و ايمايلات ال ياهوو تدهب الى Memo4
فكرة البرنامج هي معاينة الايمايل في كل سطر و رؤية ما حو موجود بعد رمز "@"
جزاكم الله خيرا يا اخواني

وعليكم السلام
هذا تطبيق لكلامك

PHP كود :
procedure TForm1.Button1Click(Sender: TObject);
function GetMailType(Mail: string): Integer;
const
  MailArr: array[1..3] of string = ('hotm4il.com', 'gm4il.com', 'ym4il.com');
var
  I: Integer;
  ExHost: string;
begin
  Result := 0;
  ExHost := Copy(Mail, Pos('@', Mail) + Length('@'), Length(Mail));
  for I := 1 to 3 do
  begin
    if MailArr[I] = ExHost then
    begin
      Result := I;
      Break;
    end;
  end;
end;
var
  I: Integer;
begin
  for I := 0 to Memo1.Lines.Count -1 do
  begin
    case GetMailType(Memo1.Lines[I]) of
      1: Memo2.Lines.Add(Memo1.Lines[I]);
      2: Memo3.Lines.Add(Memo1.Lines[I]);
      3: Memo4.Lines.Add(Memo1.Lines[I]);
    end;
  end;
end; 

بالتوفيق

شكرااا يا أخي Ghost-Dz الكود يعمل 100%
جزااك الله خيراا و أنار طريقك Smile

هل توجد هناك طريقة يا أخي الكريم لعدم مقارنة هل الايمايل .com او .fr او .dz ...
فقط مقارنة هل هو Hom4il او gm4il الخ بدون ال .com .fr الخ
لاني جربت نفس السورس و مسحت .com في ال Array للهوتمايل لاكن لم يعمل و شكراا جزيلا ^_^

السلام عليكم
جرب هذا الحل

PHP كود :
procedure TForm1.Button1Click(Sender: TObject);
var
  I, Index: Integer;
  TmpStr: String;
begin
  Index  := -1;
  TmpStr := '';
  for I := 0 to memoGeneral.Lines.Count -1 do
    begin
      TmpStr := UpperCase(memoGeneral.Lines[i]);
      TmpStr := Copy(TmpStr, LastDelimiter('@', TmpStr) + 1, LastDelimiter('.', TmpStr) - LastDelimiter('@', TmpStr) -1);
      if TmpStr = '*******' then
       memo*******.Lines.Add(memoGeneral.Lines[i]);
      if TmpStr = '*****' then
        memo*****.Lines.Add(memoGeneral.Lines[i]);
      if TmpStr = '*****' then
        memo*****.Lines.Add(memoGeneral.Lines[i]);
    end;
end; 

هذا مثال أخي S.FATEH بارك الله فيه
إضافة else لدوران مباشرة عند تساوي

PHP كود :
var
  I: Integer;
  TmpStr: String;
begin
  for I := 0 to Memo1.Lines.Count -1 do
    begin
      TmpStr := UpperCase(Memo1.Lines[i]);
      TmpStr := Copy(TmpStr, Pos('@', TmpStr) + 1, Pos('.', TmpStr) - Pos('@', TmpStr) - 1);
      if TmpStr = 'HOTM4IL' then
        Memo2.Lines.Add(Memo1.Lines[i])
      else
      if TmpStr = 'GM4IL' then
        Memo3.Lines.Add(Memo1.Lines[i])
      else
      if TmpStr = 'YM4IL' then
        Memo4.Lines.Add(Memo1.Lines[i]);
    end;
end; 

أو

PHP كود :
function GetMailType(Mail: string): Integer;
const
  HostArr: array[1..3] of string = ('hotm4il', 'gm4il', 'ym4il');
var
  I: Integer;
  HostEx: string;
  P1, P2: Integer;
begin
  Result := 0;
  P1 := Pos('@', Mail) + Length('@');
  P2 := Pos('.', Mail);
  HostEx := Copy(Mail, P1, P2 - P1);
  for I := 1 to 3 do
  begin
    if HostArr[I] = HostEx then
    begin
      Result := I;
      Break;
    end;
  end;
end;

var
  I: Integer;
begin
  for I := 0 to Memo1.Lines.Count -1 do
  begin
    case GetMailType(Memo1.Lines[I]) of
      1: Memo2.Lines.Add(Memo1.Lines[I]);
      2: Memo3.Lines.Add(Memo1.Lines[I]);
      3: Memo4.Lines.Add(Memo1.Lines[I]);
    end;
  end;
end; 

شكرا جزيلا لكم جزاكم الله خيرا يا اخواني ^_^

TheGame

Agmcz

TheGame

TheGame

S.FATEH

Agmcz

TheGame