Browse Source

# revisions: 43950,44275,44276,44277,44278,44280,44282,44290

git-svn-id: branches/fixes_3_2@44298 -
marco 5 years ago
parent
commit
913dd3190f

+ 24 - 17
packages/chm/src/htmlutil.pas

@@ -37,13 +37,13 @@ uses
   SysUtils, strutils;
   SysUtils, strutils;
 
 
 { most commonly used }
 { most commonly used }
-function GetVal(tag, attribname_ci: string): string;
-function GetTagName(Tag: string): string;
+function GetVal(const tag, attribname_ci: string): string;
+function GetTagName(const Tag: string): string;
 
 
 { less commonly used, but useful }
 { less commonly used, but useful }
-function GetUpTagName(tag: string): string;
-function GetNameValPair(tag, attribname_ci: string): string;
-function GetValFromNameVal(namevalpair: string): string;
+function GetUpTagName(const tag: string): string;
+function GetNameValPair(const tag, attribname_ci: string): string;
+function GetValFromNameVal(const namevalpair: string): string;
 
 
 { old buggy code}
 { old buggy code}
 function GetVal_JAMES(tag, attribname_ci: string): string;
 function GetVal_JAMES(tag, attribname_ci: string): string;
@@ -64,15 +64,17 @@ begin
 end;
 end;
 
 
 { Return tag name, case preserved }
 { Return tag name, case preserved }
-function GetTagName(Tag: string): string;
+function GetTagName(const Tag: string): string;
 var
 var
   P : Pchar;
   P : Pchar;
   S : Pchar;
   S : Pchar;
 begin
 begin
   P := Pchar(Tag);
   P := Pchar(Tag);
