From 47b69e0a355019f510d00225a1d3325d63e9ba46 Mon Sep 17 00:00:00 2001
From: geby <geby@7c85be65-684b-0410-a082-b2ed4fbef004>
Date: Thu, 24 Apr 2008 07:12:01 +0000
Subject: [PATCH] Release 26

git-svn-id: https://svn.code.sf.net/p/synalist/code/trunk@55 7c85be65-684b-0410-a082-b2ed4fbef004
---
 IMAPsend.pas | 575 +++++++++++++++++++++++++++++++++++++++++++++++++++
 NNTPsend.pas | 310 +++++++++++++++++++++++++++
 asn1util.pas |   2 +-
 blcksock.pas | 200 ++++++++++++------
 mimeinln.pas |   4 +-
 mimemess.pas |  86 ++++++--
 mimepart.pas |  43 ++--
 pingsend.pas |  22 +-
 pop3send.pas |  11 +-
 slogsend.pas |   4 +-
 snmpsend.pas |  98 ++++-----
 sntpsend.pas | 113 ++++++++--
 synachar.pas |   4 +-
 synacode.pas | 156 +++++++++++---
 synautil.pas | 347 ++++++++++++++++++++++++++++---
 15 files changed, 1748 insertions(+), 227 deletions(-)
 create mode 100644 IMAPsend.pas
 create mode 100644 NNTPsend.pas

diff --git a/IMAPsend.pas b/IMAPsend.pas
new file mode 100644
index 0000000..adb881b
--- /dev/null
+++ b/IMAPsend.pas
@@ -0,0 +1,575 @@
+{==============================================================================|
+| Project : Delphree - Synapse                                   | 001.001.001 |
+|==============================================================================|
+| Content: IMAP4rev1 client                                                         |
+|==============================================================================|
+| The contents of this file are Subject to the Mozilla Public License Ver. 1.1 |
+| (the "License"); you may not use this file except in compliance with the     |
+| License. You may obtain a Copy of the License at http://www.mozilla.org/MPL/ |
+|                                                                              |
+| Software distributed under the License is distributed on an "AS IS" basis,   |
+| WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for |
+| the specific language governing rights and limitations under the License.    |
+|==============================================================================|
+| The Original Code is Synapse Delphi Library.                                 |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2001.                     |
+| All Rights Reserved.                                                         |
+|==============================================================================|
+| Contributor(s):                                                              |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package                           |
+|          (Found at URL: http://www.ararat.cz/synapse/)                       |
+|==============================================================================}
+
+{$WEAKPACKAGEUNIT ON}
+
+//RFC-2060
+
+unit IMAPsend;
+
+interface
+
+uses
+  SysUtils, Classes,
+  blcksock, SynaUtil, SynaCode;
+
+const
+  cIMAPProtocol = '143';
+
+type
+  TIMAPSend = class(TObject)
+  private
+    FSock: TTCPBlockSocket;
+    FTimeout: Integer;
+    FIMAPHost: string;
+    FIMAPPort: string;
+    FTagCommand: integer;
+    FResultString: string;
+    FFullResult: TStringList;
+    FIMAPcap: TStringList;
+    FUsername: string;
+    FPassword: string;
+    FAuthDone: Boolean;
+    FSelectedFolder: string;
+    FSelectedCount: integer;
+    FSelectedRecent: integer;
+    FSelectedUIDvalidity: integer;
+    FUID: Boolean;
+
+    function ReadResult: string;
+    function AuthLogin: Boolean;
+    function Connect: Boolean;
+    procedure ParseMess(Value:TStrings);
+    procedure ParseFolderList(Value:TStrings);
+    procedure ParseSelect;
+    procedure ParseSearch(Value:TStrings);
+  public
+    constructor Create;
+    destructor Destroy; override;
+    function IMAPcommand(Value: string): string;
+    function IMAPuploadCommand(Value: string; const Data:TStrings): string;
+    function Login: Boolean;
+    procedure Logout;
+    function NoOp: Boolean;
+    function List(FromFolder: string; const FolderList: TStrings): Boolean;
+    function ListSubscribed(FromFolder: string; const FolderList: TStrings): Boolean;
+    function CreateFolder(FolderName: string): Boolean;
+    function DeleteFolder(FolderName: string): Boolean;
+    function RenameFolder(FolderName, NewFolderName: string): Boolean;
+    function SubscribeFolder(FolderName: string): Boolean;
+    function UnsubscribeFolder(FolderName: string): Boolean;
+    function SelectFolder(FolderName: string): Boolean;
+    function SelectROFolder(FolderName: string): Boolean;
+    function CloseFolder: Boolean;
+    function StatusFolder(FolderName, Value: string): integer;
+    function ExpungeFolder: Boolean;
+    function CheckFolder: Boolean;
+    function AppendMess(ToFolder: string; const Mess: TStrings): Boolean;
+    function DeleteMess(MessID: integer): boolean;
+    function FetchMess(MessID: integer; const Mess: TStrings): Boolean;
+    function FetchHeader(MessID: integer; const Headers: TStrings): Boolean;
+    function MessageSize(MessID: integer): integer;
+    function CopyMess(MessID: integer; ToFolder: string): Boolean;
+    function SearchMess(Criteria: string; const FoundMess: TStrings): Boolean;
+    function SetFlagsMess(MessID: integer; Flags: string): Boolean;
+    function GetFlagsMess(MessID: integer; var Flags: string): Boolean;
+
+    function FindCap(const Value: string): string;
+  published
+    property Timeout: Integer read FTimeout Write FTimeout;
+    property IMAPHost: string read FIMAPHost Write FIMAPHost;
+    property IMAPPort: string read FIMAPPort Write FIMAPPort;
+    property ResultString: string read FResultString;
+    property FullResult: TStringList read FFullResult;
+    property IMAPcap: TStringList read FIMAPcap;
+    property Username: string read FUsername Write FUsername;
+    property Password: string read FPassword Write FPassword;
+    property AuthDone: Boolean read FAuthDone;
+    property UID: Boolean read FUID Write FUID;
+    property Sock: TTCPBlockSocket read FSock;
+    property SelectedFolder: string read FSelectedFolder;
+    property SelectedCount: integer read FSelectedCount;
+    property SelectedRecent: integer read FSelectedRecent;
+    property SelectedUIDvalidity: integer read FSelectedUIDvalidity;
+  end;
+
+implementation
+
+const
+  CRLF = #13#10;
+
+constructor TIMAPSend.Create;
+begin
+  inherited Create;
+  FFullResult := TStringList.Create;
+  FIMAPcap := TStringList.Create;
+  FSock := TTCPBlockSocket.Create;
+  FSock.CreateSocket;
+  FSock.SizeRecvBuffer := 32768;
+  FSock.SizeSendBuffer := 32768;
+  FTimeout := 300000;
+  FIMAPhost := cLocalhost;
+  FIMAPPort := cIMAPProtocol;
+  FUsername := '';
+  FPassword := '';
+  FTagCommand := 0;
+  FSelectedFolder := '';
+  FSelectedCount := 0;
+  FSelectedRecent := 0;
+  FSelectedUIDvalidity := 0;
+  FUID := False;
+end;
+
+destructor TIMAPSend.Destroy;
+begin
+  FSock.Free;
+  FIMAPcap.Free;
+  FFullResult.Free;
+  inherited Destroy;
+end;
+
+
+function TIMAPSend.ReadResult: string;
+var
+  s: string;
+  x, l: integer;
+begin
+  Result := '';
+  FFullResult.Clear;
+  FResultString := '';
+  repeat
+    s := FSock.RecvString(FTimeout);
+    if Pos('S' + IntToStr(FTagCommand) + ' ', s) = 1 then
+    begin
+      FResultString := s;
+      break;
+    end
+    else
+      FFullResult.Add(s);
+    if (s <> '') and (s[Length(s)]='}') then
+    begin
+      s := Copy(s, 1, Length(s) - 1);
+      x := RPos('{', s);
+      s := Copy(s, x + 1, Length(s) - x);
+      l := StrToIntDef(s, -1);
+      if l <> -1 then
+      begin
+        setlength(s, l);
+        x := FSock.recvbufferex(PChar(s), l, FTimeout);
+        SetLength(s, x);
+        FFullResult.Add(s);
+      end;
+    end;
+  until FSock.LastError <> 0;
+  s := separateright(FResultString, ' ');
+  Result:=uppercase(separateleft(s, ' '));
+end;
+
+function TIMAPSend.IMAPcommand(Value: string): string;
+begin
+  Inc(FTagCommand);
+  FSock.SendString('S' + IntToStr(FTagCommand) + ' ' + Value + CRLF);
+  Result := ReadResult;
+end;
+
+function TIMAPSend.IMAPuploadCommand(Value: string; const Data:TStrings): string;
+var
+  l: integer;
+begin
+  Inc(FTagCommand);
+  l := Length(Data.Text);
+  FSock.SendString(IntToStr(FTagCommand) + ' ' + Value + ' {'+ IntToStr(l) + '}' + CRLF);
+  FSock.SendString(Data.Text + CRLF);
+  Result := ReadResult;
+end;
+
+procedure TIMAPSend.ParseMess(Value:TStrings);
+var
+  n: integer;
+begin
+  Value.Clear;
+  for n := 0 to FFullResult.Count - 2 do
+    if FFullResult[n][Length(FFullResult[n])] = '}' then
+    begin
+      Value.Text := FFullResult[n + 1];
+      Break;
+    end;
+end;
+
+procedure TIMAPSend.ParseFolderList(Value:TStrings);
+var
+  n, x: integer;
+  s: string;
+begin
+  Value.Clear;
+  for n := 0 to FFullResult.Count - 1 do
+  begin
+    s := FFullResult[n];
+    x := RPos(' ', s);
+    if (x > 0) and (Pos('NOSELECT', UpperCase(s)) = 0) then
+      Value.Add(Copy(s, x + 1, Length(s) - x));
+  end;
+end;
+
+procedure TIMAPSend.ParseSelect;
+var
+  n: integer;
+  s, t: string;
+begin
+  FSelectedCount := 0;
+  FSelectedRecent := 0;
+  FSelectedUIDvalidity := 0;
+  for n := 0 to FFullResult.Count - 1 do
+  begin
+    s := uppercase(FFullResult[n]);
+    if Pos(' EXISTS', s) > 0 then
+    begin
+      t := separateleft(s, ' EXISTS');
+      t := separateright(t, '* ');
+      FSelectedCount := StrToIntDef(t, 0);
+    end;
+    if Pos(' RECENT', s) > 0 then
+    begin
+      t := separateleft(s, ' RECENT');
+      t := separateright(t, '* ');
+      FSelectedRecent := StrToIntDef(t, 0);
+    end;
+    if Pos('UIDVALIDITY', s) > 0 then
+    begin
+      t := separateright(s, 'UIDVALIDITY ');
+      t := separateleft(t, ']');
+      FSelectedUIDvalidity := StrToIntDef(t, 0);
+    end;
+  end;
+end;
+
+procedure TIMAPSend.ParseSearch(Value:TStrings);
+var
+  n: integer;
+  s: string;
+begin
+  Value.Clear;
+  for n := 0 to FFullResult.Count - 1 do
+  begin
+    s := uppercase(FFullResult[n]);
+    if Pos('* SEARCH', s) = 1 then
+    begin
+      s := SeparateRight(s, '* SEARCH');
+      while s <> '' do
+        Value.Add(Fetch(s, ' '));
+    end;
+  end;
+end;
+
+function TIMAPSend.FindCap(const Value: string): string;
+var
+  n: Integer;
+  s: string;
+begin
+  s := UpperCase(Value);
+  Result := '';
+  for n := 0 to FIMAPcap.Count - 1 do
+    if Pos(s, UpperCase(FIMAPcap[n])) = 1 then
+    begin
+      Result := FIMAPcap[n];
+      Break;
+    end;
+end;
+
+function TIMAPSend.AuthLogin: Boolean;
+begin
+  Result := IMAPcommand('LOGIN ' + FUsername + ' ' + FPassword) = 'OK';
+end;
+
+function TIMAPSend.Connect: Boolean;
+begin
+  FSock.CloseSocket;
+  FSock.CreateSocket;
+  FSock.Connect(FIMAPHost, FIMAPPort);
+  Result := FSock.LastError = 0;
+end;
+
+function TIMAPSend.Login: Boolean;
+var
+  n: Integer;
+  s, t: string;
+begin
+  FSelectedFolder := '';
+  FSelectedCount := 0;
+  FSelectedRecent := 0;
+  FSelectedUIDvalidity := 0;
+  Result := False;
+  FAuthDone := False;
+  if not Connect then
+    Exit;
+  s := FSock.RecvString(FTimeout);
+  if Pos('* PREAUTH', s) = 1 then
+    FAuthDone := True
+  else
+    if Pos('* OK', s) = 1 then
+      FAuthDone := False
+    else
+      Exit;
+  FIMAPcap.Clear;
+  s := IMAPcommand('CAPABILITY');
+  if s = 'OK' then
+  begin
+    for n := 0 to FFullResult.Count - 1 do
+      if Pos('* CAPABILITY ', FFullResult[n]) = 1 then
+      begin
+        s := SeparateRight(FFullResult[n], '* CAPABILITY ');
+        while not (s = '') do
+        begin
+          t := separateleft(s, ' ');
+          s := separateright(s, ' ');
+          if s = t then
+            s := '';
+          FIMAPcap.Add(t);
+        end;
+      end;
+    if Findcap('IMAP4rev1') = '' then
+      Exit;
+  end;
+  Result := AuthLogin;
+end;
+
+procedure TIMAPSend.Logout;
+begin
+  IMAPcommand('LOGOUT');
+  FSelectedFolder := '';
+  FSock.CloseSocket;
+end;
+
+function TIMAPSend.NoOp: Boolean;
+begin
+  Result := IMAPcommand('NOOP') = 'OK';
+end;
+
+function TIMAPSend.List(FromFolder: string; const FolderList: TStrings): Boolean;
+begin
+  Result := IMAPcommand('LIST "' + FromFolder + '" *') = 'OK';
+  ParseFolderList(FolderList);
+end;
+
+function TIMAPSend.ListSubscribed(FromFolder: string; const FolderList: TStrings): Boolean;
+begin
+  Result := IMAPcommand('LSUB "' + FromFolder + '" *') = 'OK';
+  ParseFolderList(FolderList);
+end;
+
+function TIMAPSend.CreateFolder(FolderName: string): Boolean;
+begin
+  Result := IMAPcommand('CREATE "' + FolderName + '"') = 'OK';
+end;
+
+function TIMAPSend.DeleteFolder(FolderName: string): Boolean;
+begin
+  Result := IMAPcommand('DELETE "' + FolderName + '"') = 'OK';
+end;
+
+function TIMAPSend.RenameFolder(FolderName, NewFolderName: string): Boolean;
+begin
+  Result := IMAPcommand('RENAME "' + FolderName + '" "' + NewFolderName + '"') = 'OK';
+end;
+
+function TIMAPSend.SubscribeFolder(FolderName: string): Boolean;
+begin
+  Result := IMAPcommand('SUBSCRIBE "' + FolderName + '"') = 'OK';
+end;
+
+function TIMAPSend.UnsubscribeFolder(FolderName: string): Boolean;
+begin
+  Result := IMAPcommand('UNSUBSCRIBE "' + FolderName + '"') = 'OK';
+end;
+
+function TIMAPSend.SelectFolder(FolderName: string): Boolean;
+begin
+  Result := IMAPcommand('SELECT "' + FolderName + '"') = 'OK';
+  FSelectedFolder := FolderName;
+  ParseSelect;
+end;
+
+function TIMAPSend.SelectROFolder(FolderName: string): Boolean;
+begin
+  Result := IMAPcommand('EXAMINE "' + FolderName + '"') = 'OK';
+  FSelectedFolder := FolderName;
+  ParseSelect;
+end;
+
+function TIMAPSend.CloseFolder: Boolean;
+begin
+  Result := IMAPcommand('CLOSE') = 'OK';
+  FSelectedFolder := '';
+end;
+
+function TIMAPSend.StatusFolder(FolderName, Value: string): integer;
+var
+  n: integer;
+  s, t: string;
+begin
+  Result := -1;
+  Value := Uppercase(Value);
+  if IMAPcommand('STATUS "' + FolderName + '" (' + Value + ')' ) = 'OK' then
+    for n := 0 to FFullResult.Count - 1 do
+    begin
+      s := UpperCase(FFullResult[n]);
+      if (Pos('* STATUS ', s) = 1) and (Pos(Value, s) > 0 ) then
+      begin
+        t := SeparateRight(s, Value);
+        t := SeparateLeft(t, ')');
+        t := trim(t);
+        Result := StrToIntDef(t, -1);
+        Break;
+      end;
+    end;
+end;
+
+function TIMAPSend.ExpungeFolder: Boolean;
+begin
+  Result := IMAPcommand('EXPUNGE') = 'OK';
+end;
+
+function TIMAPSend.CheckFolder: Boolean;
+begin
+  Result := IMAPcommand('CHECK') = 'OK';
+end;
+
+function TIMAPSend.AppendMess(ToFolder: string; const Mess: TStrings): Boolean;
+begin
+  Result := IMAPuploadCommand('APPEND "' + ToFolder + '"', Mess) = 'OK';
+end;
+
+function TIMAPSend.DeleteMess(MessID: integer): boolean;
+var
+  s: string;
+begin
+  s := 'STORE ' + IntToStr(MessID) + ' +FLAGS.SILENT (\Deleted)';
+  if FUID then
+    s := 'UID ' + s;
+  Result := IMAPcommand(s) = 'OK';
+end;
+
+function TIMAPSend.FetchMess(MessID: integer; const Mess: TStrings): Boolean;
+var
+  s: string;
+begin
+  s := 'FETCH ' + IntToStr(MessID) + ' (RFC822)';
+  if FUID then
+    s := 'UID ' + s;
+  Result := IMAPcommand(s) = 'OK';
+  ParseMess(Mess);
+end;
+
+function TIMAPSend.FetchHeader(MessID: integer; const Headers: TStrings): Boolean;
+var
+  s: string;
+begin
+  s := 'FETCH ' + IntToStr(MessID) + ' (RFC822.HEADER)';
+  if FUID then
+    s := 'UID ' + s;
+  Result := IMAPcommand(s) = 'OK';
+  ParseMess(Headers);
+end;
+
+function TIMAPSend.MessageSize(MessID: integer): integer;
+var
+  n: integer;
+  s, t: string;
+begin
+  Result := -1;
+  s := 'FETCH ' + IntToStr(MessID) + ' (RFC822.SIZE)';
+  if FUID then
+    s := 'UID ' + s;
+  if IMAPcommand(s) = 'OK' then
+    for n := 0 to FFullResult.Count - 1 do
+    begin
+      s := UpperCase(FFullResult[n]);
+      if (Pos('* ', s) = 1) and (Pos('RFC822.SIZE', s) > 0 ) then
+      begin
+        t := SeparateRight(s, 'RFC822.SIZE ');
+        t := SeparateLeft(t, ')');
+        t := trim(t);
+        Result := StrToIntDef(t, -1);
+        Break;
+      end;
+    end;
+end;
+
+function TIMAPSend.CopyMess(MessID: integer; ToFolder: string): Boolean;
+var
+  s: string;
+begin
+  s := 'COPY ' + IntToStr(MessID) + ' "' + ToFolder + '"';
+  if FUID then
+    s := 'UID ' + s;
+  Result := IMAPcommand(s) = 'OK';
+end;
+
+function TIMAPSend.SearchMess(Criteria: string; const FoundMess: TStrings): Boolean;
+var
+  s: string;
+begin
+  s := 'SEARCH ' + Criteria;
+  if FUID then
+    s := 'UID ' + s;
+  Result := IMAPcommand(s) = 'OK';
+  ParseSearch(FoundMess);
+end;
+
+function TIMAPSend.SetFlagsMess(MessID: integer; Flags: string): Boolean;
+var
+  s: string;
+begin
+  s := 'STORE ' + IntToStr(MessID) + ' FLAGS.SILENT (' + Flags + ')';
+  if FUID then
+    s := 'UID ' + s;
+  Result := IMAPcommand(s) = 'OK';
+end;
+
+function TIMAPSend.GetFlagsMess(MessID: integer; var Flags: string): Boolean;
+var
+  s: string;
+  n: integer;
+begin
+  Flags := '';
+  s := 'FETCH ' + IntToStr(MessID) + ' (FLAGS)';
+  if FUID then
+    s := 'UID ' + s;
+  Result := IMAPcommand(s) = 'OK';
+  for n := 0 to FFullResult.Count - 1 do
+  begin
+    s := uppercase(FFullResult[n]);
+    if Pos('* FETCH (FLAGS', s) = 1 then
+    begin
+      s := SeparateRight(s, 'FLAGS');
+      s := Separateright(s, '(');
+      Flags := SeparateLeft(s, ')');
+    end;
+  end;
+end;
+
+{==============================================================================}
+
+end.
diff --git a/NNTPsend.pas b/NNTPsend.pas
new file mode 100644
index 0000000..9d73422
--- /dev/null
+++ b/NNTPsend.pas
@@ -0,0 +1,310 @@
+{==============================================================================|
+| Project : Delphree - Synapse                                   | 001.000.000 |
+|==============================================================================|
+| Content: NNTP client                                                         |
+|==============================================================================|
+| The contents of this file are Subject to the Mozilla Public License Ver. 1.1 |
+| (the "License"); you may not use this file except in compliance with the     |
+| License. You may obtain a Copy of the License at http://www.mozilla.org/MPL/ |
+|                                                                              |
+| Software distributed under the License is distributed on an "AS IS" basis,   |
+| WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for |
+| the specific language governing rights and limitations under the License.    |
+|==============================================================================|
+| The Original Code is Synapse Delphi Library.                                 |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c) 1999,2000,2001.          |
+| All Rights Reserved.                                                         |
+|==============================================================================|
+| Contributor(s):                                                              |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package                           |
+|          (Found at URL: http://www.ararat.cz/synapse/)                       |
+|==============================================================================}
+
+{$WEAKPACKAGEUNIT ON}
+
+unit NNTPsend;
+
+interface
+
+uses
+  SysUtils, Classes,
+  blcksock, SynaUtil, SynaCode;
+
+const
+  cNNTPProtocol = 'nntp';
+
+type
+  TNNTPSend = class(TObject)
+  private
+    FSock: TTCPBlockSocket;
+    FTimeout: Integer;
+    FNNTPHost: string;
+    FNNTPPort: string;
+    FResultCode: Integer;
+    FResultString: string;
+    FData: TStringList;
+    function ReadResult: Integer;
+    function ReadData: boolean;
+    function SendData: boolean;
+    function Connect: Boolean;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    function Login: Boolean;
+    procedure Logout;
+    function GetArticle(const Value: string): Boolean;
+    function GetBody(const Value: string): Boolean;
+    function GetHead(const Value: string): Boolean;
+    function GetStat(const Value: string): Boolean;
+    function SelectGroup(const Value: string): Boolean;
+    function IHave(const MessID: string): Boolean;
+    function GotoLast: Boolean;
+    function GotoNext: Boolean;
+    function ListGroups: Boolean;
+    function ListNewGroups(Since: TDateTime): Boolean;
+    function NewArticles(const Group: string; Since: TDateTime): Boolean;
+    function PostArticle: Boolean;
+    function SwitchToSlave: Boolean;
+  published
+    property Timeout: Integer read FTimeout Write FTimeout;
+    property NNTPHost: string read FNNTPHost Write FNNTPHost;
+    property NNTPPort: string read FNNTPPort Write FNNTPPort;
+    property ResultCode: Integer read FResultCode;
+    property ResultString: string read FResultString;
+    property Data: TStringList read FData;
+    property Sock: TTCPBlockSocket read FSock;
+  end;
+
+implementation
+
+const
+  CRLF = #13#10;
+
+constructor TNNTPSend.Create;
+begin
+  inherited Create;
+  FData := TStringList.Create;
+  FSock := TTCPBlockSocket.Create;
+  FSock.CreateSocket;
+  FTimeout := 300000;
+  FNNTPhost := cLocalhost;
+  FNNTPPort := cNNTPProtocol;
+end;
+
+destructor TNNTPSend.Destroy;
+begin
+  FSock.Free;
+  FData.Free;
+  inherited Destroy;
+end;
+
+function TNNTPSend.ReadResult: Integer;
+var
+  s: string;
+begin
+  Result := 0;
+  FData.Clear;
+  s := FSock.RecvString(FTimeout);
+  FResultString := Copy(s, 5, Length(s) - 4);
+  if FSock.LastError <> 0 then
+    Exit;
+  if Length(s) >= 3 then
+    Result := StrToIntDef(Copy(s, 1, 3), 0);
+  FResultCode := Result;
+end;
+
+function TNNTPSend.ReadData: boolean;
+var
+  s: string;
+begin
+  Result := False;
+  repeat
+    s := FSock.RecvString(FTimeout);
+    if s = '.' then
+      break;
+    if (s <> '') and (s[1] = '.') then
+      s := Copy(s, 2, Length(s) - 1);
+    FData.Add(s);
+  until FSock.LastError <> 0;
+  Result := FSock.LastError = 0;
+end;
+
+function TNNTPSend.SendData: boolean;
+var
+  s: string;
+  n: integer;
+begin
+  Result := False;
+  for n := 0 to FData.Count -1 do
+  begin
+    s := FData[n];
+    if (s <> '') and (s[1]='.') then
+      s := s + '.';
+    FSock.SendString(s + CRLF);
+    if FSock.LastError <> 0 then
+      break;
+  end;
+  Result := FSock.LastError = 0;
+end;
+
+function TNNTPSend.Connect: Boolean;
+begin
+  FSock.CloseSocket;
+  FSock.CreateSocket;
+  FSock.Connect(FNNTPHost, FNNTPPort);
+  Result := FSock.LastError = 0;
+end;
+
+function TNNTPSend.Login: Boolean;
+begin
+  Result := False;
+  if not Connect then
+    Exit;
+  Result := (ReadResult div 100) = 2;
+end;
+
+procedure TNNTPSend.Logout;
+begin
+  FSock.SendString('QUIT' + CRLF);
+  ReadResult;
+  FSock.CloseSocket;
+end;
+
+function TNNTPSend.GetArticle(const Value: string): Boolean;
+var
+  s: string;
+begin
+  Result := False;
+  s := 'ARTICLE';
+  if Value <> '' then
+    s := s + ' ' + Value;
+  FSock.SendString(s + CRLF);
+  if (ReadResult div 100) <> 2 then
+    Exit;
+  Result := ReadData;
+end;
+
+function TNNTPSend.GetBody(const Value: string): Boolean;
+var
+  s: string;
+begin
+  Result := False;
+  s := 'BODY';
+  if Value <> '' then
+    s := s + ' ' + Value;
+  FSock.SendString(s + CRLF);
+  if (ReadResult div 100) <> 2 then
+    Exit;
+  Result := ReadData;
+end;
+
+function TNNTPSend.GetHead(const Value: string): Boolean;
+var
+  s: string;
+begin
+  Result := False;
+  s := 'HEAD';
+  if Value <> '' then
+    s := s + ' ' + Value;
+  FSock.SendString(s + CRLF);
+  if (ReadResult div 100) <> 2 then
+    Exit;
+  Result := ReadData;
+end;
+
+function TNNTPSend.GetStat(const Value: string): Boolean;
+var
+  s: string;
+begin
+  Result := False;
+  s := 'STAT';
+  if Value <> '' then
+    s := s + ' ' + Value;
+  FSock.SendString(s + CRLF);
+  if (ReadResult div 100) <> 2 then
+    Exit;
+  Result := FSock.LastError = 0;
+end;
+
+function TNNTPSend.SelectGroup(const Value: string): Boolean;
+begin
+  FSock.SendString('GROUP ' + Value + CRLF);
+  Result := (ReadResult div 100) = 2;
+end;
+
+function TNNTPSend.IHave(const MessID: string): Boolean;
+var
+  x: integer;
+begin
+  FSock.SendString('IHAVE ' + MessID + CRLF);
+  x := (ReadResult div 100);
+  if x = 3 then
+  begin
+    SendData;
+    x := (ReadResult div 100);
+  end;
+  Result := x = 2;
+end;
+
+function TNNTPSend.GotoLast: Boolean;
+begin
+  FSock.SendString('LAST' + CRLF);
+  Result := (ReadResult div 100) = 2;
+end;
+
+function TNNTPSend.GotoNext: Boolean;
+begin
+  FSock.SendString('NEXT' + CRLF);
+  Result := (ReadResult div 100) = 2;
+end;
+
+function TNNTPSend.ListGroups: Boolean;
+begin
+  FSock.SendString('LIST' + CRLF);
+  Result := (ReadResult div 100) = 2;
+  if Result then
+    Result := ReadData;
+end;
+
+function TNNTPSend.ListNewGroups(Since: TDateTime): Boolean;
+begin
+  FSock.SendString('NEWGROUPS ' + SimpleDateTime(Since) + ' GMT' + CRLF);
+  Result := (ReadResult div 100) = 2;
+  if Result then
+    Result := ReadData;
+end;
+
+function TNNTPSend.NewArticles(const Group: string; Since: TDateTime): Boolean;
+begin
+  FSock.SendString('NEWNEWS ' + Group + ' ' + SimpleDateTime(Since) + ' GMT' + CRLF);
+  Result := (ReadResult div 100) = 2;
+  if Result then
+    Result := ReadData;
+end;
+
+function TNNTPSend.PostArticle: Boolean;
+var
+  x: integer;
+begin
+  FSock.SendString('POST' + CRLF);
+  x := (ReadResult div 100);
+  if x = 3 then
+  begin
+    SendData;
+    x := (ReadResult div 100);
+  end;
+  Result := x = 2;
+end;
+
+function TNNTPSend.SwitchToSlave: Boolean;
+begin
+  FSock.SendString('SLAVE' + CRLF);
+  Result := (ReadResult div 100) = 2;
+end;
+
+{==============================================================================}
+
+end.
diff --git a/asn1util.pas b/asn1util.pas
index 277d453..b94e3b3 100644
--- a/asn1util.pas
+++ b/asn1util.pas
@@ -1,7 +1,7 @@
 {==============================================================================|
 | Project : Delphree - Synapse                                   | 001.003.004 |
 |==============================================================================|
-| Content: support for ASN.1 coding and decoding                               |
+| Content: support for ASN.1 BER coding and decoding                           |
 |==============================================================================|
 | The contents of this file are subject to the Mozilla Public License Ver. 1.1 |
 | (the "License"); you may not use this file except in compliance with the     |
diff --git a/blcksock.pas b/blcksock.pas
index e658132..b2ccf33 100644
--- a/blcksock.pas
+++ b/blcksock.pas
@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 004.000.000 |
+| Project : Delphree - Synapse                                   | 004.004.000 |
 |==============================================================================|
 | Content: Library base                                                        |
 |==============================================================================|
@@ -23,6 +23,7 @@
 |          (Found at URL: http://www.ararat.cz/synapse/)                       |
 |==============================================================================}
 
+{$Q-}
 {$WEAKPACKAGEUNIT ON}
 
 unit blcksock;
@@ -76,10 +77,15 @@ type
     FLastError: Integer;
     FBuffer: string;
     FRaiseExcept: Boolean;
+    FNonBlockMode: Boolean;
+    FMaxLineLength: Integer;
+    FMaxBandwidth: Integer;
+    FNextSend: Cardinal;
     function GetSizeRecvBuffer: Integer;
     procedure SetSizeRecvBuffer(Size: Integer);
     function GetSizeSendBuffer: Integer;
     procedure SetSizeSendBuffer(Size: Integer);
+    procedure SetNonBlockMode(Value: Boolean);
   protected
     FSocket: TSocket;
     FProtocol: Integer;
@@ -88,6 +94,7 @@ type
     function GetSinIP(Sin: TSockAddrIn): string;
     function GetSinPort(Sin: TSockAddrIn): Integer;
     procedure DoStatus(Reason: THookSocketReason; const Value: string);
+    procedure LimitBandwidth(Length: Integer);
   public
     constructor Create;
     constructor CreateAlternate(Stub: string);
@@ -103,6 +110,7 @@ type
       Timeout: Integer): Integer; virtual;
     function RecvByte(Timeout: Integer): Byte; virtual;
     function RecvString(Timeout: Integer): string; virtual;
+    function RecvTerminated(Timeout: Integer; const Terminator: string): string; virtual;
     function RecvPacket(Timeout: Integer): string; virtual;
     function PeekBuffer(Buffer: Pointer; Length: Integer): Integer; virtual;
     function PeekByte(Timeout: Integer): Byte; virtual;
@@ -126,6 +134,7 @@ type
     function RecvBufferFrom(Buffer: Pointer; Length: Integer): Integer; virtual;
     function GroupCanRead(const SocketList: TList; Timeout: Integer;
       const CanReadList: TList): Boolean;
+    function EnableReuse(Value: Boolean): Boolean;
 
     //See 'winsock2.txt' file in distribute package!
     function SetTimeout(Timeout: Integer): Boolean;
@@ -145,6 +154,9 @@ type
     property SizeSendBuffer: Integer read GetSizeSendBuffer write SetSizeSendBuffer;
     property WSAData: TWSADATA read FWsaData;
     property OnStatus: THookSocketStatus read FOnStatus write FOnStatus;
+    property NonBlockMode: Boolean read FNonBlockMode Write SetNonBlockMode;
+    property MaxLineLength: Integer read FMaxLineLength Write FMaxLineLength;
+    property MaxBandwidth: Integer read FMaxBandwidth Write FMaxBandwidth;
   end;
 
   TSocksBlockSocket = class(TBlockSocket)
@@ -206,6 +218,8 @@ type
     function RecvBuffer(Buffer: Pointer; Length: Integer): Integer; override;
     function SendBufferTo(Buffer: Pointer; Length: Integer): Integer; override;
     function RecvBufferFrom(Buffer: Pointer; Length: Integer): Integer; override;
+    procedure AddMulticast(MCastIP:string);
+    procedure DropMulticast(MCastIP:string);
   end;
 
   //See 'winsock2.txt' file in distribute package!
@@ -236,6 +250,12 @@ type
 
 implementation
 
+type
+  TMulticast = record
+    MCastAddr : u_long;
+    MCastIfc : u_long;
+  end;
+
 constructor TBlockSocket.Create;
 var
   e: ESynapseError;
@@ -245,6 +265,10 @@ begin
   FSocket := INVALID_SOCKET;
   FProtocol := IPPROTO_IP;
   FBuffer := '';
+  FNonBlockMode := False;
+  FMaxLineLength := 0;
+  FMaxBandwidth := 0;
+  FNextSend := 0;
   if not InitSocketInterface('') then
   begin
     e := ESynapseError.Create('Error loading Winsock DLL!');
@@ -345,6 +369,7 @@ end;
 
 procedure TBlockSocket.CloseSocket;
 begin
+  synsock.Shutdown(FSocket, 2);
   synsock.CloseSocket(FSocket);
   DoStatus(HR_SocketClose, '');
 end;
@@ -385,8 +410,22 @@ begin
   synsock.GetPeerName(FSocket, FremoteSin, Len);
 end;
 
+procedure TBlockSocket.LimitBandwidth(Length: Integer);
+var
+  x: Cardinal;
+begin
+  if FMaxBandwidth > 0 then
+  begin
+    x := FNextSend - GetTick;
+    if x > 0 then
+      Sleep(x);
+    FNextSend := GetTick + Trunc((FMaxBandwidth / 1000) * Length);
+  end;
+end;
+
 function TBlockSocket.SendBuffer(Buffer: Pointer; Length: Integer): Integer;
 begin
+  LimitBandwidth(Length);
   Result := synsock.Send(FSocket, Buffer^, Length, 0);
   SockCheck(Result);
   ExceptCheck;
@@ -454,14 +493,9 @@ begin
         if (system.Length(ss) + l) > fs then
           l := fs - system.Length(ss);
         SetLength(st, l);
-        x := synsock.Recv(FSocket, Pointer(st)^, l, 0);
-        if x = 0 then
-          FLastError := WSAECONNRESET
-        else
-          SockCheck(x);
+        x := RecvBuffer(Pointer(st), l);
         if FLastError <> 0 then
           Break;
-        DoStatus(HR_ReadCount, IntToStr(x));
         lss := system.Length(ss);
         SetLength(ss, lss + x);
         Move(Pointer(st)^, Pointer(@ss[lss + 1])^, x);
@@ -515,47 +549,44 @@ end;
 
 function TBlockSocket.RecvByte(Timeout: Integer): Byte;
 var
-  y: Integer;
-  Data: Byte;
+  s: String;
 begin
-  Data := 0;
   Result := 0;
   if CanRead(Timeout) then
   begin
-    y := synsock.Recv(FSocket, Data, 1, 0);
-    if y = 0 then
-      FLastError := WSAECONNRESET
-    else
-      SockCheck(y);
-    Result := Data;
-    DoStatus(HR_ReadCount, '1');
+    SetLength(s, 1);
+    RecvBuffer(Pointer(s), 1);
+    if s <> '' then
+      Result := Ord(s[1]);
   end
   else
     FLastError := WSAETIMEDOUT;
   ExceptCheck;
 end;
 
-function TBlockSocket.RecvString(Timeout: Integer): string;
+function TBlockSocket.RecvTerminated(Timeout: Integer; const Terminator: string): string;
 const
-  MaxBuf = 1024;
+  MaxSize = 1024;
 var
   x: Integer;
   s: string;
   c: Char;
-  r: Integer;
+  r,l: Integer;
 begin
   s := '';
+  l := Length(Terminator);
+  Result := '';
+  if l = 0 then
+    Exit;
   FLastError := 0;
-  c := #0;
   repeat
+    x := 0;
     if FBuffer = '' then
     begin
       x := WaitingData;
-      if x = 0 then
-        x := 1;
-      if x > MaxBuf then
-        x := MaxBuf;
-      if x = 1 then
+      if x > MaxSize then
+        x := MaxSize;
+      if x <= 1 then
       begin
         c := Char(RecvByte(Timeout));
         if FLastError <> 0 then
@@ -565,42 +596,44 @@ begin
       else
       begin
         SetLength(FBuffer, x);
-        r := synsock.Recv(FSocket, Pointer(FBuffer)^, x, 0);
-        SockCheck(r);
-        if r = 0 then
-          FLastError := WSAECONNRESET;
+        r := RecvBuffer(Pointer(FBuffer), x);
         if FLastError <> 0 then
           Break;
-        DoStatus(HR_ReadCount, IntToStr(r));
         if r < x then
           SetLength(FBuffer, r);
       end;
     end;
-    x := Pos(#10, FBuffer);
-    if x < 1 then x := Length(FBuffer);
-    s := s + Copy(FBuffer, 1, x - 1);
-    c := FBuffer[x];
-    Delete(FBuffer, 1, x);
-    s := s + c;
-  until c = #10;
-
-  if FLastError = 0 then
-  begin
-{$IFDEF LINUX}
-    s := AdjustLineBreaks(s, tlbsCRLF);
-{$ELSE}
-    s := AdjustLineBreaks(s);
-{$ENDIF}
-    x := Pos(#13 + #10, s);
+    s := s + FBuffer;
+    FBuffer := '';
+    x := Pos(Terminator, s);
     if x > 0 then
+    begin
+      FBuffer := Copy(s, x + l, Length(s) - x - l + 1);
       s := Copy(s, 1, x - 1);
-    Result := s;
-  end
+    end;
+    if (FMaxLineLength <> 0) and (Length(s) > FMaxLineLength) then
+    begin
+      FLastError := WSAENOBUFS;
+      Break;
+    end;
+  until x > 0;
+  if FLastError = 0 then
+    Result := s
   else
     Result := '';
   ExceptCheck;
 end;
 
+function TBlockSocket.RecvString(Timeout: Integer): string;
+var
+  s: string;
+begin
+  Result := '';
+  s := RecvTerminated(Timeout, #13 + #10);
+  if FLastError = 0 then
+    Result := s;
+end;
+
 function TBlockSocket.PeekBuffer(Buffer: Pointer; Length: Integer): Integer;
 begin
   Result := synsock.Recv(FSocket, Buffer^, Length, MSG_PEEK);
@@ -610,18 +643,15 @@ end;
 
 function TBlockSocket.PeekByte(Timeout: Integer): Byte;
 var
-  y: Integer;
-  Data: Byte;
+  s: string;
 begin
-  Data := 0;
   Result := 0;
   if CanRead(Timeout) then
   begin
-    y := synsock.Recv(FSocket, Data, 1, MSG_PEEK);
-    if y = 0 then
-      FLastError := WSAECONNRESET;
-    SockCheck(y);
-    Result := Data;
+    SetLength(s, 1);
+    PeekBuffer(Pointer(s), 1);
+    if s <> '' then
+      Result := Ord(s[1]);
   end
   else
     FLastError := WSAETIMEDOUT;
@@ -642,7 +672,8 @@ var
   e: ESynapseError;
   s: string;
 begin
-  if FRaiseExcept and (LastError <> 0) then
+  if FRaiseExcept and (LastError <> 0) and (LastError <> WSAEINPROGRESS)
+    and (LastError <> WSAEWOULDBLOCK) then
   begin
     s := GetErrorDesc(LastError);
     e := ESynapseError.CreateFmt('TCP/IP Socket error %d: %s', [LastError, s]);
@@ -833,10 +864,12 @@ function TBlockSocket.SendBufferTo(Buffer: Pointer; Length: Integer): Integer;
 var
   Len: Integer;
 begin
+  LimitBandwidth(Length);
   Len := SizeOf(FRemoteSin);
   Result := synsock.SendTo(FSocket, Buffer^, Length, 0, FRemoteSin, Len);
   SockCheck(Result);
   ExceptCheck;
+  DoStatus(HR_WriteCount, IntToStr(Result));
 end;
 
 function TBlockSocket.RecvBufferFrom(Buffer: Pointer; Length: Integer): Integer;
@@ -847,6 +880,7 @@ begin
   Result := synsock.RecvFrom(FSocket, Buffer^, Length, 0, FRemoteSin, Len);
   SockCheck(Result);
   ExceptCheck;
+  DoStatus(HR_ReadCount, IntToStr(Result));
 end;
 
 function TBlockSocket.GetSizeRecvBuffer: Integer;
@@ -883,6 +917,18 @@ begin
   ExceptCheck;
 end;
 
+procedure TBlockSocket.SetNonBlockMode(Value: Boolean);
+var
+  x: integer;
+begin
+  FNonBlockMode := Value;
+  if Value then
+    x := 1
+  else
+    x := 0;
+  synsock.IoctlSocket(FSocket, FIONBIO, u_long(x));
+end;
+
 //See 'winsock2.txt' file in distribute package!
 function TBlockSocket.SetTimeout(Timeout: Integer): Boolean;
 begin
@@ -940,6 +986,18 @@ begin
           CanReadList.Add(TBlockSocket(SocketList.Items[n]));
 end;
 
+function TBlockSocket.EnableReuse(Value: Boolean): Boolean;
+var
+  Opt: Integer;
+  Res: Integer;
+begin
+  opt := Ord(Value);
+  Res := synsock.SetSockOpt(FSocket, SOL_SOCKET, SO_REUSEADDR, @Opt, SizeOf(opt));
+  SockCheck(Res);
+  Result := res = 0;
+  ExceptCheck;
+end;
+
 procedure TBlockSocket.DoStatus(Reason: THookSocketReason; const Value: string);
 begin
   if assigned(OnStatus) then
@@ -1044,7 +1102,7 @@ begin
     WSANOTINITIALISED: {10093}
       Result := 'Winsock not initialized';
     WSAEDISCON: {10101}
-      Result := 'WSAEDISCON-10101';
+      Result := 'Disconnect';
     WSAHOST_NOT_FOUND: {11001}
       Result := 'Host not found';
     WSATRY_AGAIN: {11002}
@@ -1325,6 +1383,28 @@ begin
   end;
 end;
 
+procedure TUDPBlockSocket.AddMulticast(MCastIP: string);
+var
+  Multicast: TMulticast;
+begin
+  Multicast.MCastAddr := synsock.inet_addr(PChar(MCastIP));
+  Multicast.MCastIfc := u_long(INADDR_ANY);
+  SockCheck(synsock.SetSockOpt(FSocket, IPPROTO_IP, IP_ADD_MEMBERSHIP,
+    pchar(@Multicast), SizeOf(Multicast)));
+  ExceptCheck;
+end;
+
+procedure TUDPBlockSocket.DropMulticast(MCastIP: string);
+var
+  Multicast: TMulticast;
+begin
+  Multicast.MCastAddr := synsock.inet_addr(PChar(MCastIP));
+  Multicast.MCastIfc := u_long(INADDR_ANY);
+  SockCheck(synsock.SetSockOpt(FSocket, IPPROTO_IP, IP_DROP_MEMBERSHIP,
+    pchar(@Multicast), SizeOf(Multicast)));
+  ExceptCheck;
+end;
+
 {======================================================================}
 
 procedure TTCPBlockSocket.CreateSocket;
@@ -1356,7 +1436,7 @@ begin
     if Sip = '0.0.0.0' then
       Sip := LocalName;
     SPort := IntToStr(GetLocalSinPort);
-    Connect(FSocksIP, FSocksPort);
+    inherited Connect(FSocksIP, FSocksPort);
     b := SocksOpen;
     if b then
       b := SocksRequest(2, Sip, SPort);
diff --git a/mimeinln.pas b/mimeinln.pas
index f42ba16..caf4d8f 100644
--- a/mimeinln.pas
+++ b/mimeinln.pas
@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 001.000.002 |
+| Project : Delphree - Synapse                                   | 001.000.003 |
 |==============================================================================|
 | Content: Inline MIME support procedures and functions                        |
 |==============================================================================|
@@ -72,7 +72,7 @@ begin
   Result := Value;
   x := Pos('=?', Result);
   y := SearchEndInline(Result, x);
-  while y > x do
+  while (y > x) and (x > 0) do  //fix by Marcus Moennig (minibbjd@gmx.de)
   begin
     s := Copy(Result, x, y - x + 2);
     su := Copy(s, 3, Length(s) - 4);
diff --git a/mimemess.pas b/mimemess.pas
index bbe77de..83ca7fa 100644
--- a/mimemess.pas
+++ b/mimemess.pas
@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 001.005.000 |
+| Project : Delphree - Synapse                                   | 001.007.000 |
 |==============================================================================|
 | Content: MIME message object                                                 |
 |==============================================================================|
@@ -38,21 +38,27 @@ type
   private
     FFrom: string;
     FToList: TStringList;
+    FCCList: TStringList;
     FSubject: string;
     FOrganization: string;
     FCustomHeaders: TStringList;
+    FDate: TDateTime;
   public
     constructor Create;
     destructor Destroy; override;
     procedure Clear;
-    procedure EncodeHeaders(Value: TStringList);
-    procedure DecodeHeaders(Value: TStringList);
+    procedure EncodeHeaders(const Value: TStringList);
+    procedure DecodeHeaders(const Value: TStringList);
+    function FindHeader(Value: string): string;
+    procedure FindHeaderList(Value: string; const HeaderList: TStringList);
   published
     property From: string read FFrom Write FFrom;
     property ToList: TStringList read FToList;
+    property CCList: TStringList read FCCList;
     property Subject: string read FSubject Write FSubject;
     property Organization: string read FOrganization Write FOrganization;
     property CustomHeaders: TStringList read FCustomHeaders;
+    property Date: TDateTime read FDate Write FDate;
   end;
 
   TMimeMess = class(TObject)
@@ -66,8 +72,8 @@ type
     destructor Destroy; override;
     procedure Clear;
     function AddPart: Integer;
-    procedure AddPartText(Value: TStringList);
-    procedure AddPartHTML(Value: TStringList);
+    procedure AddPartText(const Value: TStringList);
+    procedure AddPartHTML(const Value: TStringList);
     procedure AddPartHTMLBinary(Value, Cid: string);
     procedure AddPartBinary(Value: string);
     procedure EncodeMessage;
@@ -89,12 +95,14 @@ constructor TMessHeader.Create;
 begin
   inherited Create;
   FToList := TStringList.Create;
+  FCCList := TStringList.Create;
   FCustomHeaders := TStringList.Create;
 end;
 
 destructor TMessHeader.Destroy;
 begin
   FCustomHeaders.Free;
+  FCCList.Free;
   FToList.Free;
   inherited Destroy;
 end;
@@ -105,23 +113,29 @@ procedure TMessHeader.Clear;
 begin
   FFrom := '';
   FToList.Clear;
+  FCCList.Clear;
   FSubject := '';
   FOrganization := '';
   FCustomHeaders.Clear;
+  FDate := 0;
 end;
 
-procedure TMessHeader.EncodeHeaders(Value: TStringList);
+procedure TMessHeader.EncodeHeaders(const Value: TStringList);
 var
   n: Integer;
 begin
+  if FDate = 0 then
+    FDate := Now;
   for n := FCustomHeaders.Count - 1 downto 0 do
     if FCustomHeaders[n] <> '' then
       Value.Insert(0, FCustomHeaders[n]);
-  Value.Insert(0, 'x-mailer: Synapse - Delphi TCP/IP library by Lukas Gebauer');
+  Value.Insert(0, 'x-mailer: Synapse - Delphi & Kylix TCP/IP library by Lukas Gebauer');
   Value.Insert(0, 'MIME-Version: 1.0 (produced by Synapse)');
-  Value.Insert(0, 'date: ' + Rfc822DateTime(Now));
   if FOrganization <> '' then
     Value.Insert(0, 'Organization: ' + InlineCode(FOrganization));
+  for n := 0 to FCCList.Count - 1 do
+    Value.Insert(0, 'CC: ' + InlineEmail(FCCList[n]));
+  Value.Insert(0, 'Date: ' + Rfc822DateTime(FDate));
   if FSubject <> '' then
     Value.Insert(0, 'Subject: ' + InlineCode(FSubject));
   for n := 0 to FToList.Count - 1 do
@@ -129,9 +143,9 @@ begin
   Value.Insert(0, 'From: ' + InlineEmail(FFrom));
 end;
 
-procedure TMessHeader.DecodeHeaders(Value: TStringList);
+procedure TMessHeader.DecodeHeaders(const Value: TStringList);
 var
-  s: string;
+  s, t: string;
   x: Integer;
   cp: TMimeChar;
 begin
@@ -160,13 +174,58 @@ begin
     end;
     if Pos('TO:', UpperCase(s)) = 1 then
     begin
-      FToList.Add(InlineDecode(SeparateRight(s, ':'), cp));
+      s := SeparateRight(s, ':');
+      repeat
+        t := InlineDecode(fetch(s, ','), cp);
+        if t <> '' then
+          FToList.Add(t);
+      until s = '';
+      continue;
+    end;
+    if Pos('CC:', UpperCase(s)) = 1 then
+    begin
+      s := SeparateRight(s, ':');
+      repeat
+        t := InlineDecode(fetch(s, ','), cp);
+        if t <> '' then
+          FCCList.Add(t);
+      until s = '';
+      continue;
+    end;
+    if Pos('DATE:', UpperCase(s)) = 1 then
+    begin
+      FDate := DecodeRfcDateTime(SeparateRight(s, ':'));
       continue;
     end;
     FCustomHeaders.Add(s);
   end;
 end;
 
+function TMessHeader.FindHeader(Value: string): string;
+var
+  n: integer;
+begin
+  Result := '';
+  for n := 0 to FCustomHeaders.Count - 1 do
+    if Pos(Value, FCustomHeaders[n]) = 1 then
+    begin
+      Result := SeparateRight(FCustomHeaders[n], ':');
+      break;
+    end;
+end;
+
+procedure TMessHeader.FindHeaderList(Value: string; const HeaderList: TStringList);
+var
+  n: integer;
+begin
+  HeaderList.Clear;
+  for n := 0 to FCustomHeaders.Count - 1 do
+    if Pos(Value, FCustomHeaders[n]) = 1 then
+    begin
+      HeaderList.Add(SeparateRight(FCustomHeaders[n], ':'));
+    end;
+end;
+
 {==============================================================================}
 
 constructor TMimeMess.Create;
@@ -180,6 +239,7 @@ end;
 
 destructor TMimeMess.Destroy;
 begin
+  Clear;
   FHeader.Free;
   Lines.Free;
   PartList.Free;
@@ -209,7 +269,7 @@ end;
 
 {==============================================================================}
 
-procedure TMimeMess.AddPartText(Value: TStringList);
+procedure TMimeMess.AddPartText(const Value: TStringList);
 begin
   with TMimePart(FPartList[AddPart]) do
   begin
@@ -228,7 +288,7 @@ end;
 
 {==============================================================================}
 
-procedure TMimeMess.AddPartHTML(Value: TStringList);
+procedure TMimeMess.AddPartHTML(const Value: TStringList);
 begin
   with TMimePart(FPartList[AddPart]) do
   begin
diff --git a/mimepart.pas b/mimepart.pas
index 014820f..407766b 100644
--- a/mimepart.pas
+++ b/mimepart.pas
@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 001.005.002 |
+| Project : Delphree - Synapse                                   | 001.007.000 |
 |==============================================================================|
 | Content: MIME support procedures and functions                               |
 |==============================================================================|
@@ -44,6 +44,7 @@ type
     FPrimary: string;
     FEncoding: string;
     FCharset: string;
+    FDefaultCharset: string;
     FPrimaryCode: TMimePrimary;
     FEncodingCode: TMimeEncoding;
     FCharsetCode: TMimeChar;
@@ -71,6 +72,7 @@ type
     property Primary: string read FPrimary write SetPrimary;
     property Encoding: string read FEncoding write SetEncoding;
     property Charset: string read FCharset write SetCharset;
+    property DefaultCharset: string read FDefaultCharset write FDefaultCharset;
     property PrimaryCode: TMimePrimary read FPrimaryCode Write FPrimaryCode;
     property EncodingCode: TMimeEncoding read FEncodingCode Write FEncodingCode;
     property CharsetCode: TMimeChar read FCharsetCode Write FCharsetCode;
@@ -157,6 +159,7 @@ begin
   FLines := TStringList.Create;
   FDecodedLines := TMemoryStream.Create;
   FTargetCharset := GetCurCP;
+  FDefaultCharset := 'US-ASCII';
 end;
 
 destructor TMIMEPart.Destroy;
@@ -205,7 +208,7 @@ begin
     Primary := 'text';
     FSecondary := 'plain';
     FDescription := '';
-    Charset := 'US-ASCII';
+    Charset := FDefaultCharset;
     FFileName := '';
     Encoding := '7BIT';
 
@@ -337,10 +340,8 @@ begin
         if Pos('--' + b, s) = 1 then
         begin
           s := TrimRight(s);
-          x := Length(s);
-          if x > 4 then
-            if (s[x] = '-') and (S[x-1] = '-') then
-              Result := Value.Count - 1;
+          if s = ('--' + b + '--') then
+            Result := Value.Count - 1;
           Break;
         end;
       end;
@@ -406,8 +407,10 @@ end;
 procedure TMIMEPart.EncodePart;
 var
   l: TStringList;
-  s, buff: string;
+  s, t: string;
   n, x: Integer;
+const
+  MaxLine = 75;
 begin
   if (FEncodingCode = ME_UU) or (FEncodingCode = ME_XX) then
     Encoding := 'base64';
@@ -423,11 +426,9 @@ begin
         begin
           while FDecodedLines.Position < FDecodedLines.Size do
           begin
-            Setlength(Buff, 54);
-            s := '';
-            x := FDecodedLines.Read(pointer(Buff)^, 54);
-            for n := 1 to x do
-              s := s + Buff[n];
+            Setlength(s, 54);
+            x := FDecodedLines.Read(pointer(s)^, 54);
+            Setlength(s, x);
             if FPrimaryCode = MP_TEXT then
               s := CharsetConversion(s, FTargetCharset, FCharsetCode);
             s := EncodeBase64(s);
@@ -440,13 +441,23 @@ begin
           for n := 0 to l.Count - 1 do
           begin
             s := l[n];
-            if FPrimaryCode = MP_TEXT then
+            if (FPrimaryCode = MP_TEXT) and (FEncodingCode <> ME_7BIT) then
               s := CharsetConversion(s, FTargetCharset, FCharsetCode);
-            s := EncodeQuotedPrintable(s);
-            FLines.Add(s);
+            if FEncodingCode = ME_QUOTED_PRINTABLE then
+            begin
+              s := EncodeQuotedPrintable(s);
+              repeat
+                t := Copy(s, 1, MaxLine);
+                s := Copy(s, MaxLine + 1, Length(s) - MaxLine);
+                if s <> '' then
+                  t := t + '=';
+                FLines.Add(t);
+              until s = '';
+            end
+            else
+              FLines.Add(s);
           end;
         end;
-
     end;
     FLines.Add('');
     FLines.Insert(0, '');
diff --git a/pingsend.pas b/pingsend.pas
index 614adc5..13cde86 100644
--- a/pingsend.pas
+++ b/pingsend.pas
@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 002.001.002 |
+| Project : Delphree - Synapse                                   | 002.002.000 |
 |==============================================================================|
 | Content: PING sender                                                         |
 |==============================================================================|
@@ -69,7 +69,6 @@ type
     FPacketSize: Integer;
     FPingTime: Integer;
     function Checksum: Integer;
-    function GetTick: Cardinal;
     function ReadPacket: Boolean;
   public
     function Ping(const Host: string): Boolean;
@@ -178,25 +177,6 @@ begin
   Result := Word(not CkSum);
 end;
 
-{$IFDEF LINUX}
-
-function TPINGSend.GetTick: Cardinal;
-var
-  Stamp: TTimeStamp;
-begin
-  Stamp := DateTimeToTimeStamp(Now);
-  Result := Stamp.Time;
-end;
-
-{$ELSE}
-
-function TPINGSend.GetTick: Cardinal;
-begin
-  Result := Windows.GetTickCount;
-end;
-
-{$ENDIF}
-
 {==============================================================================}
 
 function PingHost(const Host: string): Integer;
diff --git a/pop3send.pas b/pop3send.pas
index 5b4cd93..eb254f0 100644
--- a/pop3send.pas
+++ b/pop3send.pas
@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 001.001.002 |
+| Project : Delphree - Synapse                                   | 001.002.000 |
 |==============================================================================|
 | Content: POP3 client                                                         |
 |==============================================================================|
@@ -185,7 +185,16 @@ begin
   end;
   Result := False;
   if (FTimeStamp <> '') and not (FAuthType = POP3AuthLogin) then
+  begin
     Result := AuthApop;
+    if not Result then
+    begin
+      if not Connect then
+        Exit;
+      if ReadResult(False) <> 1 then
+        Exit;
+    end;
+  end;
   if not Result and not (FAuthType = POP3AuthAPOP) then
     Result := AuthLogin;
 end;
diff --git a/slogsend.pas b/slogsend.pas
index 84f6ac3..0d935b4 100644
--- a/slogsend.pas
+++ b/slogsend.pas
@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 001.000.000 |
+| Project : Delphree - Synapse                                   | 001.000.001 |
 |==============================================================================|
 | Content: SysLog client                                                       |
 |==============================================================================|
@@ -137,6 +137,8 @@ begin
   Buf := Buf + Tag + ': ' + FMessage;
   if Length(Buf) <= 1024 then
   begin
+    if FSock.EnableReuse(True) then
+      Fsock.Bind('0.0.0.0', FSyslogPort);
     FSock.Connect(FSyslogHost, FSyslogPort);
     FSock.SendString(Buf);
     Result := FSock.LastError = 0;
diff --git a/snmpsend.pas b/snmpsend.pas
index 59c3989..dc80cea 100644
--- a/snmpsend.pas
+++ b/snmpsend.pas
@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 002.003.005 |
+| Project : Delphree - Synapse                                   | 002.003.006 |
 |==============================================================================|
 | Content: SNMP client                                                         |
 |==============================================================================|
@@ -18,7 +18,7 @@
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
-|   Jean-Fabien Connault (jfconnault@mail.dotcom.fr)                           |
+|   Jean-Fabien Connault (cycocrew@worldnet.fr)                                |
 |==============================================================================|
 | History: see HISTORY.HTM from distribution package                           |
 |          (Found at URL: http://www.ararat.cz/synapse/)                       |
@@ -38,14 +38,14 @@ uses
 const
   cSnmpProtocol = '161';
 
-//PDU type
+  //PDU type
   PDUGetRequest = $A0;
   PDUGetNextRequest = $A1;
   PDUGetResponse = $A2;
   PDUSetRequest = $A3;
   PDUTrap = $A4;
 
-//errors
+  //errors
   ENoError = 0;
   ETooBig = 1;
   ENoSuchName = 2;
@@ -60,9 +60,9 @@ type
     FValue: string;
     FValueType: Integer;
   published
-    property OID: string read FOID Write FOID;
-    property Value: string read FValue Write FValue;
-    property ValueType: Integer read FValueType Write FValueType;
+    property OID: string read FOID write FOID;
+    property Value: string read FValue write FValue;
+    property ValueType: Integer read FValueType write FValueType;
   end;
 
   TSNMPRec = class(TObject)
@@ -84,12 +84,12 @@ type
     procedure MIBDelete(Index: Integer);
     function MIBGet(const MIB: string): string;
   published
-    property Version: Integer read FVersion Write FVersion;
-    property Community: string read FCommunity Write FCommunity;
-    property PDUType: Integer read FPDUType Write FPDUType;
-    property ID: Integer read FID Write FID;
-    property ErrorStatus: Integer read FErrorStatus Write FErrorStatus;
-    property ErrorIndex: Integer read FErrorIndex Write FErrorIndex;
+    property Version: Integer read FVersion write FVersion;
+    property Community: string read FCommunity write FCommunity;
+    property PDUType: Integer read FPDUType write FPDUType;
+    property ID: Integer read FID write FID;
+    property ErrorStatus: Integer read FErrorStatus write FErrorStatus;
+    property ErrorIndex: Integer read FErrorIndex write FErrorIndex;
     property SNMPMibList: TList read FSNMPMibList;
   end;
 
@@ -107,18 +107,16 @@ type
     destructor Destroy; override;
     function DoIt: Boolean;
   published
-    property Timeout: Integer read FTimeout Write FTimeout;
-    property Host: string read FHost Write FHost;
+    property Timeout: Integer read FTimeout write FTimeout;
+    property Host: string read FHost write FHost;
     property HostIP: string read FHostIP;
     property Query: TSNMPRec read FQuery;
     property Reply: TSNMPRec read FReply;
     property Sock: TUDPBlockSocket read FSock;
   end;
 
-function SNMPGet(const Oid, Community, SNMPHost: string;
-  var Value: string): Boolean;
-function SNMPSet(const Oid, Community, SNMPHost, Value: string;
-  ValueType: Integer): Boolean;
+function SNMPGet(const OID, Community, SNMPHost: string; var Value: string): Boolean;
+function SNMPSet(const OID, Community, SNMPHost, Value: string; ValueType: Integer): Boolean;
 
 implementation
 
@@ -128,7 +126,7 @@ constructor TSNMPRec.Create;
 begin
   inherited Create;
   FSNMPMibList := TList.Create;
-  id := 1;
+  FID := 1;
 end;
 
 destructor TSNMPRec.Destroy;
@@ -137,6 +135,7 @@ var
 begin
   for i := 0 to FSNMPMibList.Count - 1 do
     TSNMPMib(FSNMPMibList[i]).Free;
+  FSNMPMibList.Clear;
   FSNMPMibList.Free;
   inherited Destroy;
 end;
@@ -292,12 +291,9 @@ begin
 end;
 
 function TSNMPSend.DoIt: Boolean;
-var
-  x: Integer;
 begin
-  Result := False;
   FReply.Clear;
-  FBuffer := Query.EncodeBuf;
+  FBuffer := FQuery.EncodeBuf;
   FSock.Connect(FHost, cSnmpProtocol);
   FHostIP := '0.0.0.0';
   FSock.SendString(FBuffer);
@@ -305,43 +301,45 @@ begin
   if FSock.LastError = 0 then
   begin
     FHostIP := FSock.GetRemoteSinIP;
-    Result := True;
-  end;
-  if Result then
     Result := FReply.DecodeBuf(FBuffer);
+  end
+  else
+    Result := False;
 end;
 
 {==============================================================================}
 
-function SNMPGet(const Oid, Community, SNMPHost: string;
-  var Value: string): Boolean;
-var
-  SNMP: TSNMPSend;
-begin
-  SNMP := TSNMPSend.Create;
-  try
-    SNMP.Query.Community := Community;
-    SNMP.Query.PDUType := PDUGetRequest;
-    SNMP.Query.MIBAdd(Oid, '', ASN1_NULL);
-    SNMP.Host := SNMPHost;
-    Result := SNMP.DoIt;
-    if Result then
-      Value := SNMP.Reply.MIBGet(Oid);
-  finally
-    SNMP.Free;
-  end;
-end;
-
-function SNMPSet(const Oid, Community, SNMPHost, Value: string;
-  ValueType: Integer): Boolean;
+function SNMPGet(const OID, Community, SNMPHost: string; var Value: string): Boolean;
 var
   SNMPSend: TSNMPSend;
 begin
   SNMPSend := TSNMPSend.Create;
   try
+    SNMPSend.Query.Clear;
+    SNMPSend.Query.Community := Community;
+    SNMPSend.Query.PDUType := PDUGetRequest;
+    SNMPSend.Query.MIBAdd(OID, '', ASN1_NULL);
+    SNMPSend.Host := SNMPHost;
+    Result := SNMPSend.DoIt;
+    if Result then
+      Value := SNMPSend.Reply.MIBGet(OID)
+    else
+      Value := '';
+  finally
+    SNMPSend.Free;
+  end;
+end;
+
+function SNMPSet(const OID, Community, SNMPHost, Value: string; ValueType: Integer): Boolean;
+var
+  SNMPSend: TSNMPSend;
+begin
+  SNMPSend := TSNMPSend.Create;
+  try
+    SNMPSend.Query.Clear;
     SNMPSend.Query.Community := Community;
     SNMPSend.Query.PDUType := PDUSetRequest;
-    SNMPSend.Query.MIBAdd(Oid, Value, ValueType);
+    SNMPSend.Query.MIBAdd(OID, Value, ValueType);
     SNMPSend.Host := SNMPHost;
     Result := SNMPSend.DoIt = True;
   finally
@@ -350,3 +348,5 @@ begin
 end;
 
 end.
+
+
diff --git a/sntpsend.pas b/sntpsend.pas
index de9d60b..c7d3bf7 100644
--- a/sntpsend.pas
+++ b/sntpsend.pas
@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 002.000.002 |
+| Project : Delphree - Synapse                                   | 002.001.000 |
 |==============================================================================|
 | Content: SNTP client                                                         |
 |==============================================================================|
@@ -18,6 +18,7 @@
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
+|   Patrick Chevalley                                                          |
 |==============================================================================|
 | History: see HISTORY.HTM from distribution package                           |
 |          (Found at URL: http://www.ararat.cz/synapse/)                       |
@@ -32,7 +33,7 @@ interface
 
 uses
   SysUtils,
-  synsock, blcksock;
+  synsock, blcksock, SynaUtil;
 
 const
   cNtpProtocol = 'ntp';
@@ -61,19 +62,30 @@ type
   private
     FNTPReply: TNtp;
     FNTPTime: TDateTime;
+    FNTPOffset: double;
+    FNTPDelay: double;
+    FMaxSyncDiff: double;
+    FSyncTime: Boolean;
     FSntpHost: string;
     FTimeout: Integer;
     FSock: TUDPBlockSocket;
     FBuffer: string;
+    FLi, FVn, Fmode : byte;
   public
     constructor Create;
     destructor Destroy; override;
     function DecodeTs(Nsec, Nfrac: Longint): TDateTime;
+    procedure EncodeTs(dt: TDateTime; var Nsec, Nfrac: Longint);
+    function GetSNTP: Boolean;
     function GetNTP: Boolean;
     function GetBroadcastNTP: Boolean;
   published
     property NTPReply: TNtp read FNTPReply;
     property NTPTime: TDateTime read FNTPTime;
+    property NTPOffset: Double read FNTPOffset;
+    property NTPDelay: Double read FNTPDelay;
+    property MaxSyncDiff: double read FMaxSyncDiff write FMaxSyncDiff;
+    property SyncTime: Boolean read FSyncTime write FSyncTime;
     property SntpHost: string read FSntpHost write FSntpHost;
     property Timeout: Integer read FTimeout write FTimeout;
     property Sock: TUDPBlockSocket read FSock;
@@ -88,6 +100,8 @@ begin
   FSock.CreateSocket;
   FTimeout := 5000;
   FSntpHost := cLocalhost;
+  FMaxSyncDiff := 3600;
+  FSyncTime := False;
 end;
 
 destructor TSNTPSend.Destroy;
@@ -98,7 +112,7 @@ end;
 
 function TSNTPSend.DecodeTs(Nsec, Nfrac: Longint): TDateTime;
 const
-  maxi = 4294967296.0;
+  maxi = 4294967295.0;
 var
   d, d1: Double;
 begin
@@ -106,16 +120,38 @@ begin
   Nfrac := synsock.htonl(Nfrac);
   d := Nsec;
   if d < 0 then
-    d := maxi + d - 1;
+    d := maxi + d + 1;
   d1 := Nfrac;
   if d1 < 0 then
-    d1 := maxi + d1 - 1;
+    d1 := maxi + d1 + 1;
   d1 := d1 / maxi;
-  d1 := Trunc(d1 * 1000) / 1000;
+  d1 := Trunc(d1 * 10000) / 10000;
   Result := (d + d1) / 86400;
   Result := Result + 2;
 end;
 
+procedure TSNTPSend.EncodeTs(dt: TDateTime; var Nsec, Nfrac: Longint);
+const
+  maxi = 4294967295.0;
+  maxilongint = 2147483647;
+var
+  d, d1: Double;
+begin
+  d  := (dt - 2) * 86400;
+  d1 := frac(d);
+  d  := trunc(d);
+  if d>maxilongint then
+     d := d - maxi - 1;
+  d1 := Trunc(d1 * 10000) / 10000;
+  d1 := d1 * maxi;
+  if d1>maxilongint then
+     d1 := d1 - maxi - 1;
+  Nsec:=trunc(d);
+  Nfrac:=trunc(d1);
+  Nsec := synsock.htonl(Nsec);
+  Nfrac := synsock.htonl(Nfrac);
+end;
+
 function TSNTPSend.GetBroadcastNTP: Boolean;
 var
   NtpPtr: PNtp;
@@ -123,23 +159,24 @@ var
 begin
   Result := False;
   FSock.Bind('0.0.0.0', cNtpProtocol);
-  if FSock.CanRead(Timeout) then
+  FBuffer := FSock.RecvPacket(FTimeout);
+  if FSock.LastError = 0 then
   begin
-    x := FSock.WaitingData;
-    SetLength(FBuffer, x);
-    FSock.RecvBufferFrom(Pointer(FBuffer), x);
+    x := Length(FBuffer);
     if (SntpHost = '0.0.0.0') or (FSock.GetRemoteSinIP = SntpHost) then
       if x >= SizeOf(NTPReply) then
       begin
         NtpPtr := Pointer(FBuffer);
         FNTPReply := NtpPtr^;
         FNTPTime := DecodeTs(NTPReply.Xmit1, NTPReply.Xmit2);
+        if FSyncTime and ((abs(FNTPTime - GetUTTime) * 86400) <= FMaxSyncDiff) then
+          SetUTTime(FNTPTime);
         Result := True;
       end;
   end;
 end;
 
-function TSNTPSend.GetNTP: Boolean;
+function TSNTPSend.GetSNTP: Boolean;
 var
   q: TNtp;
   NtpPtr: PNtp;
@@ -150,19 +187,65 @@ begin
   FillChar(q, SizeOf(q), 0);
   q.mode := $1B;
   FSock.SendBuffer(@q, SizeOf(q));
-  if FSock.CanRead(Timeout) then
+  FBuffer := FSock.RecvPacket(FTimeout);
+  if FSock.LastError = 0 then
   begin
-    x := FSock.WaitingData;
-    SetLength(FBuffer, x);
-    FSock.RecvBuffer(Pointer(FBuffer), x);
+    x := Length(FBuffer);
     if x >= SizeOf(NTPReply) then
     begin
       NtpPtr := Pointer(FBuffer);
       FNTPReply := NtpPtr^;
       FNTPTime := DecodeTs(NTPReply.Xmit1, NTPReply.Xmit2);
+      if FSyncTime and ((abs(FNTPTime - GetUTTime) * 86400) <= FMaxSyncDiff) then
+        SetUTTime(FNTPTime);
       Result := True;
     end;
   end;
 end;
 
+function TSNTPSend.GetNTP: Boolean;
+var
+  q: TNtp;
+  NtpPtr: PNtp;
+  x: Integer;
+  t1, t2, t3, t4 : TDateTime;
+begin
+  Result := False;
+  FSock.Connect(sntphost, cNtpProtocol);
+  FillChar(q, SizeOf(q), 0);
+  q.mode := $1B;
+  t1 := GetUTTime;
+  EncodeTs(t1,q.org1,q.org2);
+  FSock.SendBuffer(@q, SizeOf(q));
+  FBuffer := FSock.RecvPacket(FTimeout);
+  if FSock.LastError = 0 then
+  begin
+    x := Length(FBuffer);
+    t4 := GetUTTime;
+    if x >= SizeOf(NTPReply) then
+    begin
+      NtpPtr := Pointer(FBuffer);
+      FNTPReply := NtpPtr^;
+      FLi := (NTPReply.mode and $C0) shr 6;
+      FVn := (NTPReply.mode and $38) shr 3;
+      Fmode := NTPReply.mode and $07;
+      if (Fli < 3) and (Fmode = 4) and
+         (NTPReply.stratum >= 1) and (NTPReply.stratum <= 15) and
+         (NTPReply.Rcv1 <> 0) and (NTPReply.Xmit1 <> 0)
+         then begin
+           t2 := DecodeTs(NTPReply.Rcv1, NTPReply.Rcv2);
+           t3 := DecodeTs(NTPReply.Xmit1, NTPReply.Xmit2);
+           FNTPDelay := (T4 - T1) - (T2 - T3);
+           FNTPTime := t3 + FNTPDelay / 2;
+           FNTPOffset := (((T2 - T1) + (T3 - T4)) / 2) * 86400;
+           FNTPDelay := FNTPDelay * 86400;
+           if FSyncTime and ((abs(FNTPTime - t1) * 86400) <= FMaxSyncDiff) then
+             SetUTTime(FNTPTime);
+           Result := True;
+           end
+         else result:=false;
+    end;
+  end;
+end;
+
 end.
diff --git a/synachar.pas b/synachar.pas
index bf72382..2206a85 100644
--- a/synachar.pas
+++ b/synachar.pas
@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 004.000.000 |
+| Project : Delphree - Synapse                                   | 004.000.001 |
 |==============================================================================|
 | Content: Charset conversion support                                          |
 |==============================================================================|
@@ -947,7 +947,7 @@ begin
         s := s + c;
       end;
       if s = '' then
-        s := '+'
+        s := WriteMulti(Ord('+'), 0, 0, 0, 2)
       else
         s := DecodeBase64(s);
       Result := Result + s;
diff --git a/synacode.pas b/synacode.pas
index 0b2f3e9..a82473e 100644
--- a/synacode.pas
+++ b/synacode.pas
@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 001.004.001 |
+| Project : Delphree - Synapse                                   | 001.005.002 |
 |==============================================================================|
 | Content: Coding and decoding support                                         |
 |==============================================================================|
@@ -52,7 +52,33 @@ const
     '`!"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';
   TableXX =
     '+-0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_';
-
+  ReTablebase64 =
+    #$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$3E +#$40
+    +#$40 +#$40 +#$3F +#$34 +#$35 +#$36 +#$37 +#$38 +#$39 +#$3A +#$3B +#$3C
+    +#$3D +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$00 +#$01 +#$02 +#$03
+    +#$04 +#$05 +#$06 +#$07 +#$08 +#$09 +#$0A +#$0B +#$0C +#$0D +#$0E +#$0F
+    +#$10 +#$11 +#$12 +#$13 +#$14 +#$15 +#$16 +#$17 +#$18 +#$19 +#$40 +#$40
+    +#$40 +#$40 +#$40 +#$40 +#$1A +#$1B +#$1C +#$1D +#$1E +#$1F +#$20 +#$21
+    +#$22 +#$23 +#$24 +#$25 +#$26 +#$27 +#$28 +#$29 +#$2A +#$2B +#$2C +#$2D
+    +#$2E +#$2F +#$30 +#$31 +#$32 +#$33 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40;
+  ReTableUU =
+    #$01 +#$02 +#$03 +#$04 +#$05 +#$06 +#$07 +#$08 +#$09 +#$0A +#$0B +#$0C
+    +#$0D +#$0E +#$0F +#$10 +#$11 +#$12 +#$13 +#$14 +#$15 +#$16 +#$17 +#$18
+    +#$19 +#$1A +#$1B +#$1C +#$1D +#$1E +#$1F +#$20 +#$21 +#$22 +#$23 +#$24
+    +#$25 +#$26 +#$27 +#$28 +#$29 +#$2A +#$2B +#$2C +#$2D +#$2E +#$2F +#$30
+    +#$31 +#$32 +#$33 +#$34 +#$35 +#$36 +#$37 +#$38 +#$39 +#$3A +#$3B +#$3C
+    +#$3D +#$3E +#$3F +#$00 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40
+    +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40
+    +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40;
+  ReTableXX =
+    #$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$00 +#$40
+    +#$01 +#$40 +#$40 +#$02 +#$03 +#$04 +#$05 +#$06 +#$07 +#$08 +#$09 +#$0A
+    +#$0B +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$0C +#$0D +#$0E +#$0F
+    +#$10 +#$11 +#$12 +#$13 +#$14 +#$15 +#$16 +#$17 +#$18 +#$19 +#$1A +#$1B
+    +#$1C +#$1D +#$1E +#$1F +#$20 +#$21 +#$22 +#$23 +#$24 +#$25 +#$40 +#$40
+    +#$40 +#$40 +#$40 +#$40 +#$26 +#$27 +#$28 +#$29 +#$2A +#$2B +#$2C +#$2D
+    +#$2E +#$2F +#$30 +#$31 +#$32 +#$33 +#$34 +#$35 +#$36 +#$37 +#$38 +#$39
+    +#$3A +#$3B +#$3C +#$3D +#$3E +#$3F +#$40 +#$40 +#$40 +#$40 +#$40 +#$40;
 
 function DecodeTriplet(const Value: string; Delimiter: Char): string;
 function DecodeQuotedPrintable(const Value: string): string;
@@ -63,6 +89,8 @@ function EncodeQuotedPrintable(const Value: string): string;
 function EncodeURLElement(const Value: string): string;
 function EncodeURL(const Value: string): string;
 function Decode4to3(const Value, Table: string): string;
+function Decode4to3Ex(const Value, Table: string): string;
+function Encode3to4(const Value, Table: string): string;
 function DecodeBase64(const Value: string): string;
 function EncodeBase64(const Value: string): string;
 function DecodeUU(const Value: string): string;
@@ -193,27 +221,31 @@ type
 
 function DecodeTriplet(const Value: string; Delimiter: Char): string;
 var
-  x: Integer;
+  x, l: Integer;
   c: Char;
   s: string;
 begin
-  Result := '';
+  SetLength(Result, Length(Value));
   x := 1;
+  l := 1;
   while x <= Length(Value) do
   begin
     c := Value[x];
     Inc(x);
     if c <> Delimiter then
-      Result := Result + c
+      Result[l] := c
     else
       if x < Length(Value) then
       begin
         s := Copy(Value, x, 2);
         Inc(x, 2);
         if pos(#13, s) + pos(#10, s) = 0 then
-          Result := Result + Char(StrToIntDef('$' + s, 32));
+          Result[l] := Char(StrToIntDef('$' + s, 32));
       end;
+    Inc(l);
   end;
+  Dec(l);
+  SetLength(Result, l);
 end;
 
 {==============================================================================}
@@ -235,17 +267,33 @@ end;
 function EncodeTriplet(const Value: string; Delimiter: Char;
   Specials: TSpecials): string;
 var
-  n: Integer;
+  n, l: Integer;
   s: string;
+  c: char;
 begin
-  Result := '';
+  SetLength(Result, Length(Value) * 3);
+  l := 1;
   for n := 1 to Length(Value) do
   begin
-    s := Value[n];
-    if s[1] in Specials then
-      s := Delimiter + IntToHex(Ord(s[1]), 2);
-    Result := Result + s;
+    c := Value[n];
+    if c in Specials then
+    begin
+      Result[l] := Delimiter;
+      Inc(l);
+      s := IntToHex(Ord(c), 2);
+      Result[l] := s[1];
+      Inc(l);
+      Result[l] := s[2];
+      Inc(l);
+    end
+    else
+    begin
+      Result[l] := c;
+      Inc(l);
+    end;
   end;
+  Dec(l);
+  SetLength(Result, l);
 end;
 
 {==============================================================================}
@@ -274,11 +322,12 @@ end;
 
 function Decode4to3(const Value, Table: string): string;
 var
-  x, y, n: Integer;
+  x, y, n, l: Integer;
   d: array[0..3] of Byte;
 begin
-  Result := '';
+  SetLength(Result, Length(Value));
   x := 1;
+  l := 1;
   while x < Length(Value) do
   begin
     for n := 0 to 3 do
@@ -294,33 +343,77 @@ begin
       end;
       Inc(x);
     end;
-    Result := Result + Char((D[0] and $3F) shl 2 + (D[1] and $30) shr 4);
+    Result[l] := Char((D[0] and $3F) shl 2 + (D[1] and $30) shr 4);
+    Inc(l);
     if d[2] <> 64 then
     begin
-      Result := Result + Char((D[1] and $0F) shl 4 + (D[2] and $3C) shr 2);
+      Result[l] := Char((D[1] and $0F) shl 4 + (D[2] and $3C) shr 2);
+      Inc(l);
       if d[3] <> 64 then
-        Result := Result + Char((D[2] and $03) shl 6 + (D[3] and $3F));
+      begin
+        Result[l] := Char((D[2] and $03) shl 6 + (D[3] and $3F));
+        Inc(l);
+      end;
     end;
   end;
+  Dec(l);
+  SetLength(Result, l);
 end;
 
 {==============================================================================}
 
-function DecodeBase64(const Value: string): string;
+function Decode4to3Ex(const Value, Table: string): string;
+var
+  x, y, n, l: Integer;
+  d: array[0..3] of Byte;
 begin
-  Result := Decode4to3(Value, TableBase64);
+  SetLength(Result, Length(Value));
+  x := 1;
+  l := 1;
+  while x < Length(Value) do
+  begin
+    for n := 0 to 3 do
+    begin
+      if x > Length(Value) then
+        d[n] := 64
+      else
+      begin
+        y := Ord(Value[x]);
+        if (y < 33) or (y > 127) then
+          d[n] := 64
+        else
+          d[n] := Ord(Table[y - 32]);
+      end;
+      Inc(x);
+    end;
+    Result[l] := Char((D[0] and $3F) shl 2 + (D[1] and $30) shr 4);
+    Inc(l);
+    if d[2] <> 64 then
+    begin
+      Result[l] := Char((D[1] and $0F) shl 4 + (D[2] and $3C) shr 2);
+      Inc(l);
+      if d[3] <> 64 then
+      begin
+        Result[l] := Char((D[2] and $03) shl 6 + (D[3] and $3F));
+        Inc(l);
+      end;
+    end;
+  end;
+  Dec(l);
+  SetLength(Result, l);
 end;
 
 {==============================================================================}
 
-function EncodeBase64(const Value: string): string;
+function Encode3to4(const Value, Table: string): string;
 var
   c: Byte;
-  n: Integer;
+  n, l: Integer;
   Count: Integer;
   DOut: array[0..3] of Byte;
 begin
-  Result := '';
+  setlength(Result, ((Length(Value) + 2) div 3) * 4);
+  l := 1;
   Count := 1;
   while Count <= Length(Value) do
   begin
@@ -352,12 +445,29 @@ begin
       DOut[3] := $40;
     end;
     for n := 0 to 3 do
-      Result := Result + TableBase64[DOut[n] + 1];
+    begin
+      Result[l] := Table[DOut[n] + 1];
+      Inc(l);
+    end;
   end;
 end;
 
 {==============================================================================}
 
+function DecodeBase64(const Value: string): string;
+begin
+  Result := Decode4to3Ex(Value, ReTableBase64);
+end;
+
+{==============================================================================}
+
+function EncodeBase64(const Value: string): string;
+begin
+  Result := Encode3to4(Value, TableBase64);
+end;
+
+{==============================================================================}
+
 function DecodeUU(const Value: string): string;
 var
   s: string;
diff --git a/synautil.pas b/synautil.pas
index c637998..e4007d4 100644
--- a/synautil.pas
+++ b/synautil.pas
@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 002.003.000 |
+| Project : Delphree - Synapse                                   | 002.007.001 |
 |==============================================================================|
 | Content: support procedures and functions                                    |
 |==============================================================================|
@@ -39,15 +39,22 @@ uses
   Windows;
 {$ENDIF}
 
-function Timezone: string;
+function TimeZoneBias: integer;
+function TimeZone: string;
 function Rfc822DateTime(t: TDateTime): string;
 function CDateTime(t: TDateTime): string;
+function SimpleDateTime(t: TDateTime): string;
+function DecodeRfcDateTime(Value: string): TDateTime;
+function GetUTTime: TDateTime;
+function SetUTTime(Newdt: TDateTime): Boolean;
+function GetTick: Cardinal;
 function CodeInt(Value: Word): string;
 function DecodeInt(const Value: string; Index: Integer): Word;
 function IsIP(const Value: string): Boolean;
 function ReverseIP(Value: string): string;
 function IPToID(Host: string): string;
 procedure Dump(const Buffer, DumpFile: string);
+procedure DumpEx(const Buffer, DumpFile: string);
 function SeparateLeft(const Value, Delimiter: string): string;
 function SeparateRight(const Value, Delimiter: string): string;
 function GetParameter(const Value, Parameter: string): string;
@@ -102,26 +109,19 @@ begin
 end;
 {==============================================================================}
 
-function Timezone: string;
+function TimeZoneBias: integer;
 {$IFDEF LINUX}
 var
   t: TTime_T;
   UT: TUnixTime;
-  bias: Integer;
-  h, m: Integer;
 begin
   __time(@T);
   localtime_r(@T, UT);
-  bias := ut.__tm_gmtoff div 60;
-  if bias >= 0 then
-    Result := '+'
-  else
-    Result := '-';
+  Result := ut.__tm_gmtoff div 60;
 {$ELSE}
 var
   zoneinfo: TTimeZoneInformation;
   bias: Integer;
-  h, m: Integer;
 begin
   case GetTimeZoneInformation(Zoneinfo) of
     2:
@@ -131,11 +131,22 @@ begin
   else
     bias := zoneinfo.Bias;
   end;
-  if bias <= 0 then
+  Result := bias * (-1);
+{$ENDIF}
+end;
+
+{==============================================================================}
+
+function TimeZone: string;
+var
+  bias: Integer;
+  h, m: Integer;
+begin
+  bias := TimeZoneBias;
+  if bias >= 0 then
     Result := '+'
   else
     Result := '-';
-{$ENDIF}
   bias := Abs(bias);
   h := bias div 60;
   m := bias mod 60;
@@ -148,7 +159,7 @@ function Rfc822DateTime(t: TDateTime): string;
 begin
   SaveNames;
   try
-    Result := FormatDateTime('ddd, d mmm yyyy hh:mm:ss', t);
+    Result := FormatDateTime('ddd, d mmm yyyy hh:nn:ss', t);
     Result := Result + ' ' + Timezone;
   finally
     RestoreNames;
@@ -161,7 +172,7 @@ function CDateTime(t: TDateTime): string;
 begin
   SaveNames;
   try
-    Result := FormatDateTime('mmm dd hh:mm:ss', t);
+    Result := FormatDateTime('mmm dd hh:nn:ss', t);
     if Result[5] = '0' then
       Result[5] := ' ';
   finally
@@ -171,6 +182,260 @@ end;
 
 {==============================================================================}
 
+function SimpleDateTime(t: TDateTime): string;
+begin
+  SaveNames;
+  try
+    Result := FormatDateTime('yymmdd hhnnss', t);
+  finally
+    RestoreNames;
+  end;
+end;
+
+{==============================================================================}
+
+function DecodeTimeZone(Value: string; var Zone: integer): Boolean;
+var
+  x: integer;
+  zh, zm: integer;
+  s: string;
+begin
+  Result := false;
+  s := Value;
+  if (Pos('+', s) = 1) or (Pos('-',s) = 1) then
+  begin
+    if s = '-0000' then
+      Zone := TimeZoneBias
+    else
+      if Length(s) > 4 then
+      begin
+        zh := StrToIntdef(s[2] + s[3], 0);
+        zm := StrToIntdef(s[4] + s[5], 0);
+        zone := zh * 60 + zm;
+        if s[1] = '-' then
+          zone := zone * (-1);
+      end;
+    Result := True;
+  end
+  else
+  begin
+    x := 32767;
+    if s = 'NZDT' then x := 13;
+    if s = 'IDLE' then x := 12;
+    if s = 'NZST' then x := 12;
+    if s = 'NZT' then x := 12;
+    if s = 'EADT' then x := 11;
+    if s = 'GST' then x := 10;
+    if s = 'JST' then x := 9;
+    if s = 'CCT' then x := 8;
+    if s = 'WADT' then x := 8;
+    if s = 'WAST' then x := 7;
+    if s = 'ZP6' then x := 6;
+    if s = 'ZP5' then x := 5;
+    if s = 'ZP4' then x := 4;
+    if s = 'BT' then x := 3;
+    if s = 'EET' then x := 2;
+    if s = 'MEST' then x := 2;
+    if s = 'MESZ' then x := 2;
+    if s = 'SST' then x := 2;
+    if s = 'FST' then x := 2;
+    if s = 'CEST' then x := 2;
+    if s = 'CET' then x := 1;
+    if s = 'FWT' then x := 1;
+    if s = 'MET' then x := 1;
+    if s = 'MEWT' then x := 1;
+    if s = 'SWT' then x := 1;
+    if s = 'UT' then x := 0;
+    if s = 'UTC' then x := 0;
+    if s = 'GMT' then x := 0;
+    if s = 'WET' then x := 0;
+    if s = 'WAT' then x := -1;
+    if s = 'BST' then x := -1;
+    if s = 'AT' then x := -2;
+    if s = 'ADT' then x := -3;
+    if s = 'AST' then x := -4;
+    if s = 'EDT' then x := -4;
+    if s = 'EST' then x := -5;
+    if s = 'CDT' then x := -5;
+    if s = 'CST' then x := -6;
+    if s = 'MDT' then x := -6;
+    if s = 'MST' then x := -7;
+    if s = 'PDT' then x := -7;
+    if s = 'PST' then x := -8;
+    if s = 'YDT' then x := -8;
+    if s = 'YST' then x := -9;
+    if s = 'HDT' then x := -9;
+    if s = 'AHST' then x := -10;
+    if s = 'CAT' then x := -10;
+    if s = 'HST' then x := -10;
+    if s = 'EAST' then x := -10;
+    if s = 'NT' then x := -11;
+    if s = 'IDLW' then x := -12;
+    if x <> 32767 then
+    begin
+      zone := x * 60;
+      Result := True;
+    end;
+  end;
+end;
+
+{==============================================================================}
+
+function DecodeRfcDateTime(Value: string): TDateTime;
+var
+  day, month, year: Word;
+  zone: integer;
+  x: integer;
+  s: string;
+  SaveSeparator: char;
+  n: integer;
+  t: TDateTime;
+begin
+// ddd, d mmm yyyy hh:mm:ss
+// ddd, d mmm yy hh:mm:ss
+// ddd, mmm d yyyy hh:mm:ss
+// ddd mmm dd hh:mm:ss yyyy
+//       Sun, 06 Nov 1994 08:49:37 GMT    ; RFC 822, updated by RFC 1123
+//       Sunday, 06-Nov-94 08:49:37 GMT   ; RFC 850, obsoleted by RFC 1036
+//       Sun Nov  6 08:49:37 1994         ; ANSI C's asctime() Format
+
+  Result := 0;
+  SaveSeparator := TimeSeparator;
+  try
+    TimeSeparator := ':';
+    day := 0;
+    month := 0;
+    year := 0;
+    zone := 0;
+    Value := StringReplace(Value, ' -', ' #');
+    Value := StringReplace(Value, '-', ' ');
+    Value := StringReplace(Value, ' #', ' -');
+    while Value <> '' do
+    begin
+      s := Fetch(Value, ' ');
+      s := uppercase(s);
+      // timezone
+      if DecodetimeZone(s, x) then
+      begin
+        zone := x;
+        continue;
+      end;
+      x := StrToIntDef(s, 0);
+      // day or year
+      if x > 0 then
+        if (x < 32) and (day = 0) then
+        begin
+          day := x;
+          continue;
+        end
+        else
+        begin
+          year := x;
+          if year < 32 then
+            year := year + 2000;
+          if year < 1000 then
+           year := year + 1900;
+          continue;
+        end;
+      // time
+      if rpos(':', s) > Pos(':', s) then
+      begin
+        t := 0;
+        try
+          t := StrToTime(s);
+        except
+          on Exception do ;
+        end;
+        if t <> 0 then
+          Result := t;
+        continue;
+      end;
+      //timezone daylight saving time
+      if s = 'DST' then
+      begin
+        zone := zone + 60;
+        continue;
+      end;
+      // month
+      for n := 1 to 12 do
+        if s = uppercase(MyMonthNames[n]) then
+        begin
+          month := n;
+          break;
+        end;
+    end;
+    Result := Result + Encodedate(year, month, day);
+    zone := zone - TimeZoneBias;
+    t := EncodeTime(Abs(zone) div 60, Abs(zone) mod 60, 0, 0);
+    if zone < 0 then
+      t := 0 - t;
+    Result := Result - t;
+  finally
+    TimeSeparator := SaveSeparator;
+  end;
+end;
+
+{==============================================================================}
+
+function GetUTTime: TDateTime;
+{$IFNDEF LINUX}
+var
+  st: TSystemTime;
+begin
+ GetSystemTime(st);
+ result:=SystemTimeToDateTime(st);
+{$ELSE}
+var
+  TV: TTimeVal;
+begin
+  gettimeofday(TV, nil);
+  Result:=UnixDateDelta + (TV.tv_sec + TV.tv_usec / 1000000) / 86400;
+{$ENDIF}
+end;
+
+{==============================================================================}
+
+function SetUTTime(Newdt: TDateTime): Boolean;
+{$IFNDEF LINUX}
+var
+  st: TSystemTime;
+begin
+ DateTimeToSystemTime(newdt,st);
+ Result:=SetSystemTime(st);
+{$ELSE}
+var
+  TV: TTimeVal;
+  d: double;
+  TZ: Ttimezone;
+begin
+  Result := false;
+  gettimeofday(TV, TZ);
+  d := (newdt - UnixDateDelta) * 86400;
+  TV.tv_sec := trunc(d);
+  TV.tv_usec := trunc(frac(d) * 1000000);
+  Result := settimeofday(TV, TZ) <> -1;
+{$ENDIF}
+end;
+
+{==============================================================================}
+
+{$IFDEF LINUX}
+function GetTick: Cardinal;
+var
+  Stamp: TTimeStamp;
+begin
+  Stamp := DateTimeToTimeStamp(Now);
+  Result := Stamp.Time;
+end;
+{$ELSE}
+function GetTick: Cardinal;
+begin
+  Result := Windows.GetTickCount;
+end;
+{$ENDIF}
+
+{==============================================================================}
+
 function CodeInt(Value: Word): string;
 begin
   Result := Chr(Hi(Value)) + Chr(Lo(Value))
@@ -278,6 +543,35 @@ end;
 
 {==============================================================================}
 
+procedure DumpEx(const Buffer, DumpFile: string);
+var
+  n: Integer;
+  x: Byte;
+  s: string;
+  f: Text;
+begin
+  s := '';
+  for n := 1 to Length(Buffer) do
+  begin
+    x := Ord(Buffer[n]);
+    if x in [65..90, 97..122] then
+      s := s + ' +''' + char(x) + ''''
+    else
+      s := s + ' +#$' + IntToHex(Ord(Buffer[n]), 2);
+  end;
+  AssignFile(f, DumpFile);
+  if FileExists(DumpFile) then
+    DeleteFile(PChar(DumpFile));
+  Rewrite(f);
+  try
+    Writeln(f, s);
+  finally
+    CloseFile(f);
+  end;
+end;
+
+{==============================================================================}
+
 function SeparateLeft(const Value, Delimiter: string): string;
 var
   x: Integer;
@@ -359,13 +653,13 @@ begin
     s := SeparateLeft(s, '"')
   else
   begin
-    s := SeparateRight(Value, '(');
-    if s <> Value then
-      s := SeparateLeft(s, ')')
-    else
+    s := SeparateLeft(Value, '<');
+    if s = Value then
     begin
-      s := SeparateLeft(Value, '<');
-      if s = Value then
+      s := SeparateRight(Value, '(');
+      if s <> Value then
+        s := SeparateLeft(s, ')')
+      else
         s := '';
     end;
   end;
@@ -449,7 +743,7 @@ begin
   else
     sURL := URL;
   x := Pos('@', sURL);
-  if x > 0 then
+  if (x > 0) and (x < Pos('/', sURL)) then
   begin
     s := SeparateLeft(sURL, '@');
     sURL := SeparateRight(sURL, '@');
@@ -547,9 +841,16 @@ end;
 {==============================================================================}
 
 function Fetch(var Value: string; const Delimiter: string): string;
+var
+  s: string;
 begin
   Result := SeparateLeft(Value, Delimiter);
-  Value := SeparateRight(Value, Delimiter);
+  s := SeparateRight(Value, Delimiter);
+  if s = Value then
+    Value := ''
+  else
+    Value := Trim(s);
+  Result := Trim(Result);
 end;
 
 end.