Release 35

git-svn-id: https://svn.code.sf.net/p/synalist/code/trunk@76 7c85be65-684b-0410-a082-b2ed4fbef004

blcksock.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 008.003.005 |
+| Project : Ararat Synapse                                       | 008.003.007 |
 |==============================================================================|
 | Content: Library base                                                        |
 |==============================================================================|
@@ -107,7 +107,7 @@ uses
 
 const
 
-  SynapseRelease = '34';
+  SynapseRelease = '35';
 
   cLocalhost = '127.0.0.1';
   cAnyHost = '0.0.0.0';
@@ -2504,9 +2504,13 @@ end;
 
 procedure TBlockSocket.Purge;
 begin
-  repeat
+  try
-    RecvPacket(0);
+    repeat
-  until FLastError <> 0;
+      RecvPacket(0);
+    until FLastError <> 0;
+  except
+    on exception do;
+  end;
   FLastError := 0;
 end;
 
@@ -3920,7 +3924,11 @@ end;
 procedure TTCPBlockSocket.CloseSocket;
 begin
   if SSLEnabled then
-    SSLDoShutdown;
+  begin
+    if assigned(FSsl) then
+      sslshutdown(FSsl);
+    FSSLEnabled := false;
+  end;
   if FSocket <> INVALID_SOCKET then
   begin
     Synsock.Shutdown(FSocket, 1);

ftpsend.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 003.001.000 |
+| Project : Ararat Synapse                                       | 003.001.002 |
 |==============================================================================|
 | Content: FTP client                                                          |
 |==============================================================================|
@@ -1396,6 +1396,8 @@ begin
       Exit;
     end;
     MaskC := Mask[Imask];
+    if Ivalue > Length(Value) then
+      Exit;
     c := Value[Ivalue];
     case MaskC of
       'n':
@@ -1731,6 +1733,7 @@ begin
   begin
     if pos(':', YearTime) > 0 then
     begin
