--- Merging r25495 into '.':

A    packages/fcl-base/src/nullstream.pp
--- Merging r25496 into '.':
U    packages/fcl-base/src/inifiles.pp
--- Merging r25526 into '.':
U    packages/chm/src/chmtypes.pas
--- Merging r25546 into '.':
U    rtl/win/wininc/struct.inc
U    rtl/win/wininc/redef.inc
U    rtl/win/wininc/func.inc
--- Merging r25565 into '.':
U    rtl/win/wininc/base.inc
--- Merging r25570 into '.':
U    packages/fcl-net/src/ssockets.pp

# revisions: 25495,25496,25526,25546,25565,25570
r25495 | michael | 2013-09-16 10:24:46 +0200 (Mon, 16 Sep 2013) | 1 line
Changed paths:
   A /trunk/packages/fcl-base/src/nullstream.pp

* Null stream implementation
r25496 | michael | 2013-09-16 10:25:11 +0200 (Mon, 16 Sep 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-base/src/inifiles.pp

* Added Read/Write of int64
r25526 | marco | 2013-09-21 14:29:20 +0200 (Sat, 21 Sep 2013) | 2 lines
Changed paths:
   M /trunk/packages/chm/src/chmtypes.pas

 * Patch from bug #25062 fixing parsing of coordinates within [] in windows section of hhp
r25546 | marco | 2013-09-24 14:56:43 +0200 (Tue, 24 Sep 2013) | 1 line
Changed paths:
   M /trunk/rtl/win/wininc/func.inc
   M /trunk/rtl/win/wininc/redef.inc
   M /trunk/rtl/win/wininc/struct.inc

 * fix for mantis #25078
r25565 | paul | 2013-09-25 10:50:38 +0200 (Wed, 25 Sep 2013) | 1 line
Changed paths:
   M /trunk/rtl/win/wininc/base.inc

win32: update TOKEN_INFORMATION_CLASS from windows sdk
r25570 | michael | 2013-09-25 21:04:37 +0200 (Wed, 25 Sep 2013) | 1 line
Changed paths:
   M /trunk/packages/fcl-net/src/ssockets.pp

* Implement event handler for handling errors during accept. Implemented Abort as suggested in Bug ID #24810

git-svn-id: branches/fixes_2_6@25757 -

.gitattributes

@@ -1773,6 +1773,7 @@ packages/fcl-base/src/libtar.pp svneol=native#text/plain
 packages/fcl-base/src/maskutils.pp svneol=native#text/plain
 packages/fcl-base/src/netware/custapp.inc svneol=native#text/plain
 packages/fcl-base/src/netwlibc/custapp.inc svneol=native#text/plain
+packages/fcl-base/src/nullstream.pp svneol=native#text/plain
 packages/fcl-base/src/os2/custapp.inc svneol=native#text/plain
 packages/fcl-base/src/os2/eventlog.inc svneol=native#text/plain
 packages/fcl-base/src/pooledmm.pp svneol=native#text/plain

packages/chm/src/chmtypes.pas

@@ -486,6 +486,7 @@ var ind,len,
     j,k     : integer;
     arr     : array[0..3] of integer;
     s2      : string;
+    bArr    : Boolean;
 begin
   j:=pos('=',txt);
   if j>0 then
@@ -504,17 +505,35 @@ begin
   nav_style         :=getnextint(txt,ind,len,flags,valid_navigation_pane_style);
   navpanewidth      :=getnextint(txt,ind,len,flags,valid_navigation_pane_width);
   buttons           :=getnextint(txt,ind,len,flags,valid_buttons);
+  
+  (* initialize arr[] *)
+  arr[0] :=0;
+  arr[1] :=0;
+  arr[2] :=0;
+  arr[3] :=0;
   k:=0;
-  repeat
-   s2:=getnext(txt,ind,len);
-   if (length(s2)>0) and (s2[1]='[') then delete(s2,1,1);
-   j:=pos(']',s2);
-   if j>0 then delete(s2,j,1);
-   if length(trim(s2))>0 then
-     include(flags,valid_tab_position);
-   arr[k]:=strtointdef(s2,0);
-   inc(k);
-  until (j<>0) or (ind>len);
+  bArr   := False;
+  (* "[" int,int,int,int "]", |,  *)
+  s2:=getnext(txt,ind,len);
+  if length(s2)>0 then begin
+    (* check if first chart is "[" *)
+    if (s2[1]='[') then begin
+      delete(s2,1,1);
+      bArr := True;
+    end;
+    (* looking for a max 4 int followed by a closing "]" *)
+    repeat
+      if k > 0 then s2:=getnext(txt,ind,len);
+      
+      j:=pos(']',s2);
+      if j>0 then delete(s2,j,1);
+      if length(trim(s2))>0 then
+        include(flags,valid_tab_position);
+      arr[k]:=strtointdef(s2,0);
+      inc(k);
+    until (bArr <> True) or (j<>0) or (ind>len);
+  end;
+   
   left  :=arr[0];
   top   :=arr[1];
   right :=arr[2];

packages/fcl-base/src/inifiles.pp

@@ -116,6 +116,8 @@ type
     property Items[Index: integer]: TIniFileSection read GetItem; default;
   end;
 
+  { TCustomIniFile }
+
   TCustomIniFile = class
   Private
     FFileName: string;
@@ -131,6 +133,8 @@ type
     procedure WriteString(const Section, Ident, Value: String); virtual; abstract;
     function ReadInteger(const Section, Ident: string; Default: Longint): Longint; virtual;
     procedure WriteInteger(const Section, Ident: string; Value: Longint); virtual;
+    function ReadInt64(const Section, Ident: string; Default: Int64): Longint; virtual;
+    procedure WriteInt64(const Section, Ident: string; Value: Int64); virtual;
     function ReadBool(const Section, Ident: string; Default: Boolean): Boolean; virtual;
     procedure WriteBool(const Section, Ident: string; Value: Boolean); virtual;
     function ReadDate(const Section, Ident: string; Default: TDateTime): TDateTime; virtual;
@@ -465,6 +469,17 @@ begin
   WriteString(Section, Ident, IntToStr(Value));
 end;
 
+function TCustomIniFile.ReadInt64(const Section, Ident: string; Default: Int64
+  ): Longint;
+begin
+  Result := StrToInt64Def(ReadString(Section, Ident, ''), Default);
+end;
+
+procedure TCustomIniFile.WriteInt64(const Section, Ident: string; Value: Int64);
+begin
+  WriteString(Section, Ident, IntToStr(Value));
+end;
+
 function TCustomIniFile.ReadBool(const Section, Ident: string; Default: Boolean): Boolean;
 var
   s: string;

packages/fcl-base/src/nullstream.pp

@@ -0,0 +1,122 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 1999-2000 by Michael Van Canneyt and Florian Klaempfl
+
+    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}
+{ Fake stream that always returns empty data. Can be written to and will discard
+all data.
+Emulates a memorystream as far as needed: by writing past the end you can
+increase its size; reading past the end gives an error}
+
+unit nullstream;
+
+interface
+
+uses Classes;
+
+type
+  ENullStreamError = class(EStreamError);
+
+  { TNullStream }
+
+  TNullStream = class(THandleStream)
+  private
+    FPos : Int64;
+    FSize: Int64;
+  protected
+    Function GetSize : int64; override;
+    procedure SetSize(Const AValue: Int64); override;
+    function  GetPosition: Int64; override;
+    procedure InvalidSeek; override;
+  public
+    function Read(var Buffer; Count : LongInt) : Longint; override;
+    function Write(const Buffer; Count : LongInt) : LongInt; override;
+    function Seek(const Offset: int64; Origin: TSeekOrigin): int64; override;
+    constructor Create;
+  end;
+
+implementation
+
+const
+  SInvalidOperation = 'Cannot perform this operation on a NullStream.';
+
+Function TNullStream.GetSize : int64;
+
+begin
+  Result:=FSize;
+end;
+
+procedure TNullStream.SetSize(const AValue: Int64);
+begin
+  FSize:=AValue;
+  if FPos>FSize then
+    FPos:=FSize;
+end;
+
+function TNullStream.GetPosition: Int64;
+begin
+  Result:=FPos;
+end;
+
+procedure TNullStream.InvalidSeek;
+begin
+  raise ENullStreamError.Create(SInvalidOperation);
+end;
+
+function TNullStream.Read(var Buffer; Count : LongInt) : Longint;
+var
+  RealCount: longint;
+begin
+  if (FPos+Count)>FSize then
+    RealCount:=FSize-FPos
+  else
+    RealCount:=Count;
+  FillChar(Buffer,RealCount,0);
+  Result:=RealCount;
+  Inc(FPos,RealCount);
+end;
+
+function TNullStream.Write(const Buffer; Count : LongInt) : LongInt;
+begin
+  Inc(FPos,Count);
+  // Emulate a memorystream: increase size if needed
+  If FPos>Fsize then
+    FSize:=FPos;
+end;
+
+
+function TNullStream.Seek(const Offset: int64; Origin: TSeekOrigin): int64;
+var
+  DesiredPos: int64;
+begin
+  if (Origin=soCurrent) and (Offset=0) then
+    Result:=FPos
+  else
+    begin
+    case Origin of
+      soCurrent: DesiredPos:=FPos+Offset;
+      soBeginning: DesiredPos:=Offset;
+      soEnd: DesiredPos:=FSize-Offset;
+    end;
+    if (DesiredPos<0) or (DesiredPos>FSize) then
+      InvalidSeek;
+    FPos:=DesiredPos;
+    end;
+end;
+
+constructor TNullStream.Create;
+begin
+  inherited create(0);
+  FPos:=0;
+  FSize:=0;
+end;
+
+end.

