DelFusa Blog 総本山

プログラミングの話題とかです。

NEW | PAGE-SELECT | NEXT

≫ EDIT

スポンサーサイト

上記の広告は1ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。

| スポンサー広告 | --:-- | comments(-) | trackbacks(-) | TOP↑

≫ EDIT

メールアドレス分解


               
      ∧,,∧___   ガガ ト
    /ミ,,゚Д゚ミ/|
    | ̄∪∪ ̄| |   タマネギ ノ ヒ
    |____|/  
     ,,,,∪∪,,, ,,



メール送付関数というか、クラスはこんな感じですかね。


…といっても、DFLibrary(DelFusaLibrary)を
使いまくってしまっておりますが・・・

TStringSplitterは、指定文字で文字列を分解してアクセスするクラスで
TrimCharは、指定したCharでトリムする関数です。

うーん、近いうちにどこかで公開しておかないと。
SVNリポジトリ形式がいいかな。



{---------------------------------------
  メールアドレス文字列のチェックと値の取得
機能: CheckMailNameAddressText
      「"氏名" 」という文字列かどうかチェック
    CheckMailNameAddressListText
      「"氏名" , "氏名" 」という文字列かどうかチェック
    GetMailNameAddressFromText
      「"氏名" 」から名前とメールアドレス取得
    GetMailNameAddressArrayFromListText
      「"氏名" , "氏名" 」から名前とアドレスの配列取得
備考:
履歴: 2011/06/30(木)
    ・ 作成
}//(*-----------------------------------

function CheckMailNameAddressText(s: String): Boolean;
var
 Splitter: TStringSplitter;
begin
 Result := False;

 Splitter := TStringSplitter.Create(
  s, [DoubleQuote+'<', DoubleQuote+Space+'<'], dmDelimiterExactly); try
 if Splitter.Count <> 2 then Exit;

 if not IsFirstStr(Splitter.Words[0], DoubleQuote) then Exit;
 if not IsLastStr(Splitter.Words[1], '>') then Exit;
 if InStr('>', ExcludeLastStr(Splitter.Words[1], '>')) then Exit;
 if not InStr('@', Splitter.Words[1]) then Exit;

 finally Splitter.Free; end;
 Result := True;
end;

function CheckMailNameAddressListText(s: String): Boolean;
var
 Splitter: TStringSplitter;
 I: Integer;
begin
 Result := False;

 Splitter := TStringSplitter.Create(
  TrimLastChar(s, Comma+Space), [Comma+Space, Comma, Semicolon+Space, Semicolon], dmDelimiterExactly); try
 for I := 0 to Splitter.Count - 1 do
 begin
  if not CheckMailNameAddressText(Splitter.Words[I]) then Exit;
 end;
 finally Splitter.Free; end;
 Result := True;
end;

function GetMailNameAddressFromText(s: String): TMailNameAddress;
var
 Splitter: TStringSplitter;
begin
 if CheckMailNameAddressText(s)=False then
  Assert(False, 'Error:GetMailNameAddressFromText');

 Result.Name := '';
 Result.Address := '';

 Splitter := TStringSplitter.Create(
  s, [DoubleQuote+'<', DoubleQuote+Space+'<'], dmDelimiterExactly); try

 Result.Name := ExcludeFirstStr(Splitter.Words[0], DoubleQuote);
 Result.Address := ExcludeLastStr(Splitter.Words[1], '>');

 finally Splitter.Free; end;
end;

function GetMailNameAddressArrayFromListText(s: String): TMailNameAddressArray;
var
 Splitter: TStringSplitter;
 I: Integer;
begin
 if CheckMailNameAddressListText(s)=False then
  Assert(False, 'Error:GetMailNameAddressArrayFromListText');

  Splitter := TStringSplitter.Create(
   TrimLastChar(s, Comma+Space), [Comma+Space, Comma, Semicolon+Space, Semicolon], dmDelimiterExactly); try
  SetLength(Result, Splitter.Count);
  for I := 0 to Splitter.Count - 1 do
  begin
   Result[I] := GetMailNameAddressFromText(Splitter.Words[I]);
  end;

  finally Splitter.Free; end;
end;
//------------------------------------*)

