www.pudn.com > mail104s.lzh > SMTPSEND.PAS


 
//////////////////////////////////////////////////////////////////////// 
// SMTP X-Sender V 1.0 
// It is refer to the [The Internet Application with Delphi 2.0] 
// Author      : Yhe Jehn Shan 
// Date        : 96 / 07 /20 
// Modify      : 96 / 08 /02 
// Last        : 96 / 08 /13 
//////////////////////////////////////////////////////////////////////// 
 
unit smtpsend; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
  StdCtrls, Buttons, ComCtrls, ExtCtrls, NWinsock,INSocket, DBCtrls, DB, 
  DBTables, Grids, DBGrids, Menus,EmBade,uucp; 
 
{ Declare new Message for windows socket stream mode } 
type 
  TSMTPDialog = class(TForm) 
    Panel1: TPanel; 
    StatusBar1: TStatusBar; 
    Panel2: TPanel; 
    Label1: TLabel; 
    Edit1: TEdit; 
    Label2: TLabel; 
    Edit2: TEdit; 
    Label3: TLabel; 
    Edit3: TEdit; 
    BitBtn1: TBitBtn; 
    Label4: TLabel; 
    Edit4: TEdit; 
    Label5: TLabel; 
    Edit5: TEdit; 
    BitBtn2: TBitBtn; 
    Label6: TLabel; 
    PopupMenu1: TPopupMenu; 
    LoadFile: TMenuItem; 
    OpenDialog1: TOpenDialog; 
    EmbadeFile: TMenuItem; 
    Memo1: TMemo; 
    BitBtn3: TBitBtn; 
    ComboBox1: TComboBox; 
    Memo2: TRichEdit; 
 
    procedure FormCreate(Sender: TObject); 
    Procedure HostLookup; 
    procedure BitBtn1Click(Sender: TObject); 
    procedure HostConnect; 
    procedure HostReceive; 
    procedure HostSend; 
    procedure FormDestroy(Sender: TObject); 
    {procedure EmptyBuffer(Ptr:pchar;Len:Integer);} 
    Procedure HostWelcome; 
    procedure HostHelo; 
    procedure HostMailFrom; 
    procedure HostRcptTo; 
    procedure HostData; 
    procedure HostQuit; 
    procedure SendMsgHeader; 
    procedure SendMsgText; 
    procedure BitBtn2Click(Sender: TObject); 
    procedure LoadFileClick(Sender: TObject); 
    procedure EmbadeFileClick(Sender: TObject); 
    procedure FormActivate(Sender: TObject); 
    procedure FormShow(Sender: TObject); 
    procedure ComboBox1Click(Sender: TObject); 
    procedure FormClose(Sender: TObject; var Action: TCloseAction); 
    {procedure ProcessMessage;} 
 
  private 
    { Private declarations } 
    procedure UDFSocketEvent(var Msg: TMessage); message UDF_SOCKETEVENT; 
    procedure UDFHostLookup(var Msg: TMessage); message UDF_HOSTLOOKUP; 
 
  public 
    { Public declarations } 
    MailSocket:TSocket; 
    NetMail:TSock; 
    recv_buf:pChar; 
    MailStatus:Integer; 
    ccflag:boolean; 
    doflag:boolean; 
    HostName:PChar; 
    ReceiveBuf:array[0..8192] of Char; 
    MIMEMail:boolean; 
    // Lookup or combobox 
    FHandle:TextFile; 
    LookupStr:TStringList; 
  end; 
 
var 
  SMTPDialog: TSMTPDialog; 
 
implementation 
 
uses pop3, mimelist, Setup; 
 
{$R *.DFM} 
///////////////////////////////////////////////////////////////////// 
// 配置記憶體 
//////////////////////////////////////////////////////////////////// 
procedure TSMTPDialog.FormCreate(Sender: TObject); 
begin 
     { Create New socket for mail } 
     recv_buf:=ReceiveBuf; 
     HostName:=StrAlloc(80); 
     MailStatus:=MAIL_NOOP; 
     // Default value of receive '+OK' 
     doflag:=true; 
     // Create a new socket object 
     NetMail:=TSock.Create; 
     // Call StartSocket function to initial Win socket. 
     if NetMail.StartSocket=False then 
     begin 
        ShowMessage('網路不存在'); 
        Close; 
     end; 