packages/fcl-net/src/ssockets.pp

@@ -40,6 +40,7 @@ type
     constructor Create(ACode: TSocketErrorType; const MsgArgs: array of const);
   end;
 
+  TAcceptErrorAction = (aeaRaise,aeaIgnore,aeaStop);
   { TSocketStream }
 
   TSocketStream = class(THandleStream)
@@ -70,11 +71,13 @@ type
 
   TConnectEvent = Procedure (Sender : TObject; Data : TSocketStream) Of Object;
   TConnectQuery = Procedure (Sender : TObject; ASocket : Longint; Var Allow : Boolean) of Object;
+  TOnAcceptError = Procedure (Sender : TObject; ASocket : Longint; E : Exception; Var ErrorAction : TAcceptErrorAction) of Object;
 
   { TSocketServer }
 
   TSocketServer = Class(TObject)
   Private
+    FOnAcceptError: TOnAcceptError;
     FOnIdle : TNotifyEvent;
     FNonBlocking : Boolean;
     FSocket : longint;
@@ -100,7 +103,9 @@ type
     Function  Accept: Longint;Virtual;Abstract;
     Function  SockToStream (ASocket : Longint) : TSocketStream;Virtual;Abstract;
     Procedure Close; Virtual;
+    Procedure Abort;
     function GetConnection: TSocketStream;