procedure TDataModule_SendMail.IdMessage_InitializeISO(var VHeaderEncoding: Char; var VCharSet: string);
begin
 VHeaderEncoding := 'B';
 VCharSet := 'UTF-8';
end;


procedure TDataModule_SendMail.SendMailUsingGMailEx(
SMTP_UserName, SMTP_Password,
To_MailListText,
CC_MailListText, BCC_MailListText,
From_Name, From_MailAddress,
Mail_Subject, Mail_Body: String);
var
 SMTP: TIdSMTP;
 SSL: TIdSSLIOHandlerSocketOpenSSL;
 Msg : TIdMessage;
 To_MailArray, CC_MailArray, BCC_MailArray: TMailNameAddressArray;
 I: Integer;
 EMailAddressItem: TIdEMailAddressItem;
begin
 SMTP := TIdSMTP.Create(nil);
 try
  SMTP.Host := 'smtp.gmail.com';
  SMTP.Port := 587;
  SMTP.Username := SMTP_UserName;
  SMTP.Password := SMTP_Password;
  SSL := TIdSSLIOHandlerSocketOpenSSL.Create;
  try
   SSL.Host := SMTP.Host;
   SSL.Port := SMTP.Port;
   SSL.Destination := SSL.Host + ':' + IntToStr(SSL.Port);
   SMTP.IOHandler := SSL;
   SMTP.UseTLS := utUseExplicitTLS;
   SMTP.Connect;
   Msg := TIdMessage.Create(SMTP);
   try
    Msg.OnInitializeISO := IdMessage_InitializeISO;
    Msg.ContentType := 'text/plain';
    Msg.CharSet := 'UTF-8';
    Msg.ContentTransferEncoding := 'BASE64'; // BASE64 (7bit)
   //Msg.ContentTransferEncoding := '8bit'; // RAW(8bit)
    Msg.From.Name := From_Name;
    Msg.From.Address := From_MailAddress;
// Msg.Recipients.EMailAddresses := To_MailAddress;

    if CheckMailNameAddressListText(To_MailListText) then
     To_MailArray := GetMailNameAddressArrayFromListText(To_MailListText);
     for I := 0 to Length(To_MailArray)-1 do
     begin
      EMailAddressItem := Msg.Recipients.Add;
      EMailAddressItem.Name := To_MailArray[I].Name;
      EMailAddressItem.Address := To_MailArray[I].Address;
     end;

    if (TrimChar(CC_MailListText, Comma+Space)<>EmptyStr)
    and (CheckMailNameAddressListText(CC_MailListText)) then
     CC_MailArray := GetMailNameAddressArrayFromListText(CC_MailListText);
     for I := 0 to Length(CC_MailArray)-1 do
     begin
      EMailAddressItem := Msg.CCList.Add;
      EMailAddressItem.Name := CC_MailArray[I].Name;
      EMailAddressItem.Address := CC_MailArray[I].Address;
     end;

    if (TrimChar(BCC_MailListText, Comma+Space)<>EmptyStr)
    and (CheckMailNameAddressListText(BCC_MailListText)) then
     BCC_MailArray := GetMailNameAddressArrayFromListText(BCC_MailListText);
     for I := 0 to Length(BCC_MailArray)-1 do
     begin
      EMailAddressItem := Msg.BCCList.Add;
      EMailAddressItem.Name := BCC_MailArray[I].Name;
      EMailAddressItem.Address := BCC_MailArray[I].Address;
     end;


    Msg.Subject := Mail_Subject;
    Msg.Body.Text := Mail_Body;
    SMTP.Send(Msg);
   finally
    Msg.Free;
   end;
   SMTP.Disconnect;
  finally
   SSL.Free;
  end;
 finally
  SMTP.Free;
 end;
end;

スポンサーサイト

| 未分類 | 12:54 | comments:1 | trackbacks(-) | TOP↑

COMMENT

添付ファイルを送るには

2011-06-29 - au2010の日記
http://d.hatena.ne.jp/au2010/20110629

こちらが参考になりそうです。

| ミ・д・彡 | 2011/07/26 11:02 | URL | ≫ EDIT















非公開コメント

PREV | PAGE-SELECT | NEXT

上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。