end; 
 
///////////////////////////////////////////////////////////////////// 
// Lookup Host function is called when the user has been fill in the 
//  Mail server name and press send mail 
///////////////////////////////////////////////////////////////////// 
procedure TSMTPDialog.HostLookup; 
begin 
   // Display Message to status bar. 
   SMTPDialog.StatusBar1.Panels.Items[0].Text:='與伺服器連線中'; 
   SMTPDialog.StatusBar1.Update; 
   { Check the Receive data of host entry is correct } 
   if NetMail.HostEntryVrify then 
      MailSocket:=NetMail.OpenSocketConnection(Handle,UDF_SOCKETEVENT,IPPORT_SMTP) 
   else  begin 
      SMTPDialog.StatusBar1.Panels.Items[0].Text:='不能連線到伺服器'; 
      SMTPDialog.StatusBar1.Update; 
   end; 
   if(gethostname(HostName, 80) = SOCKET_ERROR) then 
   begin 
      SMTPDialog.StatusBar1.Panels.Items[0].Text:='主機名稱錯誤!'; 
      SMTPDialog.StatusBar1.Update; 
      NetMail.CloseSocketConnection(MailSocket); 
   end; 
end; 
 
procedure TSMTPDialog.BitBtn1Click(Sender: TObject); 
begin 
   { Send Mail } 
   SMTPDialog.StatusBar1.Panels.Items[0].Text:='搜尋主機位址中...'; 
   SMTPDialog.StatusBar1.Update; 
   MailStatus:=MAIL_CONNECT; 
   if (Length(Edit1.Text)<=0) and 
      (Length(Edit3.Text)<=0) and 
      (Length(Edit2.Text)<=0) then 
      ShowMessage('請輸入郵件伺服器名稱') 
   else    NetMail.GetHostAddr(SMTPDialog.Handle,UDF_HOSTLOOKUP,Edit1.Text); 
end; 
 
///////////////////////////////////////////////////////////////////// 
// Host receive data and echo Welcome 
// If the host has been done complete, at the first, send 'HELO' 
// to remote SMTP Server. till receiving the 250 command. 
///////////////////////////////////////////////////////////////////// 
Procedure TSMTPDialog.HostWelcome; 
var 
  RcvMsg,WelStr:string; 
  SndMsg:pChar; 
 
begin 
  RcvMsg:=StrPas(ReceiveBuf); 
  WelStr:=Copy(RcvMsg,1,3); 
  case StrToInt(WelStr) of 
    220:doflag:=true; 
    421:doflag:=false; 
  end; 
  MailStatus:=MAIL_NOOP ; { No Operator } 
 
  if doflag then begin 
     MailStatus:=MAIL_HELO; 
     SMTPDialog.StatusBar1.Panels.Items[0].Text:=RcvMsg; 
     SMTPDialog.StatusBar1.Update; 
     SndMsg:=StrAlloc(256); 
     // Verify the host exist. 
     // Modify SocketSend use pChar. 
     RcvMsg:='HELO '+StrPas(HostName)+#13#10; 
     StrPCopy(SndMsg,RcvMsg); 
     NetMail.SocketSend(MailSocket, handle, UDF_SOCKETEVENT,SndMsg); 
     Empty(ReceiveBuf,8192); 
     StrDispose(SndMsg); 
  end; 
end; 
 
 
 
///////////////////////////////////////////////////////////////// 
// Process Hello command and set mail status MAIL_FROM 
// 與 pop3 相同, 送出 Helo給Server 
// 送出  Mail From : 
///////////////////////////////////////////////////////////////// 
procedure TSMTPDialog.HostHelo; 
var 
   RcvMsg,WelStr:string; 
   SndMsg:pChar; 