+    Function HandleAcceptError(E : ESocketError) : TAcceptErrorAction;
   Public
     Constructor Create(ASocket : Longint);
     Destructor Destroy; Override;
@@ -108,13 +113,14 @@ type
     function  GetSockopt(ALevel,AOptName : cint; var optval; Var optlen : tsocklen): Boolean;
     function  SetSockopt(ALevel,AOptName : cint; var optval; optlen : tsocklen): Boolean;
     Procedure StartAccepting;
-    Procedure StopAccepting;
+    Procedure StopAccepting(DoAbort : Boolean = False);
     Procedure SetNonBlocking;
     Property Bound : Boolean Read FBound;
     Property MaxConnections : longint Read FMaxConnections Write FMaxConnections;
     Property QueueSize : Longint Read FQueueSize Write FQueueSize default 5;
     Property OnConnect : TConnectEvent Read FOnConnect Write FOnConnect;
     Property OnConnectQuery : TConnectQuery Read FOnConnectQuery Write FOnConnectQuery;
+    Property OnAcceptError : TOnAcceptError Read FOnAcceptError Write FOnAcceptError;
     Property OnIdle : TNotifyEvent Read FOnIdle Write FOnIdle;
     Property NonBlocking : Boolean Read FNonBlocking;
     Property Socket : Longint Read FSocket;