+      YearTime := TrimSP(YearTime);
       mhours := StrToIntDef(Separateleft(YearTime, ':'), 0);
       mminutes := StrToIntDef(SeparateRight(YearTime, ':'), 0);
       if (Encodedate(myear, mmonth, mday)

httpsend.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 003.009.003 |
+| Project : Ararat Synapse                                       | 003.009.005 |
 |==============================================================================|
 | Content: HTTP client                                                         |
 |==============================================================================|
@@ -379,8 +379,13 @@ begin
   if FUserAgent <> '' then
     FHeaders.Insert(0, 'User-Agent: ' + FUserAgent);
   { setting Ranges }
-  if FRangeEnd > 0 then
+  if FRangeStart > 0 then
-    FHeaders.Insert(0, 'Range: bytes=' + IntToStr(FRangeStart) + '-' + IntToStr(FRangeEnd));
+  begin
+    if FRangeEnd >= FRangeStart then
+      FHeaders.Insert(0, 'Range: bytes=' + IntToStr(FRangeStart) + '-' + IntToStr(FRangeEnd))
+    else
+      FHeaders.Insert(0, 'Range: bytes=' + IntToStr(FRangeStart) + '-');
+  end;
   { setting Cookies }
   s := '';
   for n := 0 to FCookies.Count - 1 do
@@ -476,7 +481,12 @@ begin
         Exit;
       FSock.Connect(FTargetHost, FTargetPort);
       if FSock.LastError <> 0 then
+      begin
+        FSock.CloseSocket;
+        FAliveHost := '';
+        FAlivePort := '';
         Exit;
+      end;
     end;
   end;
 

ldapsend.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 001.002.001 |
+| Project : Ararat Synapse                                       | 001.003.000 |
 |==============================================================================|
 | Content: LDAP client                                                         |
 |==============================================================================|
@@ -123,6 +123,8 @@ type
     function Count: integer;
     {:Add new TLDAPAttribute object to list.}
     function Add: TLDAPAttribute;
+    {:Delete one TLDAPAttribute object from list.}
+    procedure Del(Index: integer);
     {:List of TLDAPAttribute objects.}
     property Items[Index: Integer]: TLDAPAttribute read GetAttribute; default;
   end;
@@ -410,6 +412,16 @@ begin
   FAttributeList.Add(Result);
 end;
 
+procedure TLDAPAttributeList.Del(Index: integer);
+var
+  x: TLDAPAttribute;
+begin
+  x := GetAttribute(Index);
+  if Assigned(x) then
+    x.free;
+  FAttributeList.Delete(Index);
+end;
+
 {==============================================================================}
 constructor TLDAPResult.Create;
 begin

mimepart.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 002.006.002 |
+| Project : Ararat Synapse                                       | 002.006.003 |
 |==============================================================================|
 | Content: MIME support procedures and functions                               |
 |==============================================================================|
@@ -668,9 +668,7 @@ begin
         begin
           x := Pos(' ', Copy(s, 2, Length(s) - 1));
           if x < 1 then
-            x := Length(s)
+            x := Length(s);
-          else
-            inc(x);
         end
         else
           if d1 > 0 then

nntpsend.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 001.004.000 |
+| Project : Ararat Synapse                                       | 001.004.001 |
 |==============================================================================|
 | Content: NNTP client                                                         |
 |==============================================================================|
@@ -410,7 +410,7 @@ begin
   s := 'STAT';
   if Value <> '' then
     s := s + ' ' + Value;
-  Result := DoCommandRead(s);
+  Result := DoCommand(s);
 end;
 
 function TNNTPSend.SelectGroup(const Value: string): Boolean;

sslinux.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 002.000.002 |
+| Project : Ararat Synapse                                       | 002.000.003 |
 |==============================================================================|
 | Content: Socket Independent Platform Layer - Linux definition include        |
 |==============================================================================|
@@ -73,7 +73,7 @@ function DestroySocketInterface: Boolean;
 
 const
   WinsockLevel = $0202;
-  
+
 type
   u_char = Char;
   u_short = Word;
@@ -698,7 +698,7 @@ end;
 
 {=============================================================================}
 var
-{$IFNDEF FPC}
+{$IFNDEF VER1_0}  //FTP version 1.0.x
   errno_loc: function: PInteger cdecl = nil;
 {$ELSE}
   errno_loc: function: PInteger = nil; cdecl;

synachar.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 005.000.001 |
+| Project : Ararat Synapse                                       | 005.001.000 |
 |==============================================================================|
 | Content: Charset conversion support                                          |
 |==============================================================================|
@@ -184,6 +184,12 @@ function IdealCharsetCoding(const Value: AnsiString; CharFrom: TMimeChar;
 {:Return BOM (Byte Order Mark) for given unicode charset.}
 function GetBOM(Value: TMimeChar): AnsiString;
 
+{:Convert binary string with unicode content to WideString.}
+function StringToWide(const Value: AnsiString): WideString;
+
+{:Convert WideString to binary string with unicode content.}
+function WideToString(const Value: WideString): AnsiString;
+
 {==============================================================================}
 implementation
 
@@ -1728,6 +1734,36 @@ begin
   end;
 end;
 
+{==============================================================================}
+function StringToWide(const Value: AnsiString): WideString;
+var
+  n: integer;
+  x, y: integer;
+begin
+  SetLength(Result, Length(Value) div 2);
+  for n := 1 to Length(Value) div 2 do
+  begin
+    x := Ord(Value[((n-1) * 2) + 1]);
+    y := Ord(Value[((n-1) * 2) + 2]);
+    Result[n] := WideChar(x * 256 + y);
+  end;
+end;
+
+{==============================================================================}
+function WideToString(const Value: WideString): AnsiString;
+var
+  n: integer;
+  x: integer;
+begin
+  SetLength(Result, Length(Value) * 2);
+  for n := 1 to Length(Value) do
+  begin
+    x := Ord(Value[n]);
+    Result[((n-1) * 2) + 1] := AnsiChar(x div 256);
+    Result[((n-1) * 2) + 2] := AnsiChar(x mod 256);
+  end;
+end;
+
 {==============================================================================}
 initialization
 begin

synacode.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 002.001.002 |
+| Project : Ararat Synapse                                       | 002.001.003 |
 |==============================================================================|
 | Content: Coding and decoding support                                         |
 |==============================================================================|
@@ -1048,27 +1048,26 @@ begin
     BufAnsiChar[P] := $80;
     Inc(P);
     Cnt := 64 - 1 - Cnt;
-    if Cnt >= 0 then
+    if Cnt < 8 then
-      if Cnt < 8 then
+    begin
-      begin
+      for n := 0 to cnt - 1 do
-        for n := 0 to cnt - 1 do
+        BufAnsiChar[P + n] := 0;
-          BufAnsiChar[P + n] := 0;
+      ArrByteToLong(BufAnsiChar, BufLong);
-        ArrByteToLong(BufAnsiChar, BufLong);
+//      FillChar(BufAnsiChar[P], Cnt, #0);
-//        FillChar(BufAnsiChar[P], Cnt, #0);
+      MD5Transform(State, BufLong);
-        MD5Transform(State, BufLong);
+      ArrLongToByte(BufLong, BufAnsiChar);
-        ArrLongToByte(BufLong, BufAnsiChar);
+      for n := 0 to 55 do
-        for n := 0 to 55 do
+        BufAnsiChar[n] := 0;
-          BufAnsiChar[n] := 0;
+      ArrByteToLong(BufAnsiChar, BufLong);
-        ArrByteToLong(BufAnsiChar, BufLong);
+//      FillChar(BufAnsiChar, 56, #0);
-//        FillChar(BufAnsiChar, 56, #0);
+    end
-      end
+    else
-      else
+    begin
-      begin
+      for n := 0 to Cnt - 8 - 1 do
-        for n := 0 to Cnt - 8 - 1 do
+        BufAnsiChar[p + n] := 0;
-          BufAnsiChar[p + n] := 0;
+      ArrByteToLong(BufAnsiChar, BufLong);
-        ArrByteToLong(BufAnsiChar, BufLong);
+//      FillChar(BufAnsiChar[P], Cnt - 8, #0);
-//        FillChar(BufAnsiChar[P], Cnt - 8, #0);
+    end;
-      end;
     BufLong[14] := Count[0];
     BufLong[15] := Count[1];
     MD5Transform(State, BufLong);

synaicnv.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 001.000.000 |
+| Project : Ararat Synapse                                       | 001.000.001 |
 |==============================================================================|
 | Content: ICONV support for Win32, Linux and .NET                             |
 |==============================================================================|
@@ -169,7 +169,7 @@ end;
 
 function SynaIconvOpenTranslit (const tocode, fromcode: string): iconv_t;
 begin
-  Result := SynaIconvOpen(tocode + '//TRANSLIT', fromcode);
+  Result := SynaIconvOpen(tocode + '//IGNORE//TRANSLIT', fromcode);
 end;
 
 function SynaIconvOpenIgnore (const tocode, fromcode: string): iconv_t;

synautil.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Ararat Synapse                                       | 004.006.004 |
+| Project : Ararat Synapse                                       | 004.006.009 |
 |==============================================================================|
 | Content: support procedures and functions                                    |
 |==============================================================================|
@@ -387,7 +387,7 @@ var
 begin
   DecodeDate(t, wYear, wMonth, wDay);
   Result := Format('%s, %d %s %s %s', [MyDayNames[DayOfWeek(t)], wDay,
-    MyMonthNames[1, wMonth], FormatDateTime('yyyy hh:nn:ss', t), TimeZone]);
+    MyMonthNames[1, wMonth], FormatDateTime('yyyy hh":"nn":"ss', t), TimeZone]);
 end;
 
 {==============================================================================}
