source: trunk/Packages/synapse/pop3send.pas

Last change on this file was 5, checked in by chronos, 13 years ago
  • Added: Required packages.
File size: 15.1 KB
Line 
1{==============================================================================|
2| Project : Ararat Synapse | 002.006.000 |
3|==============================================================================|
4| Content: POP3 client |
5|==============================================================================|
6| Copyright (c)1999-2007, 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-2007. |
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
55unit pop3send;
56
57interface
58
59uses
60 SysUtils, Classes,
61 blcksock, synautil, synacode;
62
63const
64 cPop3Protocol = '110';
65
66type
67
68 {:The three types of possible authorization methods for "logging in" to a POP3
69 server.}
70 TPOP3AuthType = (POP3AuthAll, POP3AuthLogin, POP3AuthAPOP);
71
72 {:@abstract(Implementation of POP3 client protocol.)
73
74 Note: Are you missing properties for setting Username and Password? Look to
75 parent @link(TSynaClient) object!
76
77 Are you missing properties for specify server address and port? Look to
78 parent @link(TSynaClient) too!}
79 TPOP3Send = class(TSynaClient)
80 private
81 FSock: TTCPBlockSocket;
82 FResultCode: Integer;
83 FResultString: string;
84 FFullResult: TStringList;
85 FStatCount: Integer;
86 FStatSize: Integer;
87 FListSize: Integer;
88 FTimeStamp: string;
89 FAuthType: TPOP3AuthType;
90 FPOP3cap: TStringList;
91 FAutoTLS: Boolean;
92 FFullSSL: Boolean;
93 function ReadResult(Full: Boolean): Integer;
94 function Connect: Boolean;
95 function AuthLogin: Boolean;
96 function AuthApop: Boolean;
97 public
98 constructor Create;
99 destructor Destroy; override;
100
101 {:You can call any custom by this method. Call Command without trailing CRLF.
102 If MultiLine parameter is @true, multilined response are expected.
103 Result is @true on sucess.}
104 function CustomCommand(const Command: string; MultiLine: Boolean): boolean;
105
106 {:Call CAPA command for get POP3 server capabilites.
107 note: not all servers support this command!}
108 function Capability: Boolean;
109
110 {:Connect to remote POP3 host. If all OK, result is @true.}
111 function Login: Boolean;
112
113 {:Disconnects from POP3 server.}
114 function Logout: Boolean;
115
116 {:Send RSET command. If all OK, result is @true.}
117 function Reset: Boolean;
118
119 {:Send NOOP command. If all OK, result is @true.}
120 function NoOp: Boolean;
121
122 {:Send STAT command and fill @link(StatCount) and @link(StatSize) property.
123 If all OK, result is @true.}
124 function Stat: Boolean;
125
126 {:Send LIST command. If Value is 0, LIST is for all messages. After
127 successful operation is listing in FullResult. If all OK, result is @True.}
128 function List(Value: Integer): Boolean;
129
130 {:Send RETR command. After successful operation dowloaded message in
131 @link(FullResult). If all OK, result is @true.}
132 function Retr(Value: Integer): Boolean;
133
134 {:Send RETR command. After successful operation dowloaded message in
135 @link(Stream). If all OK, result is @true.}
136 function RetrStream(Value: Integer; Stream: TStream): Boolean;
137
138 {:Send DELE command for delete specified message. If all OK, result is @true.}
139 function Dele(Value: Integer): Boolean;
140
141 {:Send TOP command. After successful operation dowloaded headers of message
142 and maxlines count of message in @link(FullResult). If all OK, result is
143 @true.}
144 function Top(Value, Maxlines: Integer): Boolean;
145
146 {:Send UIDL command. If Value is 0, UIDL is for all messages. After
147 successful operation is listing in FullResult. If all OK, result is @True.}
148 function Uidl(Value: Integer): Boolean;
149
150 {:Call STLS command for upgrade connection to SSL/TLS mode.}
151 function StartTLS: Boolean;
152
153 {:Try to find given capabily in capabilty string returned from POP3 server
154 by CAPA command.}
155 function FindCap(const Value: string): string;
156 published
157 {:Result code of last POP3 operation. 0 - error, 1 - OK.}
158 property ResultCode: Integer read FResultCode;
159
160 {:Result string of last POP3 operation.}
161 property ResultString: string read FResultString;
162
163 {:Stringlist with full lines returned as result of POP3 operation. I.e. if
164 operation is LIST, this property is filled by list of messages. If
165 operation is RETR, this property have downloaded message.}
166 property FullResult: TStringList read FFullResult;
167
168 {:After STAT command is there count of messages in inbox.}
169 property StatCount: Integer read FStatCount;
170
171 {:After STAT command is there size of all messages in inbox.}
172 property StatSize: Integer read FStatSize;
173
174 {:After LIST 0 command size of all messages on server, After LIST x size of message x on server}
175 property ListSize: Integer read FListSize;
176
177 {:If server support this, after comnnect is in this property timestamp of
178 remote server.}
179 property TimeStamp: string read FTimeStamp;
180
181 {:Type of authorisation for login to POP3 server. Dafault is autodetect one
182 of possible authorisation. Autodetect do this:
183
184 If remote POP3 server support APOP, try login by APOP method. If APOP is
185 not supported, or if APOP login failed, try classic USER+PASS login method.}
186 property AuthType: TPOP3AuthType read FAuthType Write FAuthType;
187
188 {:If is set to @true, then upgrade to SSL/TLS mode if remote server support it.}
189 property AutoTLS: Boolean read FAutoTLS Write FAutoTLS;
190
191 {:SSL/TLS mode is used from first contact to server. Servers with full
192 SSL/TLS mode usualy using non-standard TCP port!}
193 property FullSSL: Boolean read FFullSSL Write FFullSSL;
194 {:Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.}
195 property Sock: TTCPBlockSocket read FSock;
196 end;
197
198implementation
199
200constructor TPOP3Send.Create;
201begin
202 inherited Create;
203 FFullResult := TStringList.Create;
204 FPOP3cap := TStringList.Create;
205 FSock := TTCPBlockSocket.Create;
206 FSock.ConvertLineEnd := true;
207 FTimeout := 60000;
208 FTargetPort := cPop3Protocol;
209 FStatCount := 0;
210 FStatSize := 0;
211 FListSize := 0;
212 FAuthType := POP3AuthAll;
213 FAutoTLS := False;
214 FFullSSL := False;
215end;
216
217destructor TPOP3Send.Destroy;
218begin
219 FSock.Free;
220 FPOP3cap.Free;
221 FullResult.Free;
222 inherited Destroy;
223end;
224
225function TPOP3Send.ReadResult(Full: Boolean): Integer;
226var
227 s: string;
228begin
229 Result := 0;
230 FFullResult.Clear;
231 s := FSock.RecvString(FTimeout);
232 if Pos('+OK', s) = 1 then
233 Result := 1;
234 FResultString := s;
235 if Full and (Result = 1) then
236 repeat
237 s := FSock.RecvString(FTimeout);
238 if s = '.' then
239 Break;
240 if s <> '' then
241 if s[1] = '.' then
242 Delete(s, 1, 1);
243 FFullResult.Add(s);
244 until FSock.LastError <> 0;
245 if not Full and (Result = 1) then
246 FFullResult.Add(SeparateRight(FResultString, ' '));
247 if FSock.LastError <> 0 then
248 Result := 0;
249 FResultCode := Result;
250end;
251
252function TPOP3Send.CustomCommand(const Command: string; MultiLine: Boolean): boolean;
253begin
254 FSock.SendString(Command + CRLF);
255 Result := ReadResult(MultiLine) <> 0;
256end;
257
258function TPOP3Send.AuthLogin: Boolean;
259begin
260 Result := False;
261 if not CustomCommand('USER ' + FUserName, False) then
262 exit;
263 Result := CustomCommand('PASS ' + FPassword, False)
264end;
265
266function TPOP3Send.AuthAPOP: Boolean;
267var
268 s: string;
269begin
270 s := StrToHex(MD5(FTimeStamp + FPassWord));
271 Result := CustomCommand('APOP ' + FUserName + ' ' + s, False);
272end;
273
274function TPOP3Send.Connect: Boolean;
275begin
276 // Do not call this function! It is calling by LOGIN method!
277 FStatCount := 0;
278 FStatSize := 0;
279 FSock.CloseSocket;
280 FSock.LineBuffer := '';
281 FSock.Bind(FIPInterface, cAnyPort);
282 if FSock.LastError = 0 then
283 FSock.Connect(FTargetHost, FTargetPort);
284 if FSock.LastError = 0 then
285 if FFullSSL then
286 FSock.SSLDoConnect;
287 Result := FSock.LastError = 0;
288end;
289
290function TPOP3Send.Capability: Boolean;
291begin
292 FPOP3cap.Clear;
293 Result := CustomCommand('CAPA', True);
294 if Result then
295 FPOP3cap.AddStrings(FFullResult);
296end;
297
298function TPOP3Send.Login: Boolean;
299var
300 s, s1: string;
301begin
302 Result := False;
303 FTimeStamp := '';
304 if not Connect then
305 Exit;
306 if ReadResult(False) <> 1 then
307 Exit;
308 s := SeparateRight(FResultString, '<');
309 if s <> FResultString then
310 begin
311 s1 := Trim(SeparateLeft(s, '>'));
312 if s1 <> s then
313 FTimeStamp := '<' + s1 + '>';
314 end;
315 Result := False;
316 if Capability then
317 if FAutoTLS and (Findcap('STLS') <> '') then
318 if StartTLS then
319 Capability
320 else
321 begin
322 Result := False;
323 Exit;
324 end;
325 if (FTimeStamp <> '') and not (FAuthType = POP3AuthLogin) then
326 begin
327 Result := AuthApop;
328 if not Result then
329 begin
330 if not Connect then
331 Exit;
332 if ReadResult(False) <> 1 then
333 Exit;
334 end;
335 end;
336 if not Result and not (FAuthType = POP3AuthAPOP) then
337 Result := AuthLogin;
338end;
339
340function TPOP3Send.Logout: Boolean;
341begin
342 Result := CustomCommand('QUIT', False);
343 FSock.CloseSocket;
344end;
345
346function TPOP3Send.Reset: Boolean;
347begin
348 Result := CustomCommand('RSET', False);
349end;
350
351function TPOP3Send.NoOp: Boolean;
352begin
353 Result := CustomCommand('NOOP', False);
354end;
355
356function TPOP3Send.Stat: Boolean;
357var
358 s: string;
359begin
360 Result := CustomCommand('STAT', False);
361 if Result then
362 begin
363 s := SeparateRight(ResultString, '+OK ');
364 FStatCount := StrToIntDef(Trim(SeparateLeft(s, ' ')), 0);
365 FStatSize := StrToIntDef(Trim(SeparateRight(s, ' ')), 0);
366 end;
367end;
368
369function TPOP3Send.List(Value: Integer): Boolean;
370var
371 s: string;
372 n: integer;
373begin
374 if Value = 0 then
375 s := 'LIST'
376 else
377 s := 'LIST ' + IntToStr(Value);
378 Result := CustomCommand(s, Value = 0);
379 FListSize := 0;
380 if Result then
381 if Value <> 0 then
382 begin
383 s := SeparateRight(ResultString, '+OK ');
384 FListSize := StrToIntDef(SeparateLeft(SeparateRight(s, ' '), ' '), 0);
385 end
386 else
387 for n := 0 to FFullResult.Count - 1 do
388 FListSize := FListSize + StrToIntDef(SeparateLeft(SeparateRight(s, ' '), ' '), 0);
389end;
390
391function TPOP3Send.Retr(Value: Integer): Boolean;
392begin
393 Result := CustomCommand('RETR ' + IntToStr(Value), True);
394end;
395
396//based on code by Miha Vrhovnik
397function TPOP3Send.RetrStream(Value: Integer; Stream: TStream): Boolean;
398var
399 s: string;
400begin
401 Result := False;
402 FFullResult.Clear;
403 Stream.Size := 0;
404 FSock.SendString('RETR ' + IntToStr(Value) + CRLF);
405
406 s := FSock.RecvString(FTimeout);
407 if Pos('+OK', s) = 1 then
408 Result := True;
409 FResultString := s;
410 if Result then begin
411 repeat
412 s := FSock.RecvString(FTimeout);
413 if s = '.' then
414 Break;
415 if s <> '' then begin
416 if s[1] = '.' then
417 Delete(s, 1, 1);
418 end;
419 WriteStrToStream(Stream, s);
420 WriteStrToStream(Stream, CRLF);
421 until FSock.LastError <> 0;
422 end;
423
424 if Result then
425 FResultCode := 1
426 else
427 FResultCode := 0;
428end;
429
430function TPOP3Send.Dele(Value: Integer): Boolean;
431begin
432 Result := CustomCommand('DELE ' + IntToStr(Value), False);
433end;
434
435function TPOP3Send.Top(Value, Maxlines: Integer): Boolean;
436begin
437 Result := CustomCommand('TOP ' + IntToStr(Value) + ' ' + IntToStr(Maxlines), True);
438end;
439
440function TPOP3Send.Uidl(Value: Integer): Boolean;
441var
442 s: string;
443begin
444 if Value = 0 then
445 s := 'UIDL'
446 else
447 s := 'UIDL ' + IntToStr(Value);
448 Result := CustomCommand(s, Value = 0);
449end;
450
451function TPOP3Send.StartTLS: Boolean;
452begin
453 Result := False;
454 if CustomCommand('STLS', False) then
455 begin
456 Fsock.SSLDoConnect;
457 Result := FSock.LastError = 0;
458 end;
459end;
460
461function TPOP3Send.FindCap(const Value: string): string;
462var
463 n: Integer;
464 s: string;
465begin
466 s := UpperCase(Value);
467 Result := '';
468 for n := 0 to FPOP3cap.Count - 1 do
469 if Pos(s, UpperCase(FPOP3cap[n])) = 1 then
470 begin
471 Result := FPOP3cap[n];
472 Break;
473 end;
474end;
475
476end.
Note: See TracBrowser for help on using the repository browser.