begin 
  RcvMsg:=strPas(recv_buf); 
  WelStr:=Copy(RcvMsg,1,3); 
  doflag:=false; 
  case StrToInt(WelStr) of 
     250: doflag:=true; 
     421:; 
     500:; 
     501:; 
     504:; 
  end; 
 
  MailStatus:=MAIL_NOOP ; { No Operator } 
 
  if doflag then begin 
     MailStatus:=MAIL_MAILFROM; 
     SMTPDialog.StatusBar1.Panels.Items[0].Text:=RcvMsg; 
     SMTPDialog.StatusBar1.Update; 
     SndMsg:=StrAlloc(256); 
     RcvMsg:='MAIL FROM:<'+Edit3.Text+'>'+#13#10; 
     StrPCopy(SndMsg,RcvMsg); 
     NetMail.SocketSend(MailSocket,handle,UDF_SOCKETEVENT,SndMsg); 
     StrDisPose(SndMsg); 
     {Clear the receive buffer} 
     Empty(ReceiveBuf,8192); 
  end; 
end; 
 
 
procedure TSMTPDialog.HostMailFrom; 
var 
  RcvMsg,WelStr:string; 
  SndMsg:pChar; 
begin 
  RcvMsg:=strPas(recv_buf); 
  WelStr:=Copy(RcvMsg,1,3); 
  doflag:=false; 
  if StrToINt(WelStr)=250 then 
     doflag:=True; 
 
  MailStatus:=MAIL_NOOP ; { No Operator } 
  if doflag then begin 
     MailStatus:=MAIL_RCPTTO; 
     SMTPDialog.StatusBar1.Panels.Items[0].Text:=RcvMsg; 
     SMTPDialog.StatusBar1.Update; 
     SndMsg:=StrAlloc(8192); 
     RcvMsg:='RCPT TO:<'+Edit2.Text+'>'+#13#10; 
     StrPCopy(SndMsg,RcvMsg); 
 
     { Verify the host exist } 
     NetMail.SocketSend(MailSocket, handle, UDF_SOCKETEVENT, 
              SndMsg ); 
     StrDisPose(SndMsg); 
     {Clear the receive buffer} 
     Empty(ReceiveBuf,8192); 
  end; 
end; 
 
procedure TSMTPDialog.HostRcptTo; 
var 
  RcvMsg,WelStr:string; 
  SndMsg:pChar; 
begin 
  RcvMsg:=strPas(recv_buf); 
  WelStr:=Copy(RcvMsg,1,3); 
  case StrToInt(WelStr) of 
    250:doflag:=true; 
    251:doflag:=true; 
  end; 
  //MailStatus:=MAIL_NOOP ; { No Operator } 
  // Caben Copy 
  SndMsg:=StrAlloc(256); 
  if doflag then begin 
     if ((Length(Edit4.Text)>0) and (MailStatus=MAIL_RCPTTO))then 
     begin 
         SMTPDialog.StatusBar1.Panels.Items[0].Text:=RcvMsg; 
         SMTPDialog.StatusBar1.Update; 
         ccflag:=true; 
         MailStatus:=MAIL_RCPTCC; 
         RcvMsg:='RCPT TO:<'+Edit4.Text+'>'+#13#10; 
         StrPCopy(SndMsg,RcvMsg); 
         NetMail.SocketSend(MailSocket, handle, UDF_SOCKETEVENT,SndMsg); 
         Empty(ReceiveBuf,8192); 
     end 
     else begin 
        MailStatus:=MAIL_DATA; 
        SMTPDialog.StatusBar1.Panels.Items[0].Text:=RcvMsg; 
        SMTPDialog.StatusBar1.Update; 
        RcvMsg:='DATA '+#13#10; 
        StrCopy(SndMsg,pChar(RcvMsg)); 
        NetMail.SocketSend(MailSocket, handle, UDF_SOCKETEVENT,SndMsg); 
        {Clear the receive buffer} 
        Empty(ReceiveBuf,8192); 
     end; 
  end; 
  StrDisPose(SndMsg); 
end; 
// This procedure used Transfer the mail header. 
procedure TSMTPDialog.HostData; 
var 
   RcvMsg,WelStr:string; 
   done:boolean; 
   SndMsg:pChar; 