-  while P^ in ['<',' ',#9] do inc(P);
+  while P^ in ['<',' ',#9] do 
+    inc(P);
   S := P;
   S := P;
-  while Not (P^ in [' ','>',#0]) do inc(P);
+  while Not (P^ in [' ','>',#0]) do 
+    inc(P);
   if P > S then
   if P > S then
     Result := CopyBuffer( S, P-S)
     Result := CopyBuffer( S, P-S)
   else
   else
@@ -80,15 +82,17 @@ begin
 end;
 end;
 
 
 { Return tag name in uppercase }
 { Return tag name in uppercase }
-function GetUpTagName(tag: string): string;
+function GetUpTagName(const tag: string): string;
 var
 var
   P : Pchar;
   P : Pchar;
   S : Pchar;
   S : Pchar;
 begin
 begin
   P := Pchar(uppercase(Tag));
   P := Pchar(uppercase(Tag));
-  while P^ in ['<',' ',#9] do inc(P);
+  while P^ in ['<',' ',#9] do 
+    inc(P);
   S := P;
   S := P;
-  while Not (P^ in [' ','>',#0]) do inc(P);
+  while Not (P^ in [' ','>',#0]) do 
+    inc(P);
   if P > S then
   if P > S then
     Result := CopyBuffer( S, P-S)
     Result := CopyBuffer( S, P-S)
   else
   else
@@ -98,7 +102,7 @@ end;
 
 
 { Return name=value pair ignoring case of NAME, preserving case of VALUE
 { Return name=value pair ignoring case of NAME, preserving case of VALUE
   Lars' fixed version }
   Lars' fixed version }
-function GetNameValPair(tag, attribname_ci: string): string;
+function GetNameValPair(const tag, attribname_ci: string): string;
 var
 var
   P    : Pchar;
   P    : Pchar;
   S    : Pchar;
   S    : Pchar;
@@ -157,7 +161,7 @@ end;
 
 
 
 
 { Get value of attribute, e.g WIDTH=36 -return-> 36, preserves case sensitive }
 { Get value of attribute, e.g WIDTH=36 -return-> 36, preserves case sensitive }
-function GetValFromNameVal(namevalpair: string): string;
+function GetValFromNameVal(const namevalpair: string): string;
 var
 var
   P: Pchar;
   P: Pchar;
   S: Pchar;
   S: Pchar;
@@ -192,7 +196,7 @@ end;
 
 
 
 
 { return value of an attribute (attribname_ci), case ignored for NAME portion, but return value case is preserved } 
 { return value of an attribute (attribname_ci), case ignored for NAME portion, but return value case is preserved } 
-function GetVal(tag, attribname_ci: string): string;
+function GetVal(const tag, attribname_ci: string): string;
 var namevalpair: string;
 var namevalpair: string;
 begin
 begin
   // returns full name=value pair
   // returns full name=value pair
@@ -231,7 +235,8 @@ begin
     while not (P^ in ['=',' ','>',#0]) do
     while not (P^ in ['=',' ','>',#0]) do
       inc(P);
       inc(P);
 
 
-    if (P^ = '=') then inc(P);
+    if (P^ = '=') then 
+       inc(P);
     
     
     while not (P^ in [' ','>',#0]) do
     while not (P^ in [' ','>',#0]) do
     begin
     begin
@@ -286,7 +291,8 @@ begin
     while not (P^ in ['=',' ','>',#0]) do
     while not (P^ in ['=',' ','>',#0]) do
       inc(P);
       inc(P);
 
 
-    if (P^ = '=') then inc(P);
+    if (P^ = '=') then 
+      inc(P);
     
     
     while not (P^ in [' ','>',#0]) do
     while not (P^ in [' ','>',#0]) do
     begin
     begin
@@ -302,7 +308,8 @@ begin
       while not (P^ in [C, '>', #0]) do
       while not (P^ in [C, '>', #0]) do
         inc(P);
         inc(P);
 
 
-      if (P^<>'>') then inc(P); { Skip current character, except '>' }
+      if (P^<>'>') then 
+        inc(P); { Skip current character, except '>' }
       break;
       break;
     end;
     end;
 
 

+ 8 - 2
packages/fcl-db/src/base/bufdataset.pas

@@ -2607,7 +2607,10 @@ begin
     if assigned(Buffer) then
     if assigned(Buffer) then
       begin
       begin
       inc(CurrBuff,FFieldBufPositions[Field.FieldNo-1]);
       inc(CurrBuff,FFieldBufPositions[Field.FieldNo-1]);
-      Move(CurrBuff^, Buffer^, GetFieldSize(FieldDefs[Field.FieldNo-1]));
+      if Field.IsBlob then // we need GetFieldSize for BLOB but Field.DataSize for others - #36747
+        Move(CurrBuff^, Buffer^, GetFieldSize(FieldDefs[Field.FieldNo-1]))
+      else
+        Move(CurrBuff^, Buffer^, Field.DataSize);
       end;
       end;
     Result := True;
     Result := True;
     end
     end
@@ -2649,7 +2652,10 @@ begin
     inc(CurrBuff,FFieldBufPositions[Field.FieldNo-1]);
     inc(CurrBuff,FFieldBufPositions[Field.FieldNo-1]);
     if assigned(buffer) then
     if assigned(buffer) then
       begin
       begin
-      Move(Buffer^, CurrBuff^, GetFieldSize(FieldDefs[Field.FieldNo-1]));
+      if Field.IsBlob then // we need GetFieldSize for BLOB but Field.DataSize for others - #36747
+        Move(Buffer^, CurrBuff^, GetFieldSize(FieldDefs[Field.FieldNo-1]))
+      else
+        Move(Buffer^, CurrBuff^, Field.DataSize);
       unSetFieldIsNull(NullMask,Field.FieldNo-1);
       unSetFieldIsNull(NullMask,Field.FieldNo-1);
       end
       end
     else
     else

+ 1 - 0
packages/paszlib/src/gzio.pas

@@ -529,6 +529,7 @@ begin
   if Assigned (s^.outbuf) then
   if Assigned (s^.outbuf) then
     FreeMem(s^.outbuf, Z_BUFSIZE);
     FreeMem(s^.outbuf, Z_BUFSIZE);
   FreeMem(s, sizeof(gz_stream));
   FreeMem(s, sizeof(gz_stream));
+  s := nil;
 
 
 end;
 end;
 
 

+ 9 - 2
packages/paszlib/src/infblock.pas

@@ -33,7 +33,7 @@ procedure inflate_blocks_reset (var s : inflate_blocks_state;
                                 c : Pcardinal); { check value on output }
                                 c : Pcardinal); { check value on output }
 
 
 
 
-function inflate_blocks_free(s : pInflate_blocks_state;
+function inflate_blocks_free(var s : pInflate_blocks_state;
                              var z : z_stream) : integer;
                              var z : z_stream) : integer;
 
 
 procedure inflate_set_dictionary(var s : inflate_blocks_state;
 procedure inflate_set_dictionary(var s : inflate_blocks_state;
@@ -103,7 +103,10 @@ begin
   if (c <> nil) then
   if (c <> nil) then
     c^ := s.check;
     c^ := s.check;
   if (s.mode = BTREE) or (s.mode = DTREE) then
   if (s.mode = BTREE) or (s.mode = DTREE) then
+  begin
     freemem(s.sub.trees.blens);
     freemem(s.sub.trees.blens);
+    s.sub.trees.blens := nil;
+  end;
   if (s.mode = CODES) then
   if (s.mode = CODES) then
     inflate_codes_free(s.sub.decode.codes, z);
     inflate_codes_free(s.sub.decode.codes, z);
 
 
@@ -587,6 +590,7 @@ begin
         if (t <> Z_OK) then
         if (t <> Z_OK) then
         begin
         begin
           freemem(s.sub.trees.blens);
           freemem(s.sub.trees.blens);
+          s.sub.trees.blens := nil;
           r := t;
           r := t;
           if (r = Z_DATA_ERROR) then
           if (r = Z_DATA_ERROR) then
             s.mode := BLKBAD;
             s.mode := BLKBAD;
@@ -707,6 +711,7 @@ begin
                ((c = 16) and (i < 1)) then
                ((c = 16) and (i < 1)) then
             begin
             begin
               freemem(s.sub.trees.blens);
               freemem(s.sub.trees.blens);
+              s.sub.trees.blens := nil;
               s.mode := BLKBAD;
               s.mode := BLKBAD;
               z.msg := 'invalid bit length repeat';
               z.msg := 'invalid bit length repeat';
               r := Z_DATA_ERROR;
               r := Z_DATA_ERROR;
@@ -741,6 +746,7 @@ begin
                   1 + ((t shr 5) and $1f),
                   1 + ((t shr 5) and $1f),
                   s.sub.trees.blens^, bl, bd, tl, td, s.hufts^, z);
                   s.sub.trees.blens^, bl, bd, tl, td, s.hufts^, z);
           freemem(s.sub.trees.blens);
           freemem(s.sub.trees.blens);
+          s.sub.trees.blens := nil;
           if (t <> Z_OK) then
           if (t <> Z_OK) then
           begin
           begin
             if (t = cardinal(Z_DATA_ERROR)) then
             if (t = cardinal(Z_DATA_ERROR)) then
@@ -913,13 +919,14 @@ begin
 end;
 end;
 
 
 
 
-function inflate_blocks_free(s : pInflate_blocks_state;
+function inflate_blocks_free(var s : pInflate_blocks_state;
                              var z : z_stream) : integer;
                              var z : z_stream) : integer;
 begin
 begin
   inflate_blocks_reset(s^, z, nil);
   inflate_blocks_reset(s^, z, nil);
   freemem(s^.window);
   freemem(s^.window);
   freemem(s^.hufts);
   freemem(s^.hufts);
   dispose(s);
   dispose(s);
+  s := nil;
   {$IFDEF ZLIB_DEBUG}
   {$IFDEF ZLIB_DEBUG}
   Trace('inflate:   blocks freed');
   Trace('inflate:   blocks freed');
   {$ENDIF}  
   {$ENDIF}  

+ 3 - 2
packages/paszlib/src/infcodes.pas

@@ -25,7 +25,7 @@ function inflate_codes(var s : inflate_blocks_state;
                        var z : z_stream;
                        var z : z_stream;
                        r : integer) : integer;
                        r : integer) : integer;
 
 
-procedure inflate_codes_free(c : pInflate_codes_state;
+procedure inflate_codes_free(var c : pInflate_codes_state;
                              var z : z_stream);
                              var z : z_stream);
 
 
 implementation
 implementation
@@ -575,10 +575,11 @@ begin
 end;
 end;
 
 
 
 
-procedure inflate_codes_free(c : pInflate_codes_state;
+procedure inflate_codes_free(var c : pInflate_codes_state;
                              var z : z_stream);
                              var z : z_stream);
 begin
 begin
   dispose(c);
   dispose(c);
+  c := nil;
   {$IFDEF ZLIB_DEBUG}  
   {$IFDEF ZLIB_DEBUG}  
   Tracev('inflate:       codes free');
   Tracev('inflate:       codes free');
   {$ENDIF}
   {$ENDIF}

+ 2 - 1
packages/paszlib/src/zip.pas

@@ -184,7 +184,7 @@ begin
   allocate_new_datablock := ldi;
   allocate_new_datablock := ldi;
 end;
 end;
 
 
-procedure free_datablock(ldi: linkedlist_datablock_internal_ptr);
+procedure free_datablock(var ldi: linkedlist_datablock_internal_ptr);
 var
 var
   ldinext: linkedlist_datablock_internal_ptr;
   ldinext: linkedlist_datablock_internal_ptr;
 begin
 begin
@@ -686,6 +686,7 @@ begin
     err := add_data_in_datablock(@zi^.central_dir, zi^.ci.central_header, longint(zi^.ci.size_centralheader));
     err := add_data_in_datablock(@zi^.central_dir, zi^.ci.central_header, longint(zi^.ci.size_centralheader));
 
 
   FreeMem(zi^.ci.central_header);
   FreeMem(zi^.ci.central_header);
+  zi^.ci.central_header := nil;
 
 
   if (err = ZIP_OK) then
   if (err = ZIP_OK) then
   begin
   begin

+ 6 - 13
packages/paszlib/src/zstream.pp

@@ -56,7 +56,7 @@ type
 
 
         Tcompressionstream=class(Tcustomzlibstream)
         Tcompressionstream=class(Tcustomzlibstream)
         private
         private
-          function ClearOutBuffer: Integer;
+          procedure ClearOutBuffer;
         protected
         protected
           raw_written,compressed_written: int64;
           raw_written,compressed_written: int64;
         public
         public
@@ -206,13 +206,12 @@ begin
   get_compressionrate:=100*compressed_written/raw_written;
   get_compressionrate:=100*compressed_written/raw_written;
 end;
 end;
 
 
-Function TCompressionstream.ClearOutBuffer : Integer;
-
+procedure TCompressionstream.ClearOutBuffer;
 
 
 begin
 begin
   { Flush the buffer to the stream and update progress }
   { Flush the buffer to the stream and update progress }
-  Result:=source.write(Fbuffer^,bufsize);
-  inc(compressed_written,Result);
+  source.writebuffer(Fbuffer^,bufsize-Fstream.avail_out);
+  inc(compressed_written,bufsize-Fstream.avail_out);
   progress(self);
   progress(self);
   { reset output buffer }
   { reset output buffer }
   Fstream.next_out:=Fbuffer;
   Fstream.next_out:=Fbuffer;
@@ -235,13 +234,7 @@ begin
       raise Ecompressionerror.create(zerror(err));
       raise Ecompressionerror.create(zerror(err));
   until false;
   until false;
   if Fstream.avail_out<bufsize then
   if Fstream.avail_out<bufsize then
-    begin
-      source.writebuffer(FBuffer^,bufsize-Fstream.avail_out);
-      inc(compressed_written,bufsize-Fstream.avail_out);
-      progress(self);
-      Fstream.next_out:=Fbuffer;
-      Fstream.avail_out:=bufsize;
-    end;
+    ClearOutBuffer;
 end;
 end;
 
 
 
 
@@ -271,7 +264,7 @@ begin
   else
   else
     err:=inflateInit(Fstream);
     err:=inflateInit(Fstream);
   if err<>Z_OK then
   if err<>Z_OK then
-    raise Ecompressionerror.create(zerror(err));
+    raise Edecompressionerror.create(zerror(err));
 end;
 end;
 
 
 function Tdecompressionstream.read(var buffer;count:longint):longint;
 function Tdecompressionstream.read(var buffer;count:longint):longint;

+ 4 - 4
packages/rtl-objpas/src/inc/variants.pp

@@ -1183,10 +1183,10 @@ begin
   if OpCode in [opCmpEq, opCmpNe] then
   if OpCode in [opCmpEq, opCmpNe] then
     if Length(WideString(Left)) <> Length(WideString(Right)) then
     if Length(WideString(Left)) <> Length(WideString(Right)) then
       Exit(-1);
       Exit(-1);
-  Result := WideCompareStr(
+  Result := sign(WideCompareStr(
     WideString(Left),
     WideString(Left),
     WideString(Right)
     WideString(Right)
-  );
+  ));
 end;
 end;
 
 
 
 
@@ -1204,10 +1204,10 @@ begin
   if OpCode in [opCmpEq, opCmpNe] then
   if OpCode in [opCmpEq, opCmpNe] then
     if Length(AnsiString(Left)) <> Length(AnsiString(Right)) then
     if Length(AnsiString(Left)) <> Length(AnsiString(Right)) then
       Exit(-1);
       Exit(-1);
-  Result := CompareStr(
+  Result := sign(CompareStr(
     AnsiString(Left),
     AnsiString(Left),
     AnsiString(Right)
     AnsiString(Right)
-  );
+  ));
 end;
 end;
 
 
 
 

+ 2 - 2
packages/winunits-jedi/src/jwanb30.pas

@@ -100,11 +100,11 @@ type
     ncb_post: TNcbPost;  // POST routine address
     ncb_post: TNcbPost;  // POST routine address
     ncb_lana_num: UCHAR; // lana (adapter) number
     ncb_lana_num: UCHAR; // lana (adapter) number
     ncb_cmd_cplt: UCHAR; // 0xff => commmand pending
     ncb_cmd_cplt: UCHAR; // 0xff => commmand pending
-    {$IFDEF _WIN64}
+    {$IFDEF WIN64}
     ncb_reserve: array [0..17] of Char; // reserved, used by BIOS
     ncb_reserve: array [0..17] of Char; // reserved, used by BIOS
     {$ELSE}
     {$ELSE}
     ncb_reserve: array [0..9] of Char;  // reserved, used by BIOS
     ncb_reserve: array [0..9] of Char;  // reserved, used by BIOS
-    {$ENDIF _WIN64}
+    {$ENDIF WIN64}
     ncb_event: HANDLE;   // HANDLE to Win32 event which
     ncb_event: HANDLE;   // HANDLE to Win32 event which
                          // will be set to the signalled
                          // will be set to the signalled
                          // state when an ASYNCH command
                          // state when an ASYNCH command

+ 4 - 4
packages/winunits-jedi/src/jwawinioctl.pas

@@ -3974,7 +3974,7 @@ type
   TMoveFileData = MOVE_FILE_DATA;
   TMoveFileData = MOVE_FILE_DATA;
   PMoveFileData = PMOVE_FILE_DATA;
   PMoveFileData = PMOVE_FILE_DATA;
 
 
-{$IFDEF _WIN64}
+{$IFDEF WIN64}
 
 
 //
 //
 //  32/64 Bit thunking support structure
 //  32/64 Bit thunking support structure
@@ -3994,7 +3994,7 @@ type
   TMoveFileData32 = MOVE_FILE_DATA32;
   TMoveFileData32 = MOVE_FILE_DATA32;
   PMoveFileData32 = PMOVE_FILE_DATA32;
   PMoveFileData32 = PMOVE_FILE_DATA32;
   
   
-{$ENDIF _WIN64}
+{$ENDIF WIN64}
 
 
 //
 //
 // Structures for FSCTL_FIND_FILES_BY_SID
 // Structures for FSCTL_FIND_FILES_BY_SID
@@ -4221,7 +4221,7 @@ type
   TMarkHandleInfo = MARK_HANDLE_INFO;
   TMarkHandleInfo = MARK_HANDLE_INFO;
   PMarkHandleInfo = PMARK_HANDLE_INFO;
   PMarkHandleInfo = PMARK_HANDLE_INFO;
 
 
-{$IFDEF _WIN64}
+{$IFDEF WIN64}
 
 
 //
 //
 //  32/64 Bit thunking support structure
 //  32/64 Bit thunking support structure
@@ -4238,7 +4238,7 @@ type
   TMarkHandleInfo32 = MARK_HANDLE_INFO32;
   TMarkHandleInfo32 = MARK_HANDLE_INFO32;
   PMarkHandleInfo32 = PMARK_HANDLE_INFO32;
   PMarkHandleInfo32 = PMARK_HANDLE_INFO32;
 
 
-{$ENDIF _WIN64}
+{$ENDIF WIN64}
 
 
 //
 //
 //  Flags for the additional source information above.
 //  Flags for the additional source information above.

+ 40 - 40
packages/winunits-jedi/src/jwaws2spi.pas

@@ -66,11 +66,11 @@ uses
  * Ensure structures are packed consistently.
  * Ensure structures are packed consistently.
  *)
  *)
 
 
-{$IFDEF _WIN64}
+{$IFDEF WIN64}
 {$ALIGN OFF}
 {$ALIGN OFF}
 {$ELSE}
 {$ELSE}
 {$ALIGN ON}
 {$ALIGN ON}
-{$ENDIF _WIN64}
+{$ENDIF WIN64}
 
 
 const
 const
   WSPDESCRIPTION_LEN = 255;
   WSPDESCRIPTION_LEN = 255;
@@ -457,7 +457,7 @@ type
   {$EXTERNALSYM LPWSCENUMPROTOCOLS}
   {$EXTERNALSYM LPWSCENUMPROTOCOLS}
   TWscEnumProtocols = LPWSCENUMPROTOCOLS;
   TWscEnumProtocols = LPWSCENUMPROTOCOLS;
 
 
-{$IFDEF _WIN64}
+{$IFDEF WIN64}
 
 
 //
 //
 // 64-bit architectures capable of running 32-bit code have
 // 64-bit architectures capable of running 32-bit code have
@@ -468,7 +468,7 @@ type
 function WSCEnumProtocols32(lpiProtocols: PINT; lpProtocolBuffer: LPWSAPROTOCOL_INFOW; lpdwBufferLength: LPDWORD; lpErrno: PINT): Integer; stdcall;
 function WSCEnumProtocols32(lpiProtocols: PINT; lpProtocolBuffer: LPWSAPROTOCOL_INFOW; lpdwBufferLength: LPDWORD; lpErrno: PINT): Integer; stdcall;
 {$EXTERNALSYM WSCEnumProtocols32}
 {$EXTERNALSYM WSCEnumProtocols32}
 
 
-{$ENDIF _WIN64}
+{$ENDIF WIN64}
 
 
 function WSCDeinstallProvider(const lpProviderId: TGUID; var lpErrno: Integer): Integer; stdcall;
 function WSCDeinstallProvider(const lpProviderId: TGUID; var lpErrno: Integer): Integer; stdcall;
 {$EXTERNALSYM WSCDeinstallProvider}
 {$EXTERNALSYM WSCDeinstallProvider}
@@ -478,12 +478,12 @@ type
   {$EXTERNALSYM LPWSCDEINSTALLPROVIDER}
   {$EXTERNALSYM LPWSCDEINSTALLPROVIDER}
   TWscDeinstallProvider = LPWSCDEINSTALLPROVIDER;
   TWscDeinstallProvider = LPWSCDEINSTALLPROVIDER;
 
 
-{$IFDEF _WIN64}
+{$IFDEF WIN64}
 
 
 function WSCDeinstallProvider32(lpProviderId: PGUID; lpErrno: PINT): Integer; stdcall;
 function WSCDeinstallProvider32(lpProviderId: PGUID; lpErrno: PINT): Integer; stdcall;
 {$EXTERNALSYM WSCDeinstallProvider32}
 {$EXTERNALSYM WSCDeinstallProvider32}
 
 
-{$ENDIF _WIN64}
+{$ENDIF WIN64}
 
 
 function WSCInstallProvider(const lpProviderId: TGUID; lpszProviderDllPath: PWCHAR;
 function WSCInstallProvider(const lpProviderId: TGUID; lpszProviderDllPath: PWCHAR;
   lpProtocolInfoList: LPWSAPROTOCOL_INFOW; dwNumberOfEntries: DWORD; var lpErrno: Integer): Integer; stdcall;
   lpProtocolInfoList: LPWSAPROTOCOL_INFOW; dwNumberOfEntries: DWORD; var lpErrno: Integer): Integer; stdcall;
@@ -495,7 +495,7 @@ type
   {$EXTERNALSYM LPWSCINSTALLPROVIDER}
   {$EXTERNALSYM LPWSCINSTALLPROVIDER}
   TWscInstallProvider = LPWSCINSTALLPROVIDER;
   TWscInstallProvider = LPWSCINSTALLPROVIDER;
 
 
-{$IFDEF _WIN64}
+{$IFDEF WIN64}
 
 
 //
 //
 // This API manipulates 64-bit and 32-bit catalogs simulteneously.
 // This API manipulates 64-bit and 32-bit catalogs simulteneously.
@@ -507,7 +507,7 @@ function WSCInstallProvider64_32(lpProviderId: PGUID; lpszProviderDllPath: PWCHA
   dwNumberOfEntries: DWORD; lpErrno: PINT): Integer; stdcall;
   dwNumberOfEntries: DWORD; lpErrno: PINT): Integer; stdcall;
 {$EXTERNALSYM WSCInstallProvider64_32}
 {$EXTERNALSYM WSCInstallProvider64_32}
 
 
-{$ENDIF _WIN64}
+{$ENDIF WIN64}
 
 
 function WSCGetProviderPath(const lpProviderId: TGUID; lpszProviderDllPath: PWCHAR;
 function WSCGetProviderPath(const lpProviderId: TGUID; lpszProviderDllPath: PWCHAR;
   var lpProviderDllPathLen, lpErrno: Integer): Integer; stdcall;
   var lpProviderDllPathLen, lpErrno: Integer): Integer; stdcall;
@@ -519,12 +519,12 @@ type
   {$EXTERNALSYM LPWSCGETPROVIDERPATH}
   {$EXTERNALSYM LPWSCGETPROVIDERPATH}
   TWscGetProviderPath = LPWSCGETPROVIDERPATH;
   TWscGetProviderPath = LPWSCGETPROVIDERPATH;
 
 
-{$IFDEF _WIN64}
+{$IFDEF WIN64}
 
 
 function WSCGetProviderPath32(lpProviderId: PGUID; lpszProviderDllPath: PWCHAR; lpProviderDllPathLen: PINT; lpErrno: PINT): Integer; stdcall;
 function WSCGetProviderPath32(lpProviderId: PGUID; lpszProviderDllPath: PWCHAR; lpProviderDllPathLen: PINT; lpErrno: PINT): Integer; stdcall;
 {$EXTERNALSYM WSCGetProviderPath32}
 {$EXTERNALSYM WSCGetProviderPath32}
 
 
-{$ENDIF _WIN64}
+{$ENDIF WIN64}
 
 
 function WSCUpdateProvider(lpProviderId: PGUID; lpszProviderDllPath: PWCHAR; lpProtocolInfoList: LPWSAPROTOCOL_INFOW;
 function WSCUpdateProvider(lpProviderId: PGUID; lpszProviderDllPath: PWCHAR; lpProtocolInfoList: LPWSAPROTOCOL_INFOW;
   dwNumberOfEntries: DWORD; lpErrno: PINT): Integer; stdcall;
   dwNumberOfEntries: DWORD; lpErrno: PINT): Integer; stdcall;
@@ -535,13 +535,13 @@ type
     dwNumberOfEntries: DWORD; lpErrno: PINT): Integer; stdcall;
     dwNumberOfEntries: DWORD; lpErrno: PINT): Integer; stdcall;
   {$EXTERNALSYM LPWSCUPDATEPROVIDER}
   {$EXTERNALSYM LPWSCUPDATEPROVIDER}
 
 
-{$IFDEF _WIN64}
+{$IFDEF WIN64}
 
 
 function WSCUpdateProvider32(lpProviderId: PGUID; lpszProviderDllPath: PWCHAR; lpProtocolInfoList: LPWSAPROTOCOL_INFOW;
 function WSCUpdateProvider32(lpProviderId: PGUID; lpszProviderDllPath: PWCHAR; lpProtocolInfoList: LPWSAPROTOCOL_INFOW;
   dwNumberOfEntries: DWORD; lpErrno: PINT): Integer; stdcall;
   dwNumberOfEntries: DWORD; lpErrno: PINT): Integer; stdcall;
 {$EXTERNALSYM WSCUpdateProvider32}
 {$EXTERNALSYM WSCUpdateProvider32}
 
 
-{$ENDIF _WIN64}
+{$ENDIF WIN64}
 
 
 function WSCInstallQOSTemplate(const Guid: TGUID; QosName: LPWSABUF; Qos: LPQOS): Integer; stdcall;
 function WSCInstallQOSTemplate(const Guid: TGUID; QosName: LPWSABUF; Qos: LPQOS): Integer; stdcall;
 {$EXTERNALSYM WSCInstallQOSTemplate}
 {$EXTERNALSYM WSCInstallQOSTemplate}
@@ -632,12 +632,12 @@ function WPUCloseThread(lpThreadId: LPWSATHREADID; lpErrno: PINT): Integer; stdc
 //#define WSCEnumNameSpaceProviders WSAEnumNameSpaceProvidersW
 //#define WSCEnumNameSpaceProviders WSAEnumNameSpaceProvidersW
 //#define LPFN_WSCENUMNAMESPACEPROVIDERS LPFN_WSAENUMNAMESPACEPROVIDERSW
 //#define LPFN_WSCENUMNAMESPACEPROVIDERS LPFN_WSAENUMNAMESPACEPROVIDERSW
 
 
-{$IFDEF _WIN64}
+{$IFDEF WIN64}
 
 
 function WSCEnumNameSpaceProviders32(lpdwBufferLength: LPDWORD; lpnspBuffer: LPWSANAMESPACE_INFOW): Integer; stdcall;
 function WSCEnumNameSpaceProviders32(lpdwBufferLength: LPDWORD; lpnspBuffer: LPWSANAMESPACE_INFOW): Integer; stdcall;
 {$EXTERNALSYM WSCEnumNameSpaceProviders32}
 {$EXTERNALSYM WSCEnumNameSpaceProviders32}
 
 
-{$ENDIF _WIN64}
+{$ENDIF WIN64}
 
 
 function WSCInstallNameSpace(lpszIdentifier, lpszPathName: LPWSTR; dwNameSpace,
 function WSCInstallNameSpace(lpszIdentifier, lpszPathName: LPWSTR; dwNameSpace,
   dwVersion: DWORD; const lpProviderId: TGUID): Integer; stdcall;
   dwVersion: DWORD; const lpProviderId: TGUID): Integer; stdcall;
@@ -649,12 +649,12 @@ type
   {$EXTERNALSYM LPWSCINSTALLNAMESPACE}
   {$EXTERNALSYM LPWSCINSTALLNAMESPACE}
   TWscInstallNamespace = LPWSCINSTALLNAMESPACE;
   TWscInstallNamespace = LPWSCINSTALLNAMESPACE;
 
 
-{$IFDEF _WIN64}
+{$IFDEF WIN64}
 
 
 function WSCInstallNameSpace32(lpszIdentifier, lpszPathName: LPWSTR; dwNameSpace, dwVersion: DWORD; lpProviderId: PGUID): Integer; stdcall;
 function WSCInstallNameSpace32(lpszIdentifier, lpszPathName: LPWSTR; dwNameSpace, dwVersion: DWORD; lpProviderId: PGUID): Integer; stdcall;
 {$EXTERNALSYM WSCInstallNameSpace32}
 {$EXTERNALSYM WSCInstallNameSpace32}
 
 
-{$ENDIF _WIN64}
+{$ENDIF WIN64}
 
 
 function WSCUnInstallNameSpace(const lpProviderId: TGUID): Integer; stdcall;
 function WSCUnInstallNameSpace(const lpProviderId: TGUID): Integer; stdcall;
 {$EXTERNALSYM WSCUnInstallNameSpace}
 {$EXTERNALSYM WSCUnInstallNameSpace}
@@ -664,12 +664,12 @@ type
   {$EXTERNALSYM LPWSCUNINSTALLNAMESPACE}
   {$EXTERNALSYM LPWSCUNINSTALLNAMESPACE}
   TWscUninstallNamespace = LPWSCUNINSTALLNAMESPACE;
   TWscUninstallNamespace = LPWSCUNINSTALLNAMESPACE;
 
 
-{$IFDEF _WIN64}
+{$IFDEF WIN64}
 
 
 function WSCUnInstallNameSpace32(lpProviderId: PGUID): Integer; stdcall;
 function WSCUnInstallNameSpace32(lpProviderId: PGUID): Integer; stdcall;
 {$EXTERNALSYM WSCUnInstallNameSpace32}
 {$EXTERNALSYM WSCUnInstallNameSpace32}
 
 
-{$ENDIF _WIN64}
+{$ENDIF WIN64}
 
 
 function WSCEnableNSProvider(const lpProviderId: TGUID; fEnable: BOOL): Integer; stdcall;
 function WSCEnableNSProvider(const lpProviderId: TGUID; fEnable: BOOL): Integer; stdcall;
 {$EXTERNALSYM WSCEnableNSProvider}
 {$EXTERNALSYM WSCEnableNSProvider}
@@ -679,12 +679,12 @@ type
   {$EXTERNALSYM LPWSCENABLENSPROVIDER}
   {$EXTERNALSYM LPWSCENABLENSPROVIDER}
   TWscEnableNsProvider = LPWSCENABLENSPROVIDER;
   TWscEnableNsProvider = LPWSCENABLENSPROVIDER;
 
 
-{$IFDEF _WIN64}
+{$IFDEF WIN64}
 
 
 function WSCEnableNSProvider32(lpProviderId: PGUID; fEnable: BOOL): Integer; stdcall;
 function WSCEnableNSProvider32(lpProviderId: PGUID; fEnable: BOOL): Integer; stdcall;
 {$EXTERNALSYM WSCEnableNSProvider32}
 {$EXTERNALSYM WSCEnableNSProvider32}
 
 
-{$ENDIF _WIN64}
+{$ENDIF WIN64}
 
 
 (*
 (*
  * Pointers to the individual entries in the namespace proc table.
  * Pointers to the individual entries in the namespace proc table.
@@ -810,7 +810,7 @@ begin
   end;
   end;
 end;
 end;
 
 
-{$IFDEF _WIN64}
+{$IFDEF WIN64}
 
 
 var
 var
   _WSCEnumProtocols32: Pointer;
   _WSCEnumProtocols32: Pointer;
@@ -825,7 +825,7 @@ begin
   end;
   end;
 end;
 end;
 
 
-{$ENDIF _WIN64}
+{$ENDIF WIN64}
 
 
 var
 var
   _WSCDeinstallProvider: Pointer;
   _WSCDeinstallProvider: Pointer;
@@ -840,7 +840,7 @@ begin
   end;
   end;
 end;
 end;
 
 
-{$IFDEF _WIN64}
+{$IFDEF WIN64}
 
 
 var
 var
   _WSCDeinstallProvider32: Pointer;
   _WSCDeinstallProvider32: Pointer;
@@ -855,7 +855,7 @@ begin
   end;
   end;
 end;
 end;
 
 
-{$ENDIF _WIN64}
+{$ENDIF WIN64}
 
 
 var
 var
   _WSCInstallProvider: Pointer;
   _WSCInstallProvider: Pointer;
@@ -870,7 +870,7 @@ begin
   end;
   end;
 end;
 end;
 
 
-{$IFDEF _WIN64}
+{$IFDEF WIN64}
 
 
 var
 var
   _WSCInstallProvider64_32: Pointer;
   _WSCInstallProvider64_32: Pointer;
@@ -885,7 +885,7 @@ begin
   end;
   end;
 end;
 end;
 
 
-{$ENDIF _WIN64}
+{$ENDIF WIN64}
 
 
 var
 var
   _WSCGetProviderPath: Pointer;
   _WSCGetProviderPath: Pointer;
@@ -900,7 +900,7 @@ begin
   end;
   end;
 end;
 end;
 
 
-{$IFDEF _WIN64}
+{$IFDEF WIN64}
 
 
 var
 var
   _WSCGetProviderPath32: Pointer;
   _WSCGetProviderPath32: Pointer;
@@ -915,7 +915,7 @@ begin
   end;
   end;
 end;
 end;
 
 
-{$ENDIF _WIN64}
+{$ENDIF WIN64}
 
 
 var
 var
   _WSCUpdateProvider: Pointer;
   _WSCUpdateProvider: Pointer;
@@ -930,7 +930,7 @@ begin
   end;
   end;
 end;
 end;
 
 
-{$IFDEF _WIN64}
+{$IFDEF WIN64}
 
 
 var
 var
   _WSCUpdateProvider32: Pointer;
   _WSCUpdateProvider32: Pointer;
@@ -945,7 +945,7 @@ begin
   end;
   end;
 end;
 end;
 
 
-{$ENDIF _WIN64}
+{$ENDIF WIN64}
 
 
 var
 var
   _WSCInstallQOSTemplate: Pointer;
   _WSCInstallQOSTemplate: Pointer;
@@ -973,7 +973,7 @@ begin
   end;
   end;
 end;
 end;
 
 
-{$IFDEF _WIN64}
+{$IFDEF WIN64}
 
 
 var
 var
   _WSCEnumNameSpaceProviders32: Pointer;
   _WSCEnumNameSpaceProviders32: Pointer;
@@ -988,7 +988,7 @@ begin
   end;
   end;
 end;
 end;
 
 
-{$ENDIF _WIN64}
+{$ENDIF WIN64}
 
 
 var
 var
   _WSCInstallNameSpace: Pointer;
   _WSCInstallNameSpace: Pointer;
@@ -1003,7 +1003,7 @@ begin
   end;
   end;
 end;
 end;
 
 
-{$IFDEF _WIN64}
+{$IFDEF WIN64}
 
 
 var
 var
   _WSCInstallNameSpace32: Pointer;
   _WSCInstallNameSpace32: Pointer;
@@ -1018,7 +1018,7 @@ begin
   end;
   end;
 end;
 end;
 
 
-{$ENDIF _WIN64}
+{$ENDIF WIN64}
 
 
 var
 var
   _WSCUnInstallNameSpace: Pointer;
   _WSCUnInstallNameSpace: Pointer;
@@ -1033,7 +1033,7 @@ begin
   end;
   end;
 end;
 end;
 
 
-{$IFDEF _WIN64}
+{$IFDEF WIN64}
 
 
 var
 var
   _WSCUnInstallNameSpace32: Pointer;
   _WSCUnInstallNameSpace32: Pointer;
@@ -1048,7 +1048,7 @@ begin
   end;
   end;
 end;
 end;
 
 
-{$ENDIF _WIN64}
+{$ENDIF WIN64}
 
 
 var
 var
   _WSCEnableNSProvider: Pointer;
   _WSCEnableNSProvider: Pointer;
@@ -1063,7 +1063,7 @@ begin
   end;
   end;
 end;
 end;
 
 
-{$IFDEF _WIN64}
+{$IFDEF WIN64}
 
 
 var
 var
   _WSCEnableNSProvider32: Pointer;
   _WSCEnableNSProvider32: Pointer;
@@ -1078,7 +1078,7 @@ begin
   end;
   end;
 end;
 end;
 
 
-{$ENDIF _WIN64}
+{$ENDIF WIN64}
 
 
 {$ELSE}
 {$ELSE}
 
 
@@ -1092,7 +1092,7 @@ function WSCRemoveQOSTemplate; external qosname name 'WSCRemoveQOSTemplate';
 function WSCInstallNameSpace; external ws2_32 name 'WSCInstallNameSpace';
 function WSCInstallNameSpace; external ws2_32 name 'WSCInstallNameSpace';
 function WSCUnInstallNameSpace; external ws2_32 name 'WSCUnInstallNameSpace';
 function WSCUnInstallNameSpace; external ws2_32 name 'WSCUnInstallNameSpace';
 function WSCEnableNSProvider; external ws2_32 name 'WSCEnableNSProvider';
 function WSCEnableNSProvider; external ws2_32 name 'WSCEnableNSProvider';
-{$IFDEF _WIN64}
+{$IFDEF WIN64}
 function WSCEnumProtocols32; external ws2_32 name 'WSCEnumProtocols32';
 function WSCEnumProtocols32; external ws2_32 name 'WSCEnumProtocols32';
 function WSCDeinstallProvider32; external ws2_32 name 'WSCDeinstallProvider32';
 function WSCDeinstallProvider32; external ws2_32 name 'WSCDeinstallProvider32';
 function WSCInstallProvider64_32; external ws2_32 name 'WSCInstallProvider64_32';
 function WSCInstallProvider64_32; external ws2_32 name 'WSCInstallProvider64_32';
@@ -1102,7 +1102,7 @@ function WSCEnumNameSpaceProviders32; external ws2_32 name 'WSCEnumNameSpaceProv
 function WSCInstallNameSpace32; external ws2_32 name 'WSCInstallNameSpace32';
 function WSCInstallNameSpace32; external ws2_32 name 'WSCInstallNameSpace32';
 function WSCUnInstallNameSpace32; external ws2_32 name 'WSCUnInstallNameSpace32';
 function WSCUnInstallNameSpace32; external ws2_32 name 'WSCUnInstallNameSpace32';
 function WSCEnableNSProvider32; external ws2_32 name 'WSCEnableNSProvider32';
 function WSCEnableNSProvider32; external ws2_32 name 'WSCEnableNSProvider32';
-{$ENDIF _WIN64}
+{$ENDIF WIN64}
 
 
 {$ENDIF DYNAMIC_LINK}
 {$ENDIF DYNAMIC_LINK}
 
 

+ 13 - 0
rtl/objpas/types.pp

@@ -130,6 +130,8 @@ type
           function  Floor   : TPoint;
           function  Floor   : TPoint;
           function  Round   : TPoint;
           function  Round   : TPoint;
           function  Length  : Single;
           function  Length  : Single;
+          class function Create(const ax, ay: Single): TPointF; overload; static; inline;
+          class function Create(const apt: TPoint): TPointF; overload; static; inline;
           class operator = (const apt1, apt2 : TPointF) : Boolean;
           class operator = (const apt1, apt2 : TPointF) : Boolean;
           class operator <> (const apt1, apt2 : TPointF): Boolean;
           class operator <> (const apt1, apt2 : TPointF): Boolean;
           class operator + (const apt1, apt2 : TPointF): TPointF;
           class operator + (const apt1, apt2 : TPointF): TPointF;
@@ -662,6 +664,17 @@ begin
   x:=ax; y:=ay;
   x:=ax; y:=ay;
 end;
 end;
 
 
+class function TPointF.Create(const ax, ay: Single): TPointF;
+begin
+  Result.x := ax;
+  Result.y := ay;
+end;
+
+class function TPointF.Create(const apt: TPoint): TPointF;
+begin
+  Result.x := apt.X;
+  Result.y := apt.Y;
+end;
 { TRectF }
 { TRectF }
 
 
 function TRectF.GetHeight: Single;
 function TRectF.GetHeight: Single;