From 042bebc82355ef277f0cb30089583465babd1143 Mon Sep 17 00:00:00 2001 From: geby Date: Thu, 24 Apr 2008 07:37:11 +0000 Subject: [PATCH] Release 35 git-svn-id: https://svn.code.sf.net/p/synalist/code/trunk@76 7c85be65-684b-0410-a082-b2ed4fbef004 --- blcksock.pas | 20 +++++++++----- ftpsend.pas | 5 +++- httpsend.pas | 16 ++++++++--- ldapsend.pas | 14 +++++++++- mimepart.pas | 6 ++--- nntpsend.pas | 4 +-- sslinux.pas | 6 ++--- synachar.pas | 38 +++++++++++++++++++++++++- synacode.pas | 43 +++++++++++++++-------------- synaicnv.pas | 4 +-- synautil.pas | 46 ++++++++++++++++++++----------- winver.pp | 76 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 12 files changed, 218 insertions(+), 60 deletions(-) create mode 100644 winver.pp diff --git a/blcksock.pas b/blcksock.pas index 2960672..60e8273 100644 --- a/blcksock.pas +++ b/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 - RecvPacket(0); - until FLastError <> 0; + try + repeat + 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); diff --git a/ftpsend.pas b/ftpsend.pas index 6cf1837..ddfb56c 100644 --- a/ftpsend.pas +++ b/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) diff --git a/httpsend.pas b/httpsend.pas index 00ba70f..7b17a86 100644 --- a/httpsend.pas +++ b/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 - FHeaders.Insert(0, 'Range: bytes=' + IntToStr(FRangeStart) + '-' + IntToStr(FRangeEnd)); + if FRangeStart > 0 then + 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; diff --git a/ldapsend.pas b/ldapsend.pas index add3fe0..8251717 100644 --- a/ldapsend.pas +++ b/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 diff --git a/mimepart.pas b/mimepart.pas index 7949e8e..d0e088f 100644 --- a/mimepart.pas +++ b/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) - else - inc(x); + x := Length(s); end else if d1 > 0 then diff --git a/nntpsend.pas b/nntpsend.pas index 89fa100..f3f6f34 100644 --- a/nntpsend.pas +++ b/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; diff --git a/sslinux.pas b/sslinux.pas index 60a71a0..d911cb5 100644 --- a/sslinux.pas +++ b/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; diff --git a/synachar.pas b/synachar.pas index 2951890..06a64df 100644 --- a/synachar.pas +++ b/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 diff --git a/synacode.pas b/synacode.pas index 64f9f98..da6b719 100644 --- a/synacode.pas +++ b/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 - begin - for n := 0 to cnt - 1 do - BufAnsiChar[P + n] := 0; - ArrByteToLong(BufAnsiChar, BufLong); -// FillChar(BufAnsiChar[P], Cnt, #0); - MD5Transform(State, BufLong); - ArrLongToByte(BufLong, BufAnsiChar); - for n := 0 to 55 do - BufAnsiChar[n] := 0; - ArrByteToLong(BufAnsiChar, BufLong); -// FillChar(BufAnsiChar, 56, #0); - end - else - begin - for n := 0 to Cnt - 8 - 1 do - BufAnsiChar[p + n] := 0; - ArrByteToLong(BufAnsiChar, BufLong); -// FillChar(BufAnsiChar[P], Cnt - 8, #0); - end; + if Cnt < 8 then + begin + for n := 0 to cnt - 1 do + BufAnsiChar[P + n] := 0; + ArrByteToLong(BufAnsiChar, BufLong); +// FillChar(BufAnsiChar[P], Cnt, #0); + MD5Transform(State, BufLong); + ArrLongToByte(BufLong, BufAnsiChar); + for n := 0 to 55 do + BufAnsiChar[n] := 0; + ArrByteToLong(BufAnsiChar, BufLong); +// FillChar(BufAnsiChar, 56, #0); + end + else + begin + for n := 0 to Cnt - 8 - 1 do + BufAnsiChar[p + n] := 0; + ArrByteToLong(BufAnsiChar, BufLong); +// FillChar(BufAnsiChar[P], Cnt - 8, #0); + end; BufLong[14] := Count[0]; BufLong[15] := Count[1]; MD5Transform(State, BufLong); diff --git a/synaicnv.pas b/synaicnv.pas index 78b6b2a..070bc00 100644 --- a/synaicnv.pas +++ b/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; diff --git a/synautil.pas b/synautil.pas index 8501c94..09c608f 100644 --- a/synautil.pas +++ b/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 < 32 then - year := year + 2000; - if year < 1000 then - year := year + 1900; - continue; + if (year = 0) and ((month > 0) or (x > 12)) then + begin + year := x; + if year < 32 then + year := year + 2000; + 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 diff --git a/winver.pp b/winver.pp new file mode 100644 index 0000000..ae1e140 --- /dev/null +++ b/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. \ No newline at end of file