paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-11 21:29:42 +02:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
git-svn-id: branches/fixes_3_2@44298 -
This commit is contained in:
marco 2020-03-14 15:22:22 +00:00
parent e7d6528f14
commit 913dd3190f
12 changed files with 116 additions and 87 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
packages/chm/src/htmlutil.pas
View File

@ -37,13 +37,13 @@ uses
SysUtils, strutils; SysUtils, strutils;
{ most commonly used } { most commonly used }
function GetVal(tag, attribname_ci: string): string; function GetVal(const tag, attribname_ci: string): string;
function GetTagName(Tag: string): string; function GetTagName(const Tag: string): string;
{ less commonly used, but useful } { less commonly used, but useful }
function GetUpTagName(tag: string): string; function GetUpTagName(const tag: string): string;
function GetNameValPair(tag, attribname_ci: string): string; function GetNameValPair(const tag, attribname_ci: string): string;
function GetValFromNameVal(namevalpair: 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;

10
packages/fcl-db/src/base/bufdataset.pas
View File

@ -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
packages/paszlib/src/gzio.pas
View File

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

11
packages/paszlib/src/infblock.pas
View File

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

5
packages/paszlib/src/infcodes.pas
View File

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

3
packages/paszlib/src/zip.pas
View File

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

19
packages/paszlib/src/zstream.pp
View File

@ -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); source.writebuffer(Fbuffer^,bufsize-Fstream.avail_out);
inc(compressed_written,Result); 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 ClearOutBuffer;
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;
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;

8
packages/rtl-objpas/src/inc/variants.pp
View File

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

4
packages/winunits-jedi/src/jwanb30.pas
View File

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

8
packages/winunits-jedi/src/jwawinioctl.pas
View File

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

80
packages/winunits-jedi/src/jwaws2spi.pas
View File

@ -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
rtl/objpas/types.pp
View File

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