begin 
  RcvMsg:=strPas(recv_buf); 
  WelStr:=Copy(RcvMsg,1,3); 
  done:=false; 
  case StrToInt(WelStr) of 
    250:begin doflag:=true;done:=true; end; 
    354:doflag:=true; 
  end; 
  MailStatus:=MAIL_NOOP ; { No Operator } 
  if doflag then 
  begin 
     if done then 
     begin 
        // Allocating the memory 8K 
        SndMsg:=StrAlloc(256); 
        MailStatus:=MAIL_QUIT; 
 
        SMTPDialog.StatusBar1.Panels.Items[0].Text:=RcvMsg; 
        SMTPDialog.StatusBar1.Update; 
        RcvMsg:='QUIT '+#13#10; 
        StrPCopy(SndMsg,RcvMsg); 
 
        { Verify the host exist } 
        NetMail.SocketSend(MailSocket, handle, UDF_SOCKETEVENT,SndMsg); 
        {Clear the receive buffer} 
        Empty(ReceiveBuf,8192); 
        StrDisPose(SndMsg); 
     end  else SendMsgHeader; 
  end; 
end; 
 
procedure TSMTPDialog.HostQuit; 
var 
   RcvMsg,WelStr:string; 
begin 
  RcvMsg:=strPas(recv_buf); 
  WelStr:=Copy(RcvMsg,1,3); 
  doflag:=false; 
  if StrToINt(WelStr)=221 then 
     doflag:=True; 
 
  MailStatus:=MAIL_NOOP ; { No Operator } 
  Edit1.Clear; 
  Edit2.Clear; 
  Edit3.Clear; 
  Edit4.Clear; 
  Edit5.Clear; 
  Memo1.Clear; 
  if doflag then begin 
     SMTPDialog.StatusBar1.Panels.Items[0].Text:=RcvMsg; 
     SMTPDialog.StatusBar1.Update; 
     { Verify the host exist } 
     NetMail.CloseSocketConnection(MailSocket); 
     NetMail.shutdownsocket; 
  end; 
end; 
 
 
 
{ Above the FD_XX Message to process } 
procedure TSMTPDialog.HostConnect; 
begin 
    SMTPDialog.StatusBar1.Panels.Items[0].Text:='主機連線中...'; 
    SMTPDialog.StatusBar1.Update; 
    Empty(ReceiveBuf,8192); 
    MailStatus:=MAIL_CONNECT; 
end; 
 
{ It used HostReceive } 
procedure TSMTPDialog.HostSend; 
begin 
    if MailStatus<>MAIL_NOOP then Empty(ReceiveBuf,8192); 
end; 
 
