source: trunk/Packages/synapse/source/lib/pop3send.pas

Last change on this file was 2, checked in by chronos, 13 years ago
  • Přidáno: Základní kostra projektu.
  • Přidáno: Knihovna synapse.
File size: 15.2 KB
Line 
1{==============================================================================|
2| Project : Ararat Synapse | 002.006.002 |
3|==============================================================================|
4| Content: POP3 client |
5|==============================================================================|
6| Copyright (c)1999-2010, Lukas Gebauer |
7| All rights reserved. |
8| |
9| Redistribution and use in source and binary forms, with or without |
10| modification, are permitted provided that the following conditions are met: |
11| |
12| Redistributions of source code must retain the above copyright notice, this |
13| list of conditions and the following disclaimer. |
14| |
15| Redistributions in binary form must reproduce the above copyright notice, |
16| this list of conditions and the following disclaimer in the documentation |
17| and/or other materials provided with the distribution. |
18| |
19| Neither the name of Lukas Gebauer nor the names of its contributors may |
20| be used to endorse or promote products derived from this software without |
21| specific prior written permission. |
22| |
23| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
24| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
25| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
26| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
27| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
28| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
29| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
30| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
31| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
32| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
33| DAMAGE. |
34|==============================================================================|
35| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
36| Portions created by Lukas Gebauer are Copyright (c)2001-2010. |
37| All Rights Reserved. |
38|==============================================================================|
39| Contributor(s): |
40|==============================================================================|
41| History: see HISTORY.HTM from distribution package |
42| (Found at URL: http://www.ararat.cz/synapse/) |
43|==============================================================================}
44
45{:@abstract(POP3 protocol client)
46
47Used RFC: RFC-1734, RFC-1939, RFC-2195, RFC-2449, RFC-2595
48}
49
50{$IFDEF FPC}
51 {$MODE DELPHI}
52{$ENDIF}
53{$H+}
54{$M+}
55
56{$IFDEF UNICODE}
57 {$WARN IMPLICIT_STRING_CAST OFF}
58 {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
59{$ENDIF}
60
61unit pop3send;
62
63interface
64
65uses
66 SysUtils, Classes,
67 blcksock, synautil, synacode;
68
69const
70 cPop3Protocol = '110';
71
72type
73
74 {:The three types of possible authorization methods for "logging in" to a POP3
75 server.}
76 TPOP3AuthType = (POP3AuthAll, POP3AuthLogin, POP3AuthAPOP);
77
78 {:@abstract(Implementation of POP3 client protocol.)
79
80 Note: Are you missing properties for setting Username and Password? Look to
81 parent @link(TSynaClient) object!
82
83 Are you missing properties for specify server address and port? Look to
84 parent @link(TSynaClient) too!}
85 TPOP3Send = class(TSynaClient)
86 private
87 FSock: TTCPBlockSocket;
88 FResultCode: Integer;
89 FResultString: string;
90 FFullResult: TStringList;
91 FStatCount: Integer;
92 FStatSize: Integer;
93 FListSize: Integer;
94 FTimeStamp: string;
95 FAuthType: TPOP3AuthType;
96 FPOP3cap: TStringList;
97 FAutoTLS: Boolean;
98 FFullSSL: Boolean;
99 function ReadResult(Full: Boolean): Integer;
100 function Connect: Boolean;
101 function AuthLogin: Boolean;
102 function AuthApop: Boolean;
103 public
104 constructor Create;
105 destructor Destroy; override;
106
107 {:You can call any custom by this method. Call Command without trailing CRLF.
108 If MultiLine parameter is @true, multilined response are expected.
109 Result is @true on sucess.}
110 function CustomCommand(const Command: string; MultiLine: Boolean): boolean;
111
112 {:Call CAPA command for get POP3 server capabilites.
113 note: not all servers support this command!}
114 function Capability: Boolean;
115
116 {:Connect to remote POP3 host. If all OK, result is @true.}
117 function Login: Boolean;
118
119 {:Disconnects from POP3 server.}
120 function Logout: Boolean;
121
122 {:Send RSET command. If all OK, result is @true.}
123 function Reset: Boolean;
124
125 {:Send NOOP command. If all OK, result is @true.}
126 function NoOp: Boolean;
127
128 {:Send STAT command and fill @link(StatCount) and @link(StatSize) property.
129 If all OK, result is @true.}
130 function Stat: Boolean;
131
132 {:Send LIST command. If Value is 0, LIST is for all messages. After
133 successful operation is listing in FullResult. If all OK, result is @True.}
134 function List(Value: Integer): Boolean;
135
136 {:Send RETR command. After successful operation dowloaded message in
137 @link(FullResult). If all OK, result is @true.}
138 function Retr(Value: Integer): Boolean;
139
140 {:Send RETR command. After successful operation dowloaded message in
141 @link(Stream). If all OK, result is @true.}
142 function RetrStream(Value: Integer; Stream: TStream): Boolean;
143
144 {:Send DELE command for delete specified message. If all OK, result is @true.}
145 function Dele(Value: Integer): Boolean;
146
147 {:Send TOP command. After successful operation dowloaded headers of message
148 and maxlines count of message in @link(FullResult). If all OK, result is
149 @true.}
150 function Top(Value, Maxlines: Integer): Boolean;
151
152 {:Send UIDL command. If Value is 0, UIDL is for all messages. After
153 successful operation is listing in FullResult. If all OK, result is @True.}
154 function Uidl(Value: Integer): Boolean;
155
156 {:Call STLS command for upgrade connection to SSL/TLS mode.}
157 function StartTLS: Boolean;
158
159 {:Try to find given capabily in capabilty string returned from POP3 server
160 by CAPA command.}
161 function FindCap(const Value: string): string;
162 published
163 {:Result code of last POP3 operation. 0 - error, 1 - OK.}
164 property ResultCode: Integer read FResultCode;
165
166 {:Result string of last POP3 operation.}
167 property ResultString: string read FResultString;
168
169 {:Stringlist with full lines returned as result of POP3 operation. I.e. if
170 operation is LIST, this property is filled by list of messages. If
171 operation is RETR, this property have downloaded message.}
172 property FullResult: TStringList read FFullResult;
173
174 {:After STAT command is there count of messages in inbox.}
175 property StatCount: Integer read FStatCount;
176
177 {:After STAT command is there size of all messages in inbox.}
178 property StatSize: Integer read FStatSize;
179
180 {:After LIST 0 command size of all messages on server, After LIST x size of message x on server}
181 property ListSize: Integer read FListSize;
182
183 {:If server support this, after comnnect is in this property timestamp of
184 remote server.}
185 property TimeStamp: string read FTimeStamp;
186
187 {:Type of authorisation for login to POP3 server. Dafault is autodetect one
188 of possible authorisation. Autodetect do this:
189
190 If remote POP3 server support APOP, try login by APOP method. If APOP is
191 not supported, or if APOP login failed, try classic USER+PASS login method.}
192 property AuthType: TPOP3AuthType read FAuthType Write FAuthType;
193
194 {:If is set to @true, then upgrade to SSL/TLS mode if remote server support it.}
195 property AutoTLS: Boolean read FAutoTLS Write FAutoTLS;
196
197 {:SSL/TLS mode is used from first contact to server. Servers with full
198 SSL/TLS mode usualy using non-standard TCP port!}
199 property FullSSL: Boolean read FFullSSL Write FFullSSL;
200 {:Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.}
201 property Sock: TTCPBlockSocket read FSock;
202 end;
203
204implementation
205
206constructor TPOP3Send.Create;
207begin
208 inherited Create;
209 FFullResult := TStringList.Create;
210 FPOP3cap := TStringList.Create;
211 FSock := TTCPBlockSocket.Create;
212 FSock.Owner := self;
213 FSock.ConvertLineEnd := true;
214 FTimeout := 60000;
215 FTargetPort := cPop3Protocol;
216 FStatCount := 0;
217 FStatSize := 0;
218 FListSize := 0;
219 FAuthType := POP3AuthAll;
220 FAutoTLS := False;
221 FFullSSL := False;
222end;
223
224destructor TPOP3Send.Destroy;
225begin
226 FSock.Free;
227 FPOP3cap.Free;
228 FullResult.Free;
229 inherited Destroy;
230end;
231
232function TPOP3Send.ReadResult(Full: Boolean): Integer;
233var
234 s: AnsiString;
235begin
236 Result := 0;
237 FFullResult.Clear;
238 s := FSock.RecvString(FTimeout);
239 if Pos('+OK', s) = 1 then
240 Result := 1;
241 FResultString := s;
242 if Full and (Result = 1) then
243 repeat
244 s := FSock.RecvString(FTimeout);
245 if s = '.' then
246 Break;
247 if s <> '' then
248 if s[1] = '.' then
249 Delete(s, 1, 1);
250 FFullResult.Add(s);
251 until FSock.LastError <> 0;
252 if not Full and (Result = 1) then
253 FFullResult.Add(SeparateRight(FResultString, ' '));
254 if FSock.LastError <> 0 then
255 Result := 0;
256 FResultCode := Result;
257end;
258
259function TPOP3Send.CustomCommand(const Command: string; MultiLine: Boolean): boolean;
260begin
261 FSock.SendString(Command + CRLF);
262 Result := ReadResult(MultiLine) <> 0;
263end;
264
265function TPOP3Send.AuthLogin: Boolean;
266begin
267 Result := False;
268 if not CustomCommand('USER ' + FUserName, False) then
269 exit;
270 Result := CustomCommand('PASS ' + FPassword, False)
271end;
272
273function TPOP3Send.AuthAPOP: Boolean;
274var
275 s: string;
276begin
277 s := StrToHex(MD5(FTimeStamp + FPassWord));
278 Result := CustomCommand('APOP ' + FUserName + ' ' + s, False);
279end;
280
281function TPOP3Send.Connect: Boolean;
282begin
283 // Do not call this function! It is calling by LOGIN method!
284 FStatCount := 0;
285 FStatSize := 0;
286 FSock.CloseSocket;
287 FSock.LineBuffer := '';
288 FSock.Bind(FIPInterface, cAnyPort);
289 if FSock.LastError = 0 then
290 FSock.Connect(FTargetHost, FTargetPort);
291 if FSock.LastError = 0 then
292 if FFullSSL then
293 FSock.SSLDoConnect;
294 Result := FSock.LastError = 0;
295end;
296
297function TPOP3Send.Capability: Boolean;
298begin
299 FPOP3cap.Clear;
300 Result := CustomCommand('CAPA', True);
301 if Result then
302 FPOP3cap.AddStrings(FFullResult);
303end;
304
305function TPOP3Send.Login: Boolean;
306var
307 s, s1: string;
308begin
309 Result := False;
310 FTimeStamp := '';
311 if not Connect then
312 Exit;
313 if ReadResult(False) <> 1 then
314 Exit;
315 s := SeparateRight(FResultString, '<');
316 if s <> FResultString then
317 begin
318 s1 := Trim(SeparateLeft(s, '>'));
319 if s1 <> s then
320 FTimeStamp := '<' + s1 + '>';
321 end;
322 Result := False;
323 if Capability then
324 if FAutoTLS and (Findcap('STLS') <> '') then
325 if StartTLS then
326 Capability
327 else
328 begin
329 Result := False;
330 Exit;
331 end;
332 if (FTimeStamp <> '') and not (FAuthType = POP3AuthLogin) then
333 begin
334 Result := AuthApop;
335 if not Result then
336 begin
337 if not Connect then
338 Exit;
339 if ReadResult(False) <> 1 then
340 Exit;
341 end;
342 end;
343 if not Result and not (FAuthType = POP3AuthAPOP) then
344 Result := AuthLogin;
345end;
346
347function TPOP3Send.Logout: Boolean;
348begin
349 Result := CustomCommand('QUIT', False);
350 FSock.CloseSocket;
351end;
352
353function TPOP3Send.Reset: Boolean;
354begin
355 Result := CustomCommand('RSET', False);
356end;
357
358function TPOP3Send.NoOp: Boolean;
359begin
360 Result := CustomCommand('NOOP', False);
361end;
362
363function TPOP3Send.Stat: Boolean;
364var
365 s: string;
366begin
367 Result := CustomCommand('STAT', False);
368 if Result then
369 begin
370 s := SeparateRight(ResultString, '+OK ');
371 FStatCount := StrToIntDef(Trim(SeparateLeft(s, ' ')), 0);
372 FStatSize := StrToIntDef(Trim(SeparateRight(s, ' ')), 0);
373 end;
374end;
375
376function TPOP3Send.List(Value: Integer): Boolean;
377var
378 s: string;
379 n: integer;
380begin
381 if Value = 0 then
382 s := 'LIST'
383 else
384 s := 'LIST ' + IntToStr(Value);
385 Result := CustomCommand(s, Value = 0);
386 FListSize := 0;
387 if Result then
388 if Value <> 0 then
389 begin
390 s := SeparateRight(ResultString, '+OK ');
391 FListSize := StrToIntDef(SeparateLeft(SeparateRight(s, ' '), ' '), 0);
392 end
393 else
394 for n := 0 to FFullResult.Count - 1 do
395 FListSize := FListSize + StrToIntDef(SeparateLeft(SeparateRight(s, ' '), ' '), 0);
396end;
397
398function TPOP3Send.Retr(Value: Integer): Boolean;
399begin
400 Result := CustomCommand('RETR ' + IntToStr(Value), True);
401end;
402
403//based on code by Miha Vrhovnik
404function TPOP3Send.RetrStream(Value: Integer; Stream: TStream): Boolean;
405var
406 s: string;
407begin
408 Result := False;
409 FFullResult.Clear;
410 Stream.Size := 0;
411 FSock.SendString('RETR ' + IntToStr(Value) + CRLF);
412
413 s := FSock.RecvString(FTimeout);
414 if Pos('+OK', s) = 1 then
415 Result := True;
416 FResultString := s;
417 if Result then begin
418 repeat
419 s := FSock.RecvString(FTimeout);
420 if s = '.' then
421 Break;
422 if s <> '' then begin
423 if s[1] = '.' then
424 Delete(s, 1, 1);
425 end;
426 WriteStrToStream(Stream, s);
427 WriteStrToStream(Stream, CRLF);
428 until FSock.LastError <> 0;
429 end;
430
431 if Result then
432 FResultCode := 1
433 else
434 FResultCode := 0;
435end;
436
437function TPOP3Send.Dele(Value: Integer): Boolean;
438begin
439 Result := CustomCommand('DELE ' + IntToStr(Value), False);
440end;
441
442function TPOP3Send.Top(Value, Maxlines: Integer): Boolean;
443begin
444 Result := CustomCommand('TOP ' + IntToStr(Value) + ' ' + IntToStr(Maxlines), True);
445end;
446
447function TPOP3Send.Uidl(Value: Integer): Boolean;
448var
449 s: string;
450begin
451 if Value = 0 then
452 s := 'UIDL'
453 else
454 s := 'UIDL ' + IntToStr(Value);
455 Result := CustomCommand(s, Value = 0);
456end;
457
458function TPOP3Send.StartTLS: Boolean;
459begin
460 Result := False;
461 if CustomCommand('STLS', False) then
462 begin
463 Fsock.SSLDoConnect;
464 Result := FSock.LastError = 0;
465 end;
466end;
467
468function TPOP3Send.FindCap(const Value: string): string;
469var
470 n: Integer;
471 s: string;
472begin
473 s := UpperCase(Value);
474 Result := '';
475 for n := 0 to FPOP3cap.Count - 1 do
476 if Pos(s, UpperCase(FPOP3cap[n])) = 1 then
477 begin
478 Result := FPOP3cap[n];
479 Break;
480 end;
481end;
482
483end.
Note: See TracBrowser for help on using the repository browser.