pascal/synapse
1
0
Fork 0
Code Issues Releases Activity

Release 35

Browse Source 
git-svn-id: https://svn.code.sf.net/p/synalist/code/trunk@76 7c85be65-684b-0410-a082-b2ed4fbef004
This commit is contained in:
geby 2008-04-24 07:37:11 +00:00
parent d9f38e7342
commit 042bebc823
12 changed files with 218 additions and 60 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
blcksock.pas
View File

@ -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
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);

5
ftpsend.pas
View File

@ -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)

16
httpsend.pas
View File

@ -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,9 +481,14 @@ begin
Exit;
FSock.Connect(FTargetHost, FTargetPort);
if FSock.LastError <> 0 then
begin
FSock.CloseSocket;
FAliveHost := '';
FAlivePort := '';
Exit;
end;
end;
end;
{ send Headers }
if FProtocol = '0.9' then

14
ldapsend.pas
View File

@ -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

6
mimepart.pas
View File

@ -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

4
nntpsend.pas
View File

@ -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;

4
sslinux.pas
View File

@ -1,5 +1,5 @@
{==============================================================================|
| Project : Ararat Synapse | 002.000.002 |
| Project : Ararat Synapse | 002.000.003 |
|==============================================================================|
| Content: Socket Independent Platform Layer - Linux definition include |
|==============================================================================|
@ -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;

38
synachar.pas
View File

@ -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

3
synacode.pas
View File

@ -1,5 +1,5 @@
{==============================================================================|
| Project : Ararat Synapse | 002.001.002 |
| Project : Ararat Synapse | 002.001.003 |
|==============================================================================|
| Content: Coding and decoding support |
|==============================================================================|
@ -1048,7 +1048,6 @@ 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

4
synaicnv.pas
View File

@ -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;

32
synautil.pas
View File

@ -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;
{==============================================================================}
@ -627,6 +627,8 @@ begin
continue;
end
else
begin
if (year = 0) and ((month > 0) or (x > 12)) then
begin
year := x;
if year < 32 then
@ -635,6 +637,7 @@ begin
year := year + 1900;
continue;
end;
end;
// time
if rpos(':', s) > Pos(':', s) then
begin
@ -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);
@ -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

76
winver.pp Normal file
View File

@ -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.