开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Delphi控件源码 > 查看源码
NMpop3.pas
资源名称：FastNet.rar　[点击查看]
上传用户：szzdds
上传日期：2013-09-18
资源大小：293k
文件大小：28k
源码类别：

Delphi控件源码

开发平台：

Delphi

NMpop3.pas：源码内容
  1. unit NMpop3;
  2. {$X+}
  3. {$R-}
  5. {$IFDEF VER100}
  6. {$DEFINE NMF3}
  7. {$ENDIF}
  8. {$IFDEF VER110}
  9. {$DEFINE NMF3}
  10. {$ENDIF}
  11. {$IFDEF VER120}
  12. {$DEFINE NMF3}
  13. {$ENDIF}
  14. {$IFDEF VER125}
  15. {$DEFINE NMF3}
  16. {$ENDIF}
  18. interface
  20. uses
  21.   Classes, PSock, Sysutils, NMUUE, NMExtstr, NMConst;
  22. {$IFDEF VER110}
  23. {$OBJEXPORTALL On}
  24. {$ENDIF}
  25. {$IFDEF VER120}
  26. {$OBJEXPORTALL On}
  27. {$ENDIF}
  28. {$IFDEF VER125}
  29. {$OBJEXPORTALL On}
  30. {$ENDIF}
  32. const
  33.   POP3_PORT = 110;
  35.    //  CompName     ='NMPOP3';
  36.    //  Major_Version='4';
  37.    //  Minor_Version='02';
  38.    //  Date_Version ='012798';
  40. const {Protocol}
  41.   Cons_OK_Resp = '+OK';
  42.   Cons_Err_Resp = '-ERR';
  43.   Cons_Cmd_User = 'USER ';
  44.   Cons_Cmd_Pass = 'PASS ';
  45.   Cons_Cmd_Stat = 'STAT';
  46.   Cons_Cmd_Quit = 'QUIT';
  47.   Cons_Cmd_Top = 'TOP ';
  48.   Cons_Cmd_List = 'LIST ';
  49.   Cons_Cmd_Retr = 'RETR ';
  50.   Cons_Cmd_Dele = 'DELE ';
  51.   Cons_Cmd_Rset = 'RSET';
  52.   Cons_Cmd_Uidl = 'UIDL ';
  53.   Cons_Head_CSubj = 'SUBJECT:';
  54.   Cons_Head_CFrom = 'FROM:';
  55.   Cons_Head_CType = 'CONTENT-TYPE:';
  56.   Cons_Head_CMid = 'MESSAGE-ID:';
  57.   Cons_Head_CBoun = 'BOUNDARY=';
  58.   Cons_Head_CCTE = 'CONTENT-TRANSFER-ENCODING';
  59.   Cons_Head_FileN = 'FILENAME';
  60.   Cons_Head_Subj = 'Subject:';
  61.   Cons_Head_From = 'From:';
  62.   Cons_Head_MId = 'Message-ID:';
  63.   Cons_Head_Mult = 'multipart';
  64.   Cons_Head_UUEn = 'X-UUENCODE';
  65.   Cons_Head_B641 = 'base64';
  66.   Cons_Head_B642 = 'Base64';
  68. type
  69.   TListEvent = procedure(Msg, Size: integer) of object;
  70.       // Modification made by Edward T. Smith Sep 09 1998
  71.   TVarFileNameEvent = procedure(var FileName: string) of object;
  72.       // End
  74.   TMailMessage = class(TPersistent)
  75.   private
  76.     FHead: TexStringList;
  77.     FRawBody: TStringList;
  78.     FBody: TStringList;
  79.     Fcontenttypes, FAttachments: TStringList;
  80.     FPartHeaders: TList;
  81.     FContentType: string;
  82.     FFrom: string;
  83.     FSubject: string;
  84.     FMessageId: string;
  86.   public
  87.     FBoundary: string;
  88.     constructor Create;
  89.     destructor Destroy; override;
  90.     property Subject: string read FSubject;
  91.     property From: string read FFrom;
  92.     property RawBody: TStringList read FRawBody;
  93.     property Body: TStringList read FBody;
  94.     property Head: TExStringList read FHead;
  95.     property MessageId: string read FMessageId write FMessageId;
  96.     property ContentType: string read FContentType write FContentType;
  97.     property Attachments: TStringList read FAttachments;
  98.     property AttachContenttypes: TStringList read FContentTypes;
  99.     property PartHeaders: TList read FPartHeaders;
  100.   end; {_ TMailMessage      = class(TPersistent) _}
  102.   TSummary = class(TPersistent)
  103.   private
  104.     FSubject: string;
  105.     FFrom: string;
  106.     FBytes: integer;
  107.     FMessageId: string;
  108.     FHeader: TExStringList;
  109.   published
  110.     constructor Create;
  111.     destructor Destroy; override;
  112.     property Subject: string read FSubject write FSubject;
  113.     property From: string read FFrom write FFrom;
  114.     property MessageId: string read FMessageId write FMessageId;
  115.     property Bytes: integer read FBytes write FBytes;
  116.     property Header: TExStringList read FHeader write FHeader;
  117.   end; {_ TSummary          = class(TPersistent) _}
  119.   TNMPOP3 = class(TPowerSock)
  120.   private
  121.       // Modification made by Edward T. Smith Sep 09 1998
  122.     FOnDecodeStart: TVarFileNameEvent;
  123.     FOnDecodeEnd: TNotifyEvent;
  124.       // End
  125.     NMUUProcessor1: TNMUUProcessor;
  126.     FAttachFilePath, FFilename, FContent_type: string;
  127.     FSummary: TSummary;
  128.     FParse: boolean;
  129.     FMailMessage: TMailMessage;
  130.     FUserID, FPassword: string;
  131.     FAbort, FDeleteOnRead, FTransactionInProgress: boolean;
  132.     FMailCount, FFirstPart: integer;
  133.     FOnAuthenticationNeeded: THandlerEvent;
  134.     FOnAuthenticationFailed: THandlerEvent;
  135.     FOnReset: TNotifyEvent;
  136.     FOnList: TListEvent;
  137.     FOnRetrieveStart: TNotifyEvent;
  138.     FOnRetrieveEnd: TNotifyEvent;
  139.     FOnSuccess: TNotifyEvent;
  140.     FOnFailure: TNotifyEvent;
  141.     FOnConnect: TNotifyEvent;
  142.     WaitForReset: integer;
  143.     procedure ReadMailParts;
  144.     function ReadBody(var MailMessage: TMailMessage): boolean;
  145.     procedure ReadHeader(Readfile: boolean; var MailMessage: TMailMessage);
  146.     procedure AbortResume(Sender: TObject);
  147.     procedure SetAttachFilePath(Value: string);
  148.   protected
  149.   public
  150.     constructor Create(AOwner: TComponent); override;
  151.     destructor Destroy; override;
  152.     procedure Connect; override;
  153.     procedure Disconnect; override;
  154.     procedure GetMailMessage(MailNumber: integer);
  155.     procedure GetSummary(MailNumber: integer);
  156.     procedure DeleteMailMessage(MailNumber: integer);
  157.     procedure Extract(InString: string; var OutString: string);
  158.     function UniqueID(MailNumber: integer): string;
  159.     procedure Reset;
  160.     procedure List;
  161.     procedure Abort; override;
  162.     property MailCount: integer read FMailCount;
  163.     property Summary: TSummary read FSummary;
  164.     property MailMessage: TMailMessage read FMailMessage;
  165.     property OnRetriveStart: TNotifyEvent read FOnRetrieveStart write FOnRetrieveStart;
  166.     property OnRetriveEnd: TNotifyEvent read FOnRetrieveEnd write FOnRetrieveEnd;
  168.   published
  169.     property OnConnectionRequired;
  170.     property OnPacketRecvd;
  171.     property BytesRecvd;
  172.     property BytesTotal;
  173.     property UserID: string read FUserID write FUserID;
  174.     property Parse: boolean read FParse write FParse;
  175.     property Password: string read FPassword write FPassword;
  176.     property DeleteOnRead: boolean read FDeleteOnRead write FDeleteOnRead;
  177.       // Modification made by Edward T. Smith Sep 09 1998
  178.     property AttachFilePath: string read FAttachFilePath write SetAttachFilePath;
  179.       // End
  180.     property OnConnect: TNotifyEvent read FOnConnect write FOnConnect;
  181.     property OnAuthenticationNeeded: THandlerEvent read FOnAuthenticationNeeded write FOnAuthenticationNeeded;
  182.     property OnAuthenticationFailed: THandlerEvent read FOnAuthenticationFailed write FOnAuthenticationFailed;
  183.     property OnReset: TNotifyEvent read FOnReset write FOnReset;
  184.     property OnList: TListEvent read FOnList write FOnList;
  185.     property OnRetrieveStart: TNotifyEvent read FOnRetrieveStart write FOnRetrieveStart;
  186.     property OnRetrieveEnd: TNotifyEvent read FOnRetrieveEnd write FOnRetrieveEnd;
  187.     property OnSuccess: TNotifyEvent read FOnSuccess write FOnSuccess;
  188.     property OnFailure: TNotifyEvent read FOnFailure write FOnFailure;
  189.       // Modification made by Edward T. Smith Sep 09 1998
  190.     property OnDecodeStart: TVarFileNameEvent read FOnDecodeStart write FOnDecodeStart;
  191.     property OnDecodeEnd: TNotifyEvent read FOnDecodeEnd write FOnDecodeEnd;
  192.       // End
  193.   end; {_ TNMPOP3           = class(TPowerSock) _}
  195. implementation
  196. var Readindex, TFileIndex: integer;
  198. constructor TSummary.Create;
  199. begin
  200.   inherited Create;
  201.   FHeader := TExStringList.Create;
  202. end;
  204. destructor TSummary.Destroy;
  205. begin
  206.   FHeader.Free;
  207.   inherited Destroy;
  208. end;
  210. procedure TNMPOP3.SetAttachFilePath(Value: string);
  211. begin
  212.   if Value[Length(Value)] <> '' then
  213.     Value := Value + '';
  214.   FAttachFilePath := Value;
  215. end;
  216. // End
  218. constructor TNMPOP3.Create(AOwner: TComponent);
  219.  begin
  220.   inherited Create(AOwner);
  221.   Port := POP3_Port;
  222.   FMailMessage := TMailMessage.create;
  223.   FSummary := TSummary.create;
  224.   FDeleteOnRead := FALSE;
  225.   FTransactionInProgress := FALSE;
  226.   FAttachFilePath := '';
  227.   OnAbortRestart := AbortResume;
  228.   WaitForReset := 2;
  229.   NMUUProcessor1 := TNMUUProcessor.create(self);
  230. end; {_ constructor TNMPOP3.Create(AOwner: TComponent); _}
  233. destructor TNMPOP3.Destroy;
  234. begin
  235.   FSummary.free;
  236.   FMailMessage.free;
  237.   NMUUProcessor1.free;
  238.   inherited Destroy;
  239. end; {_ destructor TNMPOP3.Destroy; _}
  243. procedure TNMPOP3.Connect;
  244. var
  245.   ReplyMess: string;
  246.   Check: boolean;
  247.   TryCt: integer;
  248.   Done, ConnCalled, Handled: boolean;
  250.   function CheckAuth(FromHost: string): boolean;
  251.   begin
  252.     if Pos(Cons_OK_Resp, NthWord(ReplyMess, ' ', 1)) > 0 then Result := TRUE
  253.     else {_ NOT if Pos(Cons_OK_Resp, NthWord(ReplyMess, ' ', 1)) > 0 then Result := TRUE _}
  254.       begin
  255.         Result := FALSE;
  256.         if TryCt > 0 then raise Exception.create(Cons_Msg_Auth_Fail)
  257.         else {_ NOT if TryCt > 0 then raise Exception.create(Cons_Msg_Auth_Fail) _}
  258.           if not assigned(FOnAuthenticationFailed) then
  259.             raise Exception.create(Cons_Msg_Auth_Fail)
  260.           else {_ NOT if not assigned(FOnAuthenticationFailed) then raise Exception.create(Cons_Msg_Auth_Fail) _}
  261.             begin
  262.               Handled := FALSE;
  263.               FOnAuthenticationFailed(Handled);
  264.               if not Handled then raise Exception.create(Cons_Msg_Auth_Fail);
  265.               TryCt := TryCt + 1;
  266.             end; {_ NOT if not assigned(FOnAuthenticationFailed) then raise Exception.create(Cons_Msg_Auth_Fail) _}
  267.       end; {_ NOT if Pos(Cons_OK_Resp, NthWord(ReplyMess, ' ', 1)) > 0 then Result := TRUE _}
  268.   end; {_ function CheckAuth(FromHost: string): boolean; _}
  270. begin
  271.   Done := FALSE;
  272.   TryCt := 0;
  273.   while (Password = '') or (UserID = '') do
  274.     if not assigned(FOnAuthenticationNeeded) then raise Exception.create(Cons_Msg_Auth_Fail)
  275.     else {_ NOT if not assigned(FOnAuthenticationNeeded) then raise Exception.create(Cons_Msg_Auth_Fail) _}
  276.       begin
  277.         if TryCt > 0 then break;
  278.         handled := FALSE;
  279.         FOnAuthenticationNeeded(Handled);
  280.         if not handled then raise Exception.create(Cons_Msg_Auth_Fail);
  281.         inc(TryCt);
  282.       end; {_ NOT if not assigned(FOnAuthenticationNeeded) then raise Exception.create(Cons_Msg_Auth_Fail) _}
  283.   ConnCalled := FALSE;
  284.   if FTransactionInProgress then ConnCalled := TRUE else FTransactionInProgress := TRUE;
  285.   try
  286.     inherited Connect;
  287.     try
  288.       ReplyMess := ReadLn;
  289.       if Pos(Cons_OK_Resp, NthWord(ReplyMess, ' ', 1)) = 0 then raise Exception.create(ReplyMess);
  290.       Check := FALSE; TryCt := 0;
  291.       while not check do
  292.         begin
  293.           ReplyMess := Transaction(Cons_Cmd_User + FUserID);
  294.           if CheckAuth(ReplyMess) then
  295.             begin
  296.               ReplyMess := Transaction(Cons_Cmd_Pass + FPassword);
  297.               Check := CheckAuth(ReplyMess)
  298.             end; {_ if CheckAuth(ReplyMess) then _}
  299.           TryCt := TryCt + 1;
  300.         end; {_ while not check do _}
  301.       Done := TRUE;
  302.       ReplyMess := Transaction(Cons_Cmd_Stat);
  303.       if Pos(Cons_OK_Resp, NthWord(ReplyMess, ' ', 1)) = 0 then raise Exception.create(ReplyMess);
  304.       FMailCount := StrToIntDef(NthWord(ReplyMess, ' ', 2), 0);
  305.     except
  306.       Disconnect;
  307.       raise
  308.     end; {_ try _}
  309.   finally
  310.     if not ConnCalled then FTransactionInProgress := FALSE;
  311.     if Done then
  312.       if assigned(FOnConnect) then
  313.         FOnConnect(self);
  314.   end; {_ try _}
  315. end; {_ procedure TNMPOP3.Connect; _}
  317. procedure TNMPOP3.Disconnect;
  318. var ReplyMess: string;
  319. begin
  320.   if Connected then
  321.     try
  322.       ReplyMess := Transaction(Cons_Cmd_Quit);
  323.       if Pos(Cons_OK_Resp, NthWord(ReplyMess, ' ', 1)) = 0 then raise Exception.create(ReplyMess);
  324.     finally
  325.       inherited Disconnect;
  326.     end; {_ try _}
  327. end; {_ procedure TNMPOP3.Disconnect; _}
  329. procedure TNMPOP3.GetSummary(MailNumber: integer);
  330. var ReplyMess: string;
  331. begin
  332.   if not FTransactionInProgress then
  333.     begin
  334.       FTransactionInProgress := TRUE;
  335.       try
  336.         CertifyConnect;
  337.         if assigned(FOnRetrieveStart) then FOnRetrieveStart(self);
  338.         FAbort := FALSE;
  339.         ReplyMess := Transaction(Cons_Cmd_Top + IntToStr(MailNumber) + ' 0');
  340.         if Pos(Cons_OK_Resp, NthWord(ReplyMess, ' ', 1)) = 0 then raise Exception.create(ReplyMess);
  341.         FSummary.FHeader.clear;
  342.         FSummary.FSubject := '';
  343.         FSummary.FFrom := '';
  344.         FSummary.FMessageID := '';
  345.         if not FAbort then
  346.           repeat
  347.             ReplyMess := readln;
  348.             if Pos(Cons_Head_Subj, ReplyMess) = 1 then FSummary.FSubject := Copy(ReplyMess, 9, length(ReplyMess) - 10);
  349.             if Pos(Cons_Head_From, ReplyMess) = 1 then FSummary.FFrom := Copy(ReplyMess, 6, length(ReplyMess) - 7);
  350.             if Pos(Cons_Head_MId, ReplyMess) = 1 then FSummary.FMessageID := Copy(ReplyMess, 13, 256);
  351.             if Replymess[Length(Replymess) - 1] = #13 then
  352.               SetLength(Replymess, Length(Replymess) - 2)
  353.             else {_ NOT if Replymess[Length(Replymess) - 1] = #13 then _}  SetLength(Replymess, Length(Replymess) - 1);
  354.             FSummary.FHeader.add(ReplyMess);
  355.           until ReplyMess = '.';
  356.         ReplyMess := Transaction(Cons_Cmd_List + IntToStr(MailNumber));
  357.         FSummary.FBytes := StrToInt(Trim(NthWord(ReplyMess, ' ', 3)));
  358.         StatusMessage(Status_Informational, sPOP_Cons_Summ_Retr);
  359.         if assigned(FOnRetrieveEnd) then FOnRetrieveEnd(self);
  360.       finally
  361.         FTransactionInProgress := FALSE;
  362.       end; {_ try _}
  363.     end; {_ if not FTransactionInProgress then _}
  364. end; {_ procedure TNMPOP3.GetSummary(MailNumber: integer); _}
  366. procedure TNMPOP3.GetMailMessage(MailNumber: integer);
  367. var ReplyMess: string;
  368. begin
  369.   if not FTransactionInProgress then
  370.     begin
  371.       FTransactionInProgress := TRUE;
  372.       CertifyConnect;
  373.       if assigned(FOnRetrieveStart) then FOnRetrieveStart(self);
  374.       try
  375.         FContent_type := '';
  376.         FMailMessage.FBoundary := '';
  377.         FFilename := '';
  378.         FAbort := FALSE;
  379.         FFirstPart := 2;
  380.         if assigned(OnPacketRecvd) then
  381.           begin
  382.             ReplyMess := Transaction(Cons_Cmd_List + IntToStr(MailNumber));
  383.             FBytesTotal := StrToInt(Trim(NthWord(ReplyMess, ' ', 3)));
  384.           end;
  385.         ReplyMess := Transaction(Cons_Cmd_Retr + IntToStr(MailNumber));
  386.         if Pos(Cons_OK_Resp, NthWord(ReplyMess, ' ', 1)) = 0 then raise Exception.create(ReplyMess);
  387.         Readindex := 0;
  388.         FMailMessage.FHead.clear;
  389.         FMailMessage.FBody.clear;
  390.         FMailMessage.FRawBody.clear;
  391.         FMailMessage.FAttachments.clear;
  392.         FMailMessage.Fcontenttypes.clear;
  393.         FMailMessage.FSubject := '';
  394.         FMailMessage.FContenttype := '';
  395.         FBytesRecvd := 0;
  396.         if not FAbort then ReadHeader(false, FMailMessage);
  397.         ReplyMess := Readln;
  398.         FBytesRecvd := FBytesRecvd + length(ReplyMess);
  399.         if assigned(OnPacketRecvd) then OnPacketRecvd(Self);
  400.         while ReplyMess <> '.' + #13#10 do
  401.           begin
  402.             ReplyMess := Copy(ReplyMess, 0, Length(ReplyMess) - 2);
  403.             FMailMessage.FRawBody.add(ReplyMess);
  404.             ReplyMess := Readln;
  405.             FBytesRecvd := FBytesRecvd + length(ReplyMess);
  406.             if assigned(OnPacketRecvd) then OnPacketRecvd(Self);
  407.           end;
  408.         if not FAbort then
  409.           if pos(Lowercase(Cons_Head_Mult), LowerCase(FMailMessage.FContentType)) > 0 then ReadMailParts
  410.           else if not FParse then FMailMessage.FBody.Assign(FMailMessage.FRawBody)
  411.           else
  412.             if (pos('BASE64', Uppercase(FContent_type)) > 0) then
  413.               begin
  414.                 FFirstPart := 0;
  415.                 ReadBody(FMailMessage);
  416.                 FMailMessage.FBody.loadfromfile(FAttachFilePath + FMailMessage.FAttachments[0]);
  417.               end
  418.             else {_ NOT if pos(Cons_Head_Mult, FContentType) > 0 then ReadMailParts _}  ReadBody(FMailMessage);
  419.         if FDeleteOnRead and not FAbort then
  420.           begin
  421.             ReplyMess := Transaction(Cons_Cmd_Dele + IntToStr(MailNumber));
  422.             if NthWord(ReplyMess, ' ', 1) = Cons_Err_Resp then raise Exception.create(ReplyMess);
  423.           end; {_ if FDeleteOnRead and not FAbort then _}
  424.         if FAbort then Transaction(Cons_Cmd_Rset)
  425.         else {_ NOT if FAbort then Transaction(Cons_Cmd_Rset) _}  StatusMessage(Status_Informational, sPOP_Cons_Msg_Retr);
  426.       finally
  427.         if assigned(FOnRetrieveEnd) then FOnRetrieveEnd(self);
  428.         FTransactionInProgress := FALSE;
  429.       end; {_ try _}
  430.     end; {_ if not FTransactionInProgress then _}
  431. end; {_ procedure TNMPOP3.GetMailMessage(MailNumber: integer); _}
  433. procedure TNMPOP3.Extract(InString: string; var OutString: string);
  434. var i: integer;
  435.   found: boolean;
  436. begin
  437.   CertifyConnect;
  438.   i := -1;
  439.   found := FALSE;
  440.   repeat
  441.     i := i + 1;
  442.     if (Pos(InString, FMailMessage.FHead[i]) > 0) then found := TRUE;
  443.   until found or (i = (FMailMessage.FHead.count - 1));
  444.   if found then OutString := Trim(Copy(FMailMessage.FHead[i], Pos(':', FMailMessage.FHead[i]) + 1, 255))
  445.   else {_ NOT if found then OutString := Trim(Copy(FMailMessage.FHead[i], Pos(':', FMailMessage.FHead[i]) + 1, 255)) _}  OutString := '';
  446. end; {_ procedure TNMPOP3.Extract(InString: string; var OutString: string); _}
  448. procedure TNMPOP3.Reset;
  449. var ReplyMess: string;
  450. begin
  451.   CertifyConnect;
  452.   ReplyMess := Transaction(Cons_Cmd_Rset);
  453.   if assigned(FOnReset) then FOnReset(self);
  454. end; {_ procedure TNMPOP3.Reset; _}
  456. procedure TNMPOP3.List;
  457. var ReplyMess: string;
  458. begin
  459.   if not FTransactionInProgress then
  460.     begin
  461.       FTransactionInProgress := TRUE;
  462.       try
  463.         CertifyConnect;
  464.         ReplyMess := Transaction(Cons_Cmd_List);
  465.         ReplyMess := Readln;
  466.         SetLength(ReplyMess, length(ReplyMess) - 2);
  467.         while (ReplyMess <> '.') do
  468.           begin
  469.             if assigned(FOnList) then FOnList(StrToInt(NthWord(ReplyMess, ' ', 1)), StrToInt(NthWord(ReplyMess, ' ', 2)));
  470.             ReplyMess := Readln;
  471.             SetLength(ReplyMess, length(ReplyMess) - 2);
  472.           end; {_ while (ReplyMess <> '.') do _}
  473.       finally
  474.         FTransactionInProgress := FALSE;
  475.       end; {_ try _}
  476.     end; {_ if not FTransactionInProgress then _}
  477. end; {_ procedure TNMPOP3.List; _}
  480. procedure TNMPOP3.ReadMailParts;
  481. var ReplyMess: string;
  482.   LastPart: boolean;
  483.   TemMessage: TMailMessage;
  484. begin
  485.    {Extract Boundary Information}
  486.   LastPart := FALSE;
  487.    {Read Till First Boundary}
  488.   TemMessage := TMailMessage.Create;
  489.   repeat
  490.     ReplyMess := FMailMessage.FRawBody[Readindex];
  491.     inc(Readindex);
  492.   until Pos(FMailMessage.FBoundary, ReplyMess) > 0;
  493.   repeat
  494.     if not FAbort then ReadHeader(true, TemMessage);
  495.     if not FAbort then LastPart := ReadBody(FMailMessage);
  496.   until (ReadIndex = FMailMessage.FRawBody.count) or (LastPart) or (FAbort) or (ReplyMess = '.' + #13#10);
  497.   TemMessage.Free;
  498.    {repeat
  499.       ReplyMess := readln;
  500.    until ReplyMess = '.' + #13#10; }
  501. end; {_ procedure TNMPOP3.ReadMailParts; _}
  503. procedure TNMPOP3.ReadHeader(Readfile: boolean; var MailMessage: TMailMessage);
  504. var ReplyMess: string;
  505. begin
  506.   repeat
  507.     if not FAbort then
  508.       begin
  509.         if ReadFile then
  510.           begin
  511.             if ReadIndex = FMailMessage.FRawBody.count then exit;
  512.             ReplyMess := FMailMessage.FRawBody[Readindex];
  513.             inc(Readindex);
  514.           end
  515.         else
  516.           begin
  517.             ReplyMess := ReadLn;
  518.             FBytesRecvd := FBytesRecvd + length(ReplyMess);
  519.             if assigned(OnPacketRecvd) then OnPacketRecvd(Self);
  520.             SetLength(ReplyMess, length(ReplyMess) - 2);
  521.           end;
  522.         if FFirstPart = 2 then FMailMessage.FHead.add(ReplyMess);
  523.         if (ReplyMess <> '') then
  524.           begin
  525.             if UpperCase(NthWord(ReplyMess, ' ', 1)) = Cons_Head_CSubj then
  526.               FMailMessage.Fsubject := Copy(ReplyMess, 9, 256);
  527.             if UpperCase(NthWord(ReplyMess, ' ', 1)) = Cons_Head_CFrom then
  528.               FMailMessage.FFrom := Copy(ReplyMess, 7, 256);
  529.             if UpperCase(NthWord(ReplyMess, ' ', 1)) = Cons_Head_CType then
  530.               FMailMessage.FContentType := Copy(ReplyMess, 15, 256);
  531.             if UpperCase(NthWord(ReplyMess, ' ', 1)) = Cons_Head_CMid then
  532.               FMailMessage.FMessageID := Copy(ReplyMess, 13, 256);
  533.             if Pos(Cons_Head_CBoun, UpperCase(ReplyMess)) > 0 then
  534.               begin
  535.                 MailMessage.FBoundary := Copy(ReplyMess, Pos(Cons_Head_CBoun, UpperCase(ReplyMess)) + 9, 256);
  536.                 if (MailMessage.FBoundary[1] = #22) then
  537.                   SetLength(MailMessage.FBoundary, Length(MailMessage.FBoundary) - 2)
  538.                 else {_ NOT if Boundary[1] = #22 then _}
  539.                   begin
  540.                     SetLength(MailMessage.FBoundary, Length(MailMessage.FBoundary) - 3);
  541.                     MailMessage.FBoundary := Copy(MailMessage.FBoundary, 2, 255);
  542.                   end; {_ NOT if Boundary[1] = #22 then _}
  543.               end;
  544.             if Pos(Cons_Head_CCTE, UpperCase(ReplyMess)) > 0 then
  545.               FContent_type := Copy(ReplyMess, 28, 256);
  546.             if (Pos(Cons_Head_FileN, UpperCase(ReplyMess)) > 0) or (Pos('NAME', UpperCase(ReplyMess)) > 0) then
  547.               FFilename := NthWord(ReplyMess, '"', 2);
  548.           end; {_ if (ReplyMess <> '') then _}
  549.       end; {_ if not FAbort then _}
  550.   until (ReplyMess = '') or FAbort;
  551.   if FFirstPart = 2 then FFirstPart := 1;
  552. end; {_ procedure TNMPOP3.ReadHeader; _}
  554. //BD 1-7-99 To support files with multiple .s
  556. function LastPos(StringSought, TheString: string): Integer;
  557. var
  558.   CurrentPos: Integer;
  559. begin
  560.   Result := 0;
  561.   while Pos(StringSought, TheString) > 0 do
  562.     begin
  563.       CurrentPos := Pos(StringSought, TheString) + Length(StringSought) - 1;
  564.       Result := Result + CurrentPos;
  565.       TheString := Copy(TheString, CurrentPos + 1, Length(TheString));
  566.     end;
  567.   if Result > 0 then
  568.     Result := Result - (Length(StringSought) - 1);
  569. end;
  570. //BD 1-7-99 To support files with multiple .s
  572. function TNMPOP3.ReadBody(var MailMessage: TMailMessage): boolean;
  573. var OutStream: TFileStream;
  574.   ReplyMess, TFname1, TFName2: string;
  575.   i: integer;
  576.   Ins, Ous: TFileStream;
  578. begin
  579.   try
  580.     result := FALSE;
  581.     OutStream := nil;
  582.    {if FFirstPart=1 then if (FContenttype<>'') and (pos('ascii',FContenttype)=0) then FFirstPart:=0;  }
  583.     if FFirstPart = 0 then
  584.       begin
  585.         inc(TFileIndex);
  586.         OutStream := TFileStream.create(FAttachFilePath + 'Temp' + IntToStr(TFileIndex) + '.mme', fmCreate);
  587.       end; {_ if FFirstPart = 0 then _}
  588.     StatusMessage(Status_Informational, sPOP_Cons_Msg_ExtrF);
  589.     if ReadIndex = FMailMessage.FRawBody.count then exit;
  590.     ReplyMess := FMailMessage.FRawBody[Readindex];
  591.     inc(Readindex);
  592.     while (Readindex <> FMailMessage.FRawBody.count) and (Pos(MailMessage.FBoundary, ReplyMess) = 0) and (ReplyMess <> '.' + #13#10) and (not FAbort) do
  593.       begin
  594.         if FFirstPart > 0 then
  595.           begin
  596.          //SetLength(ReplyMess, length(ReplyMess) - 2);
  597.             FMailMessage.FBody.add(ReplyMess);
  598.           end {_ if FFirstPart > 0 then _}
  599.         else {_ NOT if FFirstPart > 0 then _} {FMailMessage.FBody.add(ReplyMess);}
  600.           begin
  601.             ReplyMess := ReplyMess + CRLF;
  602.             OutStream.WriteBuffer(ReplyMess[1], length(ReplyMess));
  603.           end;
  604.         ReplyMess := FMailMessage.FRawBody[Readindex];
  605.         inc(Readindex);
  606.       end;
  607.     if not Fabort and (FFirstPart = 0) and (OutStream.size > 0) then
  608.       begin
  609.         OutStream.Free;
  610.         if FFileName = '' then FFileName := 'text.tmp';
  611.         TFName1 := Copy(FFileName, 1, LastPos('.', FFileName) - 1);
  612.         TFName2 := Copy(FFileName, Length(TFName1) + 2, Length(FFileName));
  613.         i := 1;
  614.         while FileExists(FAttachFilePath + FFileName) do
  615.           begin
  616.             FFileName := TFName1 + '_' + IntToStr(i) + '.' + TFName2;
  617.             i := i + 1;
  618.           end; {_ while FileExists(FAttachFilePath + FFileName) do _}
  620.       // Modification made by Edward T. Smith Sep 09 1998
  621.         if assigned(FOnDecodeStart) then
  622.           FOnDecodeStart(FFileName);
  623.       // End
  624.         FMailMessage.FBody.add(#13#10 + sPOP_Cons_Msg_File + FFileName + sPOP_Cons_Msg_Extr);
  625.         FMailMessage.FAttachments.Add(FFileName);
  626.         FMailMessage.FContentTypes.Add(FMailMessage.Contenttype);
  627.         if (Pos(Cons_Head_B641, Lowercase(FContent_type)) > 0) or (Pos(Cons_Head_UUEn, FContent_type) > 0) then
  628.           begin
  629.             Ins := TFileStream.create(FAttachFilePath + 'Temp' + IntToStr(TFileIndex) + '.mme', fmOpenRead);
  630.             Ous := TFileStream.create(FAttachFilePath + FFilename, fmCreate);
  631.             try
  632.               NMUUProcessor1.InputStream := Ins;
  633.               NMUUProcessor1.OutputStream := Ous;
  634.               if (Pos(Cons_Head_UUEn, FContent_type) > 0) then NMUUProcessor1.method := UUCode else NMUUProcessor1.method := UUMime;
  635.               StatusMessage(Status_Informational, sPOP_Cons_Msg_Deco);
  636.               if ins.size <> 0 then NMUUProcessor1.Decode;
  637.             finally
  638.               Ins.free;
  639.               Ous.free;
  640.             end; {_ try _}
  641.           end {_ if (Pos(Cons_Head_B641, FContent_type) > 0) or (Pos(Cons_Head_B642, FContent_type) > 0) or (Pos(Cons_Head_UUEn, FContent_type) > 0) then _}
  642.         else {_ NOT if (Pos(Cons_Head_B641, FContent_type) > 0) or (Pos(Cons_Head_B642, FContent_type) > 0) or (Pos(Cons_Head_UUEn, FContent_type) > 0) then _}
  643.           begin
  644.             if FileExists(FAttachFilePath + FFilename) then DeleteFile(FAttachFilePath + FFilename);
  645.             RenameFile(FAttachFilePath + 'Temp' + IntToStr(TFileIndex) + '.mme', FAttachFilePath + FFilename);
  646.           end;
  647.       end; {_ if not Fabort and (FFirstPart = 0) then _}
  648.     if (Pos(MailMessage.FBoundary, ReplyMess) > 0) then
  649.       begin
  650.         ReplyMess := Copy(ReplyMess, Length(ReplyMess) - 3, 256);
  651.         if Pos('--', ReplyMess) > 0 then result := true;
  652.       end; {_ if (Pos(FBoundary, ReplyMess) > 0) then _}
  653.     FFirstPart := 0;
  654.   finally
  655.     if FileExists(FAttachFilePath + 'Temp' + IntToStr(TFileIndex) + '.mme') then Deletefile(FAttachFilePath + 'Temp' + IntToStr(TFileIndex) + '.mme');
  656.   end;
  657. end; {_ function TNMPOP3.ReadBody: boolean; _}
  659. procedure TNMPOP3.DeleteMailMessage(MailNumber: integer);
  660. var ReplyMess: string;
  661.   Done: boolean;
  662. begin
  663.   if not FTransactionInProgress then
  664.     begin
  665.       Done := FALSE;
  666.       FTransactionInProgress := TRUE;
  667.       try
  668.         CertifyConnect;
  669.         ReplyMess := Transaction(Cons_Cmd_Dele + IntToStr(MailNumber));
  670.         if NthWord(ReplyMess, ' ', 1) = Cons_Err_Resp then
  671.           begin
  672.             if assigned(FOnFailure) then FOnFailure(self);
  673.             raise Exception.create(ReplyMess);
  674.           end {_ if NthWord(ReplyMess, ' ', 1) <> Cons_OK_Resp then _}
  675.         else {_ NOT if NthWord(ReplyMess, ' ', 1) <> Cons_OK_Resp then _}  Done := TRUE;
  676.       finally
  677.         FTransactionInProgress := FALSE;
  678.         if Done then
  679.           if assigned(FOnSuccess) then
  680.             FOnSuccess(self);
  681.       end; {_ try _}
  682.     end; {_ if not FTransactionInProgress then _}
  683. end; {_ procedure TNMPOP3.DeleteMailMessage(MailNumber: integer); _}
  686. function TNMPOP3.UniqueID(MailNumber: integer): string;
  687. var ReplyMess: string;
  688. begin
  689.   if not FTransactionInProgress then
  690.     begin
  691.       Result := '';
  692.       FTransactionInProgress := TRUE;
  693.       try
  694.         CertifyConnect;
  695.         ReplyMess := Transaction(Cons_Cmd_Uidl + IntToStr(MailNumber));
  696.         if NthWord(ReplyMess, ' ', 1) <> Cons_OK_Resp then
  697.           begin
  698.             if assigned(FOnFailure) then FOnFailure(self);
  699.             raise Exception.create(ReplyMess);
  700.           end {_ if NthWord(ReplyMess, ' ', 1) <> Cons_OK_Resp then _}
  701.         else {_ NOT if NthWord(ReplyMess, ' ', 1) <> Cons_OK_Resp then _}
  702.           Result := NthWord(ReplyMess, ' ', 3);
  703.       finally
  704.         FTransactionInProgress := FALSE;
  705.       end; {_ try _}
  706.     end; {_ if not FTransactionInProgress then _}
  707. end;
  709. procedure TNMPOP3.Abort;
  710. begin
  711.   Cancel;
  712.   if Connected then
  713.     begin
  714.       //if FTransactionInProgress then
  715.       //begin
  716.       //   Cancel;
  717.       //end {_ if FTransactionInProgress then _}
  718.       //else {_ NOT if FTransactionInProgress then _}
  719.       //begin
  720.       inherited Disconnect;
  721.       ClearInput;
  722.       //end; {_ NOT if FTransactionInProgress then _}
  723.     end; {_ if (not BeenCanceled) and Connected then _}
  724. end; {_ procedure TNMPOP3.Abort; _}
  727. procedure TNMPOP3.AbortResume(Sender: TObject);
  728. begin
  729.    //inherited Disconnect;
  730.    //TMemoryStream(FIstream).clear;
  731. end; {_ procedure TNMPOP3.AbortResume(Sender: TObject); _}
  733. constructor TMailMessage.create;
  734. begin
  735.   FHead := TExStringList.create;
  736.   FBody := TStringList.create;
  737.   FAttachments := TStringList.create;
  738.   FContentTypes := TStringList.create;
  739.   FRawBody := TStringList.create;
  740.   FPartHeaders := Tlist.Create;
  741. end; {_ constructor TMailMessage.create; _}
  743. destructor TMailMessage.destroy;
  744. begin
  745.   FHead.free;
  746.   FBody.free;
  747.   FAttachments.free;
  748.   FContentTypes.free;
  749.   FRawBody.free;
  750.   FPartHeaders.free;
  751. end; {_ destructor TMailMessage.destroy; _}
  753. end.