@@ -398,7 +398,7 @@ var
 begin
   DecodeDate(t, wYear, wMonth, wDay);
   Result:= Format('%s %2d %s', [MyMonthNames[1, wMonth], wDay,
-    FormatDateTime('hh:nn:ss', t)]);
+    FormatDateTime('hh":"nn":"ss', t)]);
 end;
 
 {==============================================================================}
@@ -416,7 +416,7 @@ var
 begin
   DecodeDate(t, wYear, wMonth, wDay);
   Result := Format('%s %s %d %s', [MyDayNames[DayOfWeek(t)], MyMonthNames[1, wMonth],
-    wDay, FormatDateTime('hh:nn:ss yyyy ', t)]);
+    wDay, FormatDateTime('hh":"nn":"ss yyyy ', t)]);
 end;
 
 {==============================================================================}
@@ -628,12 +628,15 @@ begin
       end
       else
       begin
-        year := x;
+        if (year = 0) and ((month > 0) or (x > 12)) then
-        if year < 32 then
+        begin
-          year := year + 2000;
+          year := x;
-        if year < 1000 then
+          if year < 32 then
-         year := year + 1900;
+            year := year + 2000;
-        continue;
+          if year < 1000 then
+           year := year + 1900;
+          continue;
+        end;
       end;
     // time
     if rpos(':', s) > Pos(':', s) then