@@ -340,6 +346,22 @@ begin
   FSocket:=-1;
 end;
 
+procedure TSocketServer.Abort;
+var
+  ASocket: longint;
+begin
+{$if defined(unix)}
+  fpShutdown(FSocket,SHUT_RDWR);
+{$elseif defined(mswindows)}
+  CloseSocket(FSocket);
+{$else}
+  {$WARNING Method Abort is not tested on this platform!}
+  ASocket:=FSocket;
+  fpShutdown(ASocket,SHUT_RDWR);
+  CloseSocket(ASocket);
+{$endif}
+end;
+
 Procedure TSocketServer.Listen;
 
 begin
@@ -365,6 +387,7 @@ Function TSocketServer.GetConnection : TSocketStream;
 
 var
   NewSocket : longint;
+  r,w,e : pfdset;
 
 begin
   Result:=Nil;
@@ -378,6 +401,16 @@ begin
     end
 end;
 
+function TSocketServer.HandleAcceptError(E: ESocketError): TAcceptErrorAction;
+begin
+  if FAccepting then
+    Result:=aeaRaise
+  else
+    Result:=aeaStop;
+  if Assigned(FOnAcceptError) then
+    FOnAcceptError(Self,FSocket,E,Result);
+end;
+
 Procedure TSocketServer.StartAccepting;
 
 Var
@@ -403,17 +436,23 @@ begin
           If E.Code=seAcceptWouldBlock then
             DoOnIdle
           else
-            Raise;
+            Case HandleAcceptError(E) of
+              aeaIgnore : ;
+              aeaStop : FAccepting:=False;
+              aeaRaise : Raise;
+            end;
           end;
        end;
     Until (Stream<>Nil) or (Not NonBlocking);
   Until Not (FAccepting) or ((FMaxConnections<>-1) and (NoConnections>=FMaxConnections));
 end;
 
-Procedure TSocketServer.StopAccepting;
+procedure TSocketServer.StopAccepting(DoAbort: Boolean = False);
 
 begin
   FAccepting:=False;
+  If DoAbort then
+    Abort;
 end;
 
 Procedure TSocketServer.DoOnIdle;
@@ -586,7 +625,10 @@ begin
       Raise ESocketError.Create(seAcceptWouldBlock,[socket])
     else
 {$endif}