{ Importment function ,it's destintion set the mail status like 'HELO' etc. } 
{ Receive Buffer } 
procedure TSMTPDialog.HostReceive; 
var 
   RcvBytes:Integer; 
begin 
   { Receive from host } 
  try 
     RcvBytes:=recv(MailSocket,ReceiveBuf,8192,0); 
     ReceiveBuf[RcvBytes]:=Char(0); { Turn to C style string } 
     // there are not any data received. 
     if ReceiveBuf[0]=Char(0) then Empty(ReceiveBuf,8192) 
     else  begin 
        case MailStatus of 
             MAIL_NOOP:; 
             MAIL_CONNECT:HostWelcome; 
             MAIL_HELO:HostHelo; 
             MAIL_MAILFROM:HostMailFrom; 
             MAIL_RCPTTO:HostRcptTo; 
             MAIL_RCPTCC:HostRcptTo; 
             MAIL_DATA:HostData; 
             MAIL_RSET:; 
             MAIL_SEND:; 
             MAIL_SOML:; 
             MAIL_SAML:; 
             MAIL_VRFY:; 
             MAIL_EXPN:; 
             MAIL_HELP:; 
             MAIL_TURN:; 
             MAIL_QUIT: HostQuit; 
        end; 
     end; 
  except 
      Empty(ReceiveBuf,8192); 
  end; 
end; 
 
// Message Loop , if you known the Application .OnMessage, 
// you can specified the application to do this task. 
procedure TSMTPDialog.UDFSocketEvent(var Msg: TMessage); 
begin 
   case Msg.LParamLo of 
      FD_READ: HostReceive; 
      FD_WRITE: HostSend; 
      FD_CONNECT: HostConnect; 
      FD_CLOSE: ; 
   end; 
end; 
 
// Search the host of mail. 
procedure TSMTPDialog.UDFHostLookup(var Msg: TMessage); 
begin 
   if (Msg.lParamHi = 0) then 
      HostLookup; 
end; 
 
procedure TSMTPDialog.FormDestroy(Sender: TObject); 
begin 
     StrDispose(HostName); 
     NetMail.CloseSocketConnection(MailSocket); 
     NetMail.ShutDownSocket; 
end; 
 
//////////////////////////////////////////////////////////////////// 
// 傳送表頭資訊 
// 1.To      :xxxxxxx 
// 2.From    : xxxxxx 
// 3.CC      :xxxxx 
// 4.Subject :xxxxx 
// 5.XSender : 
// 6.MIME    Concept 
///////////////////////////////////////////////////////////////////// 
{ Send Mail Header } 
procedure TSMTPDialog.SendMsgHeader; 
var 
   MailTitle:string; 
   nHeader:pChar; 
   MsgLen:LongInt; 
   I:Integer; 
   MIMEFN:string; 
begin 
   { Make the socket  syncnized  } 
   I:=0; 
   // Get the file name of List view without path. 
   if MIMEMail then 
   begin 
      MIMEFN:=MIMEListForm.IconList.Items[0].caption; 
      MsgLen:=Pos('\',MIMEFN); 
      while(MsgLen>0) do 
      begin 
         MIMEFN:=Copy(MIMEFN,(MsgLen+1),Length(MIMEFN)); 
         MsgLen:=Pos('\',MIMEFN); 
      end; 
   end; 
   // 將Socket設定獨佔,避免資料送出失錯 
   WSAAsyncSelect(MailSocket, handle, 0, 0); 
   nHeader:=StrAlloc(8192); 
   MailTitle:='To: '+Edit2.Text+#13#10; 
   if ccflag then 
   begin 
      MailTitle:=MailTitle+'CC: '+Edit4.Text+#13#10; 
      ccflag:=false; 
   end; 
   MailTitle:=MailTitle+'From: '+Edit3.Text+#13#10; 
   StrPCopy(nHeader,MailTitle); 
   NetMail.SocketSend(MailSocket, handle, UDF_SOCKETEVENT,nHeader); 
   // Send Subject : to Server 
   Empty(nHeader,512); 
   MailTitle:='Subject: '+Edit5.Text+#13#10; 
   StrPCopy(nHeader,MailTitle); 
   NetMail.SocketSend(MailSocket, handle, UDF_SOCKETEVENT,nHeader); 
   Empty(nHeader,512); 
   MailTitle:='X-Mail: Sample Mail Transfer Protocol V 1.0'+#13#10; 
   StrPCopy(nHeader,MailTitle); 
   NetMail.SocketSend(MailSocket, handle, UDF_SOCKETEVENT,nHeader); 
 
   // Send The MIME Message to Server 
 
   if MIMEMail=true then 
   begin 
      Empty(nHeader,8192); 
      MailTitle:='MIME-Version: 1.0'+#13#10; 
      StrPCopy(nHeader,MailTitle); 
      NetMail.SocketSend(MailSocket, handle, UDF_SOCKETEVENT,nHeader); 
 
      if ((MIMEListForm.IconList.Items.count>0) or (Memo1.GetTextLen>0)) then 
      begin 
         Empty(nHeader,256); 
         MailTitle:='Content-Type: multipart/mixed; boundary="------------66443322"'+#13#10; 
         StrPCopy(nHeader,MailTitle); 
         NetMail.SocketSend(MailSocket, handle, UDF_SOCKETEVENT,nHeader); 
      end; 
      if MIMEListForm.IconList.Items.count>0 then 
      begin 
         Empty(nHeader,512); 
         MailTitle:=#13#10; 
         MailTitle:=MailTitle+'This is a multi-part message in MIME format'+#13#10#13#10; 
         StrPCopy(nHeader,MailTitle); 
         NetMail.SocketSend(MailSocket, handle, UDF_SOCKETEVENT,nHeader); 
      end; 
   end; 
   StrDisPose(nHeader); 
   SendMsgText; 
end; 
///////////////////////////////////////////////////////////////////// 
// 送出本文及 MIME內容 
// MIME 存在則送 Boundary字串 
/////////////////////////////////////////////////////////////////// 
procedure TSMTPDialog.SendMsgText; 
var 
  SndMsg,temp:pChar; 
  WelStr:string; 
  MsgLen1,MsgLen2,Bytes:LongInt; 
  RetCar:string; 
begin 
   MsgLen1 := Memo1.GetTextLen; 
   if MsgLen1>0 then begin 
      if MIMEMail then 
      begin 
         SndMsg:=StrAlloc(256); 
         WelStr:='--------------66443322'+#13#10; 
         StrPCopy(SndMsg,WelStr); 
         NetMail.SocketSend(MailSocket, handle, UDF_SOCKETEVENT,SndMsg); 
         StrDispose(SndMsg); 
      end; 
      SndMsg:=StrAlloc(256); 
      WelStr:=WelStr+'Content-type: text/plain; charset=us-ascii'+#13#10; 
      WelStr:=WelStr+'Content-Transfer-Encoding: 8bit'+#13#10#13#10; 
      StrPCopy(SndMsg,WelStr); 
      NetMail.SocketSend(MailSocket, handle, UDF_SOCKETEVENT,SndMsg); 
      StrDispose(SndMsg); 
 
      SndMsg:=StrAlloc(MsgLen1+10); 
      Memo1.GetTextBuf(SndMsg,(MsgLen1+5)); 
      RetCar:=#13#10+#13#10; 
      SndMsg:=StrCat(SndMsg,PChar(RetCar)); 
      NetMail.SocketSend(MailSocket, handle, UDF_SOCKETEVENT,SndMsg); 
      StrDispose(SndMsg); 
   end; 
   MsgLen2 := Memo2.GettextLen; 
   SndMsg:=StrAlloc(MsgLen2+10); 
   {allocate a Pchar buffer to hold the entire message} 
   Memo2.GetTextBuf(SndMsg, (MsgLen2+1)); 
   RetCar:=#13#10+'.'+#13#10; 
   SndMsg:=StrCat(SndMsg,PChar(RetCar)); 
   NetMail.SocketSend(MailSocket, handle, UDF_SOCKETEVENT,SndMsg); 
   StrDispose(SndMsg); 
 
   { Receive others or not } 
   Empty(ReceiveBuf,8192); 
   // To set the socket is exclusive mode 
   WSAAsyncSelect(MailSocket, handle, 0, 0); 
   //to receive 8K 
   Bytes := recv(MailSocket, ReceiveBuf, 8192, 0); 
   if Bytes >0 then 
      HostData else 
   begin 
      { To receive again } 
      Bytes := recv(MailSocket, ReceiveBuf, 8192, 0); 
      // There are not any data received. 
      // Quit the mail receiving. 
      if Bytes >0 then HostData else 
      begin 
         MailStatus:=MAIL_QUIT; 
         SndMsg:=StrAlloc(64); 
         RetCar:='QUIT '+#13#10; 
         StrPCopy(SndMsg,RetCar); 
         NetMail.SocketSend(MailSocket,handle,UDF_SOCKETEVENT,SndMsg); 
         StrDispose(SndMsg); 
         Empty(ReceiveBuf,StrLen(ReceiveBuf)); 
         Close; 
      end; 
   end; 
end; 
procedure TSMTPDialog.BitBtn2Click(Sender: TObject); 
begin 
     Close; 
end; 
 
procedure TSMTPDialog.LoadFileClick(Sender: TObject); 
begin 
   if OpenDialog1.Execute then 
   begin 
      Memo1.Lines.LoadFromFile(OpenDialog1.FileName); 
   end; 
end; 
 
/////////////////////////////////////////////////////////////////// 
//  附屬檔案 
// 1.顯示 Caption 
// 2.將暫存檔內容 'mailbox.tmp'載入Memo 
// 3.逐一解碼, UUCPForm 應再修改 
// 4.呼叫 UUCPForm 
/////////////////////////////////////////////////////////////////// 
procedure TSMTPDialog.EmbadeFileClick(Sender: TObject); 
var 
   I:Integer; 
   NewFile:TextFile; 
   PFileName:string; 
begin 
 
   MIMEMail:=true; 
   MIMEListForm.MIMEFileCount:=0; 
   MIMEListForm.IconList.Items.Clear; 
   MIMEListForm.BitBtn1.Visible:=true; 
   MIMEListForm.BitBtn1.Enabled:=true; 
   MIMEListForm.Caption:='將要含入郵件的附檔新增至本視窗'; 
   MIMEListForm.ShowModal; 
   // Repeat to Encode the selected file that comes from MIMEListForm. 
   // To clear the 'mailbox.tmp' to empty. 
   PFileName:=SetupDialog.RootDir+'\mailbox.tmp'; 
   AssignFile(NewFile,PFileName); 
   ReWrite(NewFile); 
   CloseFile(NewFile); 
   I:=0; 
 
   // If the MIME is multipart, then set the ParaFlag is false, to 
   // represent it is first part, till first part process completely, 
   // set the ParaFlag is true. 
   UUCPForm.ParaFlag:=False; 
   UUCPForm.ParaEndFlag:=false; 
 
   // How many parts in the MIME . 
   while(MIMEListForm.IconList.Items.count>I) do 
   begin 
      UUCPForm.CodeFlag:=0; 
      if MIMEListForm.IconList.Items.count=I+1 then 
           UUCPForm.ParaEndFlag:=true; 
      UUCPForm.EnMode:=1; 
      UUCPForm.EnSrc:=MIMEListForm.IconList.Items[I].caption; 
      UUCPForm.EnDest:=SetupDialog.RootDir+'mailbox.tmp'; 
      UUCPForm.ShowModal; 
      Inc(I); 
   end; 
   // Useing the Memo's TStrings to store the MIME Data. 
   // Suggestion: To use Alloc memory to store the MIME Data 
   Memo2.Lines.LoadFromFile(UUCPForm.EnDest); 
end; 
 
///////////////////////////////////////////////////////////////////// 
// 1.載成郵遞資料檔 
// 2.取得純粹檔名 
///////////////////////////////////////////////////////////////////// 
 
procedure TSMTPDialog.FormActivate(Sender: TObject); 
var 
   I:integer; 
   TempStr:string; 
   LookupPos:Integer; 
   PFileName:string; 
begin 
    LookupStr:=TStringList.Create; 
    ComboBox1.Items.Clear; 
    PFileName:=SetupDialog.RootDir+'\maildb.dat'; 
    try 
 
       LookupStr.LoadFromFile('MailDB.dat'); 
    except 
       AssignFile(FHandle,'maildb.dat'); 
       ReWrite(FHandle); 
       CloseFile(FHandle); 
    end; 
    // To fill in the combobox 
    I:=0; 
    while(LookupStr.count>I) do 
    begin 
       LookupPos:= Pos('/',LookupStr[I]); 
       TempStr:=Copy(LookupStr[I],1,LookupPos-1); 
       ComboBox1.Items.Add(TempStr); 
       inc(I); 
    end; 
     //Table1.Active:=true; 
     //Table2.Active:=true; 
end; 
 
///////////////////////////////////////////////////////////////////// 
// 1. 檢查 MIME是否存在 
// 2. 若存在則將檔案加入MIMEListform視窗 
// 3. 若檔案存在則將 MIMEListForm顯示出來 
///////////////////////////////////////////////////////////////////// 
 
procedure TSMTPDialog.FormShow(Sender: TObject); 
var 
  I:Integer; 
  ImgBmp:TIcon; 
  PFileName:string ; 
begin 
    // User request to decode the MIME , it will popuop before 
    // SMTPDialog, when it will close itself,the SMTPDialog will 
    // Show. 
    if PopDialog.FoundMIME then 
    begin 
       I:=0; 
       MIMEListForm.IconList.Items.Clear; 
       ImgBmp:=TIcon.Create; 
       PFileName:=SetupDialog.RootDir+'\mailpict.ico'; 
       ImgBmp.LoadFromFile(PFileName); 
       MIMEListForm.ImageList1.AddIcon(ImgBmp); 
 
       // Processing the List view to add icon and caption. 
       if PopDialog.FoundMIME then 
       begin 
          while(I