Release 26

git-svn-id: https://svn.code.sf.net/p/synalist/code/trunk@55 7c85be65-684b-0410-a082-b2ed4fbef004
2008-04-24 07:12:01 +00:00 · 2008-04-24 07:12:01 +00:00 · 47b69e0a35
commit 47b69e0a35
parent ecf3d4aa68
15 changed files with 1748 additions and 227 deletions
--- a/IMAPsend.pas
+++ 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.
--- a/NNTPsend.pas
+++ 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.
--- 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     |
--- 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);
+        x := RecvBuffer(Pointer(st), l);
        if x = 0 then
          FLastError := WSAECONNRESET
        else
          SockCheck(x);
        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;
+  s: String;
  Data: Byte;
 begin
  Data := 0;
  Result := 0;
  if CanRead(Timeout) then
  begin
-    y := synsock.Recv(FSocket, Data, 1, 0);
+    SetLength(s, 1);
-    if y = 0 then
+    RecvBuffer(Pointer(s), 1);
-      FLastError := WSAECONNRESET
+    if s <> '' then
-    else
+      Result := Ord(s[1]);
      SockCheck(y);
    Result := Data;
    DoStatus(HR_ReadCount, '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
+      if x > MaxSize then
-        x := 1;
+        x := MaxSize;
-      if x > MaxBuf then
+      if x <= 1 then
        x := MaxBuf;
      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);
+        r := RecvBuffer(Pointer(FBuffer), x);
        SockCheck(r);
        if r = 0 then
          FLastError := WSAECONNRESET;
        if FLastError <> 0 then
          Break;
        DoStatus(HR_ReadCount, IntToStr(r));
        if r < x then
          SetLength(FBuffer, r);
      end;
    end;
-    x := Pos(#10, FBuffer);
+    s := s + FBuffer;
-    if x < 1 then x := Length(FBuffer);
+    FBuffer := '';
-    s := s + Copy(FBuffer, 1, x - 1);
+    x := Pos(Terminator, s);
    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);
    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;
+  s: string;
  Data: Byte;
 begin
  Data := 0;
  Result := 0;
  if CanRead(Timeout) then
  begin
-    y := synsock.Recv(FSocket, Data, 1, MSG_PEEK);
+    SetLength(s, 1);
-    if y = 0 then
+    PeekBuffer(Pointer(s), 1);
-      FLastError := WSAECONNRESET;
+    if s <> '' then
-    SockCheck(y);
+      Result := Ord(s[1]);
    Result := Data;
  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);
--- 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);
--- 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 EncodeHeaders(const Value: TStringList);
-    procedure DecodeHeaders(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 AddPartText(const Value: TStringList);
-    procedure AddPartHTML(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
--- 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 s = ('--' + b + '--') then
-          if x > 4 then
+            Result := Value.Count - 1;
            if (s[x] = '-') and (S[x-1] = '-') 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);
+            Setlength(s, 54);
-            s := '';
+            x := FDecodedLines.Read(pointer(s)^, 54);
-            x := FDecodedLines.Read(pointer(Buff)^, 54);
+            Setlength(s, x);
            for n := 1 to x do
              s := s + Buff[n];
            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);
+            if FEncodingCode = ME_QUOTED_PRINTABLE then
-            FLines.Add(s);
+            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, '');
--- 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;
--- 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;
--- 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;
--- 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 OID: string read FOID write FOID;
-    property Value: string read FValue Write FValue;
+    property Value: string read FValue write FValue;
-    property ValueType: Integer read FValueType Write FValueType;
+    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 Version: Integer read FVersion write FVersion;
-    property Community: string read FCommunity Write FCommunity;
+    property Community: string read FCommunity write FCommunity;
-    property PDUType: Integer read FPDUType Write FPDUType;
+    property PDUType: Integer read FPDUType write FPDUType;
-    property ID: Integer read FID Write FID;
+    property ID: Integer read FID write FID;
-    property ErrorStatus: Integer read FErrorStatus Write FErrorStatus;
+    property ErrorStatus: Integer read FErrorStatus write FErrorStatus;
-    property ErrorIndex: Integer read FErrorIndex Write FErrorIndex;
+    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 Timeout: Integer read FTimeout write FTimeout;
-    property Host: string read FHost Write FHost;
+    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;
+function SNMPGet(const OID, Community, SNMPHost: string; var Value: string): Boolean;
-  var Value: string): Boolean;
+function SNMPSet(const OID, Community, SNMPHost, Value: string; ValueType: Integer): 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;
+function SNMPGet(const OID, Community, SNMPHost: string; var Value: string): Boolean;
  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;
 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.
--- 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;
+    x := Length(FBuffer);
    SetLength(FBuffer, x);
    FSock.RecvBufferFrom(Pointer(FBuffer), x);
    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;
+    x := Length(FBuffer);
    SetLength(FBuffer, x);
    FSock.RecvBuffer(Pointer(FBuffer), x);
    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.
--- 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;
--- 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];
+    c := Value[n];
-    if s[1] in Specials then
+    if c in Specials then
-      s := Delimiter + IntToHex(Ord(s[1]), 2);
+    begin
-    Result := Result + s;
+      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;
--- 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;
+  Result := ut.__tm_gmtoff div 60;
  if bias >= 0 then
    Result := '+'
  else
    Result := '-';
 {$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, '(');
+    s := SeparateLeft(Value, '<');
-    if s <> Value then
+    if s = Value then
      s := SeparateLeft(s, ')')
    else
    begin
-      s := SeparateLeft(Value, '<');
+      s := SeparateRight(Value, '(');
-      if s = Value then
+      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.