type
  {unit1に押し込むなら TForm1 = class(TForm) のすぐ上あたり。
  隔離unitを別に誂えるなら、interface uses のすぐ下あたり、かな}
  TBSMTPStatus = record
    Counter: integer;
    Status : array[0..255] of LPSTR;
  end;
  TPBSMTPStatus = ^TBSMTPStatus;



{↓API関数はどこに書くのが正しいのか、実は知らない(そんなことよりこれはAPIじゃないだろ)}
function BSendMail(szServer, szTo, szFrom, szSubject, szBody, szFile: LPCSTR;
                    msg: LPSTR): integer; cdecl external 'Bsmtp.dll';
function BMIME(szCommand, szFileName, szPath: LPCSTR;
                Status: TPBSMTPStatus; msg:
                LPSTR):integer; cdecl external 'Bsmtp.dll';
function BPOP3(szServer, szName, szPass, szCommand, szPath: LPCSTR;
                Status: TPBSMTPStatus;
                msg: LPSTR): integer; cdecl external 'Bsmtp.dll';
procedure BFreeArray(Status: TPBSMTPStatus); cdecl external 'Bsmtp.dll';
{隔離unitの場合は implementation のすぐ下、Form付随unitの場合は $R *.dfm の下あたりでいいんじゃなかろうか。
以前はもっと上のほう、他の自作関数の宣言と混ぜてAPI関数を書いてたけど、それでもちゃんと動いてたような気がする。
さらに思い出してみると、入れ子関数の子供として書いたこともあるような気がする。
要は使う場所より上に書いてあれば、というか、使う場所から参照可能なところなら、どこでもいいんじゃね}

var
  MySTBPOP3: TPBSMTPStatus;
  MyWKSTR: array[0..80] of Char;
  MyRtn: integer;
begin
  New(MySTBPOP3); {←これ忘れないで}

  MyRtn:=BPOP3(PChar('POP3文字列'),
              PChar('ユーザーネーム文字列'),
              PChar('パスワード文字列'),
              PChar('SAVEALLD'),
              PChar('受信したメールの保存先(ディレクトリ)文字列'),
              MySTBPOP3, MyWKSTR);

  BFreeArray(MySTBPOP3); {←これも忘れないで}
end;

var
  MyWKSTR: array[0..80] of Char;
  MyRtn: integer;
begin
  MyRtn:=BSendMail(PChar('SMTP文字列'),
                  PChar('送り先アドレス文字列'),
                  PChar('送り主アドレス文字列'),
                  PChar('タイトル文字列'),
                  PChar('本文文字列'),
                  PChar('添付ファイルのフルパス文字列'),
                  MyWKSTR);
end;

function GetCntFiles(strDir: string): integer; {フォルダ内のファイル数をカウントする関数}
var
  MySrc: TSearchRec;
  MyCnt: integer;
begin
  MyCnt:=0;
  if FindFirst(strDir + '\*.*', faAnyFile, MySrc)=0 then begin
    try
      repeat
        if (MySrc.Name<>'.') and (MySrc.Name<>'..') then begin
          MyCnt:=MyCnt + 1;
        end;
      until FindNext(MySrc)<>0;
    finally
      FindClose(MySrc);
    end;
  end;
  Result:=MyCnt;
end;

function GetStrMailAddress(strF: string): string; 
{ある文字列 strF から、メールアドレスと思われる文字列を取り出したうえ、
それが複数あった場合は適当な記号で区切ったカタチにして返す関数(usesにComObjを加える必要あり)}
const
  cMLDLMTR='   '; {区切り記号。完全にテキトーでいい。この記号は、後々場面に応じて別の記号に置換されるという想定なので}
  cPATMLSVR='([\w_\-]+)\.([\w_\.\-]*)[a-z][a-z]';
  cPATMLADR='([\w]+)([\w\.-]+)@' + cPATMLSVR;
var
  MyStrF, MyStrR: string;
  MyRegExp, MyMatch: OleVariant;
  MyCnt, MyInc: integer;
begin
  MyStrF:=AnsiReplaceStr(strF, '"', '');
  MyRegExp:=CreateOleObject ('VBScript.RegExp');
  MyRegExp.Pattern:=cPATMLADR;
  MyRegExp.Global:=true;
  MyRegExp.IgnoreCase:=true;
  MyMatch:=MyRegExp.Execute(MyStrF);
  MyCnt:=MyMatch.Count;
  MyStrR:='';
  for MyInc:=0 to MyCnt-1 do begin
    MyStrR:=MyStrR + MyMatch.Item[MyInc].Value + cMLDLMTR;
  end;
  MyMatch:=Unassigned;
  MyRegExp:=Unassigned;
  MyStrR:=TrimRight(MyStrR);
  Result:=MyStrR;
end;

  if ヘッダ取得に成功したら then begin
    for i:=0 to ヘッダ中の区画みたいなものの数-1 do begin
      〜区画ごとに、本当に欲しいものの取得処理〜
    end;
  end;

procedure GetMLHData(strFile: string; var strDt, strTo, strFrom, strSbj, strCc: string);
const
  cHDATA: array[1..5] of string=('date: ', 'to: ', 'from: ', 'subject: ', 'cc: ');
var
  MyStrLine: string; {ここですでに「行」っぽい意味というか雰囲気を漂わせた変数名にしちゃってる}
  MyStrHData: array[1..5] of string;
  MyIncL, MyIncH: integer;
  MySTBMIME: TPBSMTPStatus;
  MyChrArr: array[0..80] of Char;
begin
  for MyIncH:=1 to 5 do begin
    MyStrHData[MyIncH]:=''; {どうでもいいけど初期値は全部空文字}
  end;

  New(MySTBMIME);

  if BMIME(PChar('HEAD'), PChar(strFile), PChar('C:\'), MySTBMIME, MyChrArr)>=1 then begin
    {ヘッダ取得。
    とりあえず「日付時刻、宛先、差出人、タイトル、cc文字列」を取りたいだけ。
    本文と添付ファイルについては、ここでは相手にするつもりはないので、
    展開先ディレクトリは、デタラメ'C:\'で決め打ち。
    実際に展開は行われないんだから、デタラメどころか空文字でもいいんじゃないか
    と思ったけど、ちゃんと存在するディレクトリでなきゃダメらしい}

    for MyIncL:=0 to MySTBMIME.Counter-1 do begin
      MyStrLine:=MySTBMIME.Status[MyIncL]; {1行ずつとっては、その文字列を精査}
      for MyIncH:=1 to 5 do begin
        if LowerCase(LeftStr(MyStrLine, Length(cHDATA[MyIncH])))=cHDATA[MyIncH] then begin
          {頭の6文字が'date: 'ならばそこは日付時刻の行、
          頭の4文字が'to: 'ならそこは宛先の行、という調子で}

          if (MyIncH=2) or (MyIncH=3) or (MyIncH=5) then begin
            MyStrHData[MyIncH]:=GetStrMailAddress(MyStrLine);
            {宛名、差出人、cc の行では、アドレス抜き出し関数を使用。
            ぐちゃぐちゃの状態からアドレスだけ取り出し、 後々使いやすいように
            区切り記号を使ってキレイに並べた形にしておく}
          end else begin
            MyStrHData[MyIncH]:=Trim(AnsiReplaceText(MyStrLine, cHDATA[MyIncH], ''));
            {日付時刻、タイトルの行は、頭の数文字を削るだけで、
            求めているデータの形になる(はず。たぶん)}
          end;
        end;
      end;
    end;
  end;

  BFreeArray(MySTBMIME);

  strDt:=MyStrHData[1];
  strTo:=MyStrHData[2];
  strFrom:=MyStrHData[3];
  strSbj:=MyStrHData[4];
  strCc:=MyStrHData[5];
end;

var
  MySrc: TSearchRec;
  MyStrM: array[0..5] of string; {0:ファイル名; 1:日付時刻; 2:宛先; 3:差出人; 4:タイトル; 5:Cc}
begin
  if FindFirst(strDir + '\*.txt', faAnyFile, MySrc)=0 then begin
    {保存されているフォルダの中を探し回って、全てのメールファイルをGetMLHData関数に通す}
    try
      repeat
        MyStrM[0]:=strDir + '\' + MySrc.Name;
        GetMLHData(MyStrM[0], MyStrM[1], MyStrM[2], MyStrM[3], MyStrM[4], MyStrM[5]);
        {な感じで取得したデータ、〜 MyStrM[5]を、適当なグリッドにぺたぺた貼り付けてみたり}

      until FindNext(MySrc)<>0;
    finally
      FindClose(MySrc);
    end;
  end;
end;

function TForm1.GetStrMLBody(strFile: string): string;
var
  MyFSO: OleVariant;
  MySTBMIME: TPBSMTPStatus;
  MyChrArr: array[0..80] of Char;
  MyStrTmpDir, MyStrALL, MyStrHdr, MyStrBody: string;
  MyCntAFiles, MyIntMax, MyInc: integer;
begin
  Result:='';

  MyStrTmpDir:=pbVarAppExePath + 'tmpML';
  {添付ファイルの展開場所(そのたびごとに削除生成)
  添付とtempをかけたわけじゃないぞ。たまたまだぞ}
  MyFSO:=CreateOleObject('Scripting.FileSystemObject');
  if MyFSO.FolderExists(MyStrTmpDir)=true then begin
    MyFSO.DeleteFolder(MyStrTmpDir);
  end;
  MyFSO.CreateFolder(MyStrTmpDir);
  MyFSO:=Unassigned;

  New(MySTBMIME); {添付ファイルを指定した場所に展開}
  BMIME('GET', PChar(strFile), PChar(MyStrTmpDir), MySTBMIME, MyChrArr);
  BFreeArray(MySTBMIME);

  MyCntAFiles:=GetCntFiles(MyStrTmpDir); {展開して得られた添付ファイルの数}

  MyStrHdr:='';
  New(MySTBMIME);
  {ヘッダの全文字取得
  ここでは、日付だのアドレスなんてものはどうでもいい
  欲しいのはヘッダの文字数}
  if BMIME(PChar('HEAD'), PChar(strFile), PChar(MyStrTmpDir), MySTBMIME, MyChrArr)>=1 then begin
    MyIntMax:=MySTBMIME.Counter - MyCntAFiles - 2;
    for MyInc:=0 to MyIntMax do begin
      {このループカウントMAX値はまったく不可解。
      本当は-2じゃなく-1の気がするんだけど、
      それだとヘッダがいっぱい取れすぎ。
      次の処理で全文からこのヘッダの文字数を引くと、本文のアタマが少し切れる。
      だからといって-2にすると、次の処理で本文のアタマに少し余計な文字が付く}

      MyStrHdr:=MyStrHdr + MySTBMIME.Status[MyInc];
    end;
  end;
  BFreeArray(MySTBMIME);
  if MyStrHdr='' then begin
    exit;
  end;

  MyStrALL:='';
  New(MySTBMIME); {ヘッダ+本文の全文字取得}
  if BMIME('GETNOF', PChar(strFile), PChar(MyStrTmpDir), MySTBMIME, MyChrArr)>=1 then begin
    MyIntMax:=MySTBMIME.Counter - MyCntAFiles - 1;
    for MyInc:=0 to MyIntMax do begin
      MyStrALL:=MyStrALL + MySTBMIME.Status[MyInc];
    end;
  end;
  BFreeArray(MySTBMIME);
  if MyStrALL='' then begin
    exit;
  end;

  MyStrBody:=RightBStr(MyStrALL, Length(MyStrALL) - Length(MyStrHdr));
  {取得した全文からヘッダの文字数分けずる
  (でもそれだけだと前述した通り本文のアタマに余計な文字が付く)}

  MyStrBody:=TrimLeft(MyStrBody);
  if LowerCase(LeftBStr(MyStrBody, 8))='x-uidl: ' then begin
    MyStrBody:=RightBStr(MyStrBody, Length(MyStrBody) - 41);
  end;
  MyStrBody:=TrimLeft(MyStrBody);
  if LowerCase(LeftBStr(MyStrBody, 6))='body: ' then begin
    MyStrBody:=RightBStr(MyStrBody, Length(MyStrBody) - 6);
  end;
  MyStrBody:=TrimLeft(MyStrBody);
  {仕方ないから、ちまちま削ってもっともらしく形を整える}
  Result:=MyStrBody;
end;

var
  MySTBPOP3: TPBSMTPStatus;
  MyWKSTR: array[0..80] of Char;
  MyInc: integer;
  MyStrFile: string;
begin
  New(MySTBPOP3);

  if BPOP3(PChar('POP3文字列'),
              PChar('ユーザーネーム文字列'),
              PChar('パスワード文字列'),
              PChar('SAVEALLD'),
              PChar('受信したメールの保存先(ディレクトリ)文字列'),
              MySTBPOP3, MyWKSTR)>=1 then begin

    for MyInc:=0 to MySTBPOP3.Counter-1 do begin
      MyStrFile:=MySTBPOP3.Status[MyInc]; {←これでファイル名が取れる}

      {ファイル名さえ取れればあとは何でもできる}
    end;
  end;

  BFreeArray(MySTBPOP3);
end;