-      Raise ESocketError.Create(seAcceptFailed,[Socket,SocketError]);
+     if Not FAccepting then
+        Result:=-1
+     else
+        Raise ESocketError.Create(seAcceptFailed,[Socket,SocketError])
 end;
 
 { ---------------------------------------------------------------------

rtl/win/wininc/base.inc

@@ -333,10 +333,37 @@
 
      _SID_NAME_USE = SID_NAME_USE;
 
-     TOKEN_INFORMATION_CLASS = (TokenUser := 1,TokenGroups,TokenPrivileges,
-       TokenOwner,TokenPrimaryGroup,TokenDefaultDacl,
-       TokenSource,TokenType,TokenImpersonationLevel,
-       TokenStatistics);
+     TOKEN_INFORMATION_CLASS = (
+       TokenUser = 1,
+       TokenGroups,
+       TokenPrivileges,
+       TokenOwner,
+       TokenPrimaryGroup,
+       TokenDefaultDacl,
+       TokenSource,
+       TokenType,
+       TokenImpersonationLevel,
+       TokenStatistics,
+       TokenRestrictedSids,
+       TokenSessionId,
+       TokenGroupsAndPrivileges,
+       TokenSessionReference,
+       TokenSandBoxInert,
+       TokenAuditPolicy,
+       TokenOrigin,
+       TokenElevationType,
+       TokenLinkedToken,
+       TokenElevation,
+       TokenHasRestrictions,
+       TokenAccessInformation,
+       TokenVirtualizationAllowed,
+       TokenVirtualizationEnabled,
+       TokenIntegrityLevel,
+       TokenUIAccess,
+       TokenMandatoryPolicy,
+       TokenLogonSid,
+       MaxTokenInfoClass  // MaxTokenInfoClass should always be the last enum
+     );
 
      _TOKEN_INFORMATION_CLASS = TOKEN_INFORMATION_CLASS;
      TTokenInformationClass   = TOKEN_INFORMATION_CLASS;

rtl/win/wininc/func.inc

@@ -665,6 +665,8 @@ function DrawAnimatedRects(hwnd:HWND; idAni:longint; const lprcFrom:RECT; const
 function TrackPopupMenuEx(_para1:HMENU; _para2:UINT; _para3:longint; _para4:longint; _para5:HWND;_para6:LPTPMPARAMS):WINBOOL; external 'user32' name 'TrackPopupMenuEx';
 function ChildWindowFromPointEx(_para1:HWND; _para2:POINT; _para3:UINT):HWND; external 'user32' name 'ChildWindowFromPointEx';
 function DrawIconEx(hdc:HDC; xLeft:longint; yTop:longint; hIcon:HICON; cxWidth:longint;cyWidth:longint; istepIfAniCur:UINT; hbrFlickerFreeDraw:HBRUSH; diFlags:UINT):WINBOOL; external 'user32' name 'DrawIconEx';
+function GetWindowInfo(hWnd:HWND; pwi:PWindowInfo):WINBOOL; external 'user32' name 'GetWindowInfo';
+
 function AnimatePalette(_para1:HPALETTE; _para2:UINT; _para3:UINT; var _para4:PALETTEENTRY):WINBOOL; external 'gdi32' name 'AnimatePalette';
 function Arc(_para1:HDC; _para2:longint; _para3:longint; _para4:longint; _para5:longint;_para6:longint; _para7:longint; _para8:longint; _para9:longint):WINBOOL; external 'gdi32' name 'Arc';
 function BitBlt(_para1:HDC; _para2:longint; _para3:longint; _para4:longint; _para5:longint;_para6:HDC; _para7:longint; _para8:longint; _para9:DWORD):WINBOOL; external 'gdi32' name 'BitBlt';

rtl/win/wininc/redef.inc

@@ -208,7 +208,7 @@ function InitializeCriticalSectionAndSpinCount(var CriticalSection : TRTLCritica
 function SetCriticalSectionSpinCount(var CriticalSection : TRTLCriticalSection;dwSpinCount : DWORD ): DWORD; external 'kernel32' name 'SetCriticalSectionSpinCount';
 function TryEnterCriticalSection(var CriticalSection : TRTLCriticalSection) : BOOL; external 'kernel32' name 'TryEnterCriticalSection';
 
-
+function GetWindowInfo(hWnd:HWND; var pwi:TWindowInfo):WINBOOL; external 'user32' name 'GetWindowInfo';
 function ControlService(hService:SC_HANDLE; dwControl:DWORD; var ServiceStatus:TSERVICESTATUS):WINBOOL; external 'advapi32' name 'ControlService';
 function QueryServiceStatus(hService:SC_HANDLE; var lpServiceStatus:TSERVICESTATUS):WINBOOL; external 'advapi32' name 'QueryServiceStatus';
 function SetServiceStatus(hServiceStatus:SERVICE_STATUS_HANDLE; const ServiceStatus:TSERVICESTATUS):WINBOOL; external 'advapi32' name 'SetServiceStatus';

rtl/win/wininc/struct.inc

@@ -4003,6 +4003,22 @@ Const
      TWINDOWPOS = WINDOWPOS;
      PWINDOWPOS = ^WINDOWPOS;
 
+     PWindowInfo = ^TWindowInfo;
+     LPWindowInfo = ^TWindowInfo;
+     tagWINDOWINFO = record
+          cbSize: DWORD;
+          rcWindow: TRect;
+          rcClient: TRect;
+          dwStyle: DWORD;
+          dwExStyle: DWORD;
+          dwWindowStatus: DWORD;
+          cxWindowBorders: UINT;
+          cyWindowBorders: UINT;
+          atomWindowType: TAtom;
+          wCreatorVersion: WORD;
+       end;
+     TWindowInfo = tagWINDOWINFO;
+
      HD_LAYOUT = record
           prc : ^RECT;
           pwpos : ^WINDOWPOS;