@@ -651,7 +654,7 @@ begin
     end;
     // month
     y := GetMonthNumber(s);
-    if y > 0 then
+    if (y > 0) and (month = 0) then
       month := y;
   end;
   if year = 0 then
@@ -700,10 +703,12 @@ begin
 var
   TV: TTimeVal;
   TZ: Ttimezone;
+  PZ: PTimeZone;
 begin
   TZ.tz_minuteswest := 0;
   TZ.tz_dsttime := 0;
-  gettimeofday(TV, TZ);
+  PZ := @TZ;
+  gettimeofday(TV, PZ);
   Result := UnixDateDelta + (TV.tv_sec + TV.tv_usec / 1000000) / 86400;
 {$ENDIF}
 end;
@@ -738,11 +743,13 @@ var
   TV: TTimeVal;
   d: double;
   TZ: Ttimezone;
+  PZ: PTimeZone;
 begin
   Result := false;
   TZ.tz_minuteswest := 0;
   TZ.tz_dsttime := 0;
-  gettimeofday(TV, TZ);
+  PZ := @TZ;
+  gettimeofday(TV, PZ);
   d := (newdt - UnixDateDelta) * 86400;
   TV.tv_sec := trunc(d);
   TV.tv_usec := trunc(frac(d) * 1000000);
@@ -821,7 +828,7 @@ function CodeLongInt(Value: Longint): Ansistring;
 var
   x, y: word;
 begin
-  // this is fix for negative numbers on systems where longint = integer 
+  // this is fix for negative numbers on systems where longint = integer
   x := (Value shr 16) and integer($ffff);
   y := Value and integer($ffff);
   setlength(result, 4);
@@ -1436,7 +1443,6 @@ begin
       Delete(Value, 1, 1);
     end;
   end;
-  Result := Result;
 end;
 
 {==============================================================================}
@@ -1589,6 +1595,16 @@ var
   LText: PChar;
   {$ENDIF}
 begin
+  if Value = '' then
+  begin
+    Result := '';
+    Exit;
+  end;
+  if Value = Quote + Quote then
+  begin
+    Result := '';
+    Exit;
+  end;
   //workaround for bug in AnsiExtractQuotedStr
   //...if string begin by Quote, but not ending by Quote, then it eat last char.
   if length(Value) > 1 then

winver.pp

@@ -0,0 +1,76 @@
+{
+    $Id: header,v 1.1.2.1 2003/01/05 20:47:31 michael Exp $
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2003 by the Free Pascal development team
+
+    Windows Version detection functionality.
+    
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$mode objfpc}
+unit winver;
+
+Interface
+
+Uses Windows;
+
+const  
+  Win32Platform     : Integer = 0;
+  Win32MajorVersion : Integer = 0;
+  Win32MinorVersion : Integer = 0;
+  Win32BuildNumber  : Integer = 0;
+                          
+  Win32CSDVersion   : string = '';
+ 
+function CheckWin32Version(Major,Minor : Integer ): Boolean;
+function CheckWin32Version(Major : Integer): Boolean;
+
+Implementation
+
+
+uses sysutils;
+
+procedure InitVersion;
+
+var
+  Info: TOSVersionInfo;
+  
+begin
+  Info.dwOSVersionInfoSize := SizeOf(Info);
+  if GetVersionEx(Info) then
+    with Info do
+      begin
+      Win32Platform:=dwPlatformId;
+      Win32MajorVersion:=dwMajorVersion;
+      Win32MinorVersion:=dwMinorVersion;
+      if (Win32Platform=VER_PLATFORM_WIN32_WINDOWS) then
+        Win32BuildNumber:=dwBuildNumber and $FFFF
+      else
+        Win32BuildNumber := dwBuildNumber;
+      Win32CSDVersion := StrPas(szCSDVersion);
+      end;
+end;
+
+function CheckWin32Version(Major : Integer): Boolean;
+
+begin
+  Result:=CheckWin32Version(Major,0)
+end;
+
+function CheckWin32Version(Major,Minor: Integer): Boolean;
+
+begin
+  Result := (Win32MajorVersion>Major) or
+            ((Win32MajorVersion=Major) and (Win32MinorVersion>=Minor));
+end;
+
+initialization
+  InitVersion;
+end.