paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2026-01-04 03:50:30 +01:00
Code Issues Packages Projects Releases Wiki Activity

fix compilation for {$T+} linux/win

Browse Source 
git-svn-id: trunk@4794 -
This commit is contained in:
micha 2006-10-04 20:43:55 +00:00
parent 2978e6661a
commit d704af7216
61 changed files with 330 additions and 322 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
compiler/cclasses.pas
View File

@ -810,7 +810,7 @@ var
psrc : PPointer;
begin
NewCount:=0;
psrc:=@FList[0];
psrc:=@FList^[0];
pdest:=psrc;
For I:=0 To FCount-1 Do
begin
@ -1412,7 +1412,7 @@ var
psrc : PHashItem;
begin
NewCount:=0;
psrc:=@FHashList[0];
psrc:=@FHashList^[0];
pdest:=psrc;
For I:=0 To FCount-1 Do
begin

2
compiler/cp437.pas
View File

@ -270,7 +270,7 @@ unit cp437;
unicodemap : tunicodemap = (
cpname : 'cp437';
map : @map;
map : @map[0];
lastchar : 255;
next : nil;
internalmap : true

2
compiler/cp850.pas
View File

@ -270,7 +270,7 @@ unit cp850;
unicodemap : tunicodemap = (
cpname : 'cp850';
map : @map;
map : @map[0];
lastchar : 255;
next : nil;
internalmap : true

2
compiler/cp8859_1.pas
View File

@ -270,7 +270,7 @@ unit cp8859_1;
unicodemap : tunicodemap = (
cpname : '8859-1';
map : @map;
map : @map[0];
lastchar : 255;
next : nil;
internalmap : true

4
compiler/dbgstabs.pas
View File

@ -146,7 +146,7 @@ implementation
i:=1;
len:=0;
varcounter:=0;
varptr:=@varvaluedata;
varptr:=@varvaluedata[0];
while i<=length(s) do
begin
if (s[i]='$') and (i<length(s)) then
@ -167,7 +167,7 @@ implementation
inc(i);
until s[i]='}';
varvalues[varcounter]:=Pstring(varptr);
if varptr>@varvaluedata+maxdata then
if varptr>@varvaluedata[maxdata] then
internalerrorproc(200411152);
Pstring(varptr)^:=get_var_value(varname,get_var_value_arg);
inc(len,length(Pstring(varptr)^));

2
compiler/globals.pas
View File

@ -1835,7 +1835,7 @@ end;
var
p: pbyte;
begin
p := @r;
p := pbyte(@r);
{$ifdef CPU_ARM}
inc(p,4);
{$else}

8
compiler/nadd.pas
View File

@ -535,8 +535,8 @@ implementation
c2[0]:=char(byte(tordconstnode(right).value));
c2[1]:=#0;
l2:=1;
s1:=@c1;
s2:=@c2;
s1:=@c1[0];
s2:=@c2[0];
concatstrings:=true;
end
else if (lt=stringconstn) and (rt=ordconstn) and is_char(rd) then
@ -545,7 +545,7 @@ implementation
l1:=tstringconstnode(left).len;
c2[0]:=char(byte(tordconstnode(right).value));
c2[1]:=#0;
s2:=@c2;
s2:=@c2[0];
l2:=1;
concatstrings:=true;
end
@ -554,7 +554,7 @@ implementation
c1[0]:=char(byte(tordconstnode(left).value));
c1[1]:=#0;
l1:=1;
s1:=@c1;
s1:=@c1[0];
s2:=tstringconstnode(right).value_str;
l2:=tstringconstnode(right).len;
concatstrings:=true;

10
compiler/ncal.pas
View File

@ -1368,12 +1368,14 @@ type
result:=vmttree;
end;
type
pcallparanode = ^tcallparanode;
procedure tcallnode.bind_parasym;
var
i : integer;
pt : tcallparanode;
oldppt : ^tcallparanode;
oldppt : pcallparanode;
varargspara,
currpara : tparavarsym;
used_by_callnode : boolean;
@ -1382,14 +1384,14 @@ type
temp : ttempcreatenode;
begin
pt:=tcallparanode(left);
oldppt:=@left;
oldppt:=pcallparanode(@left);
{ flag all callparanodes that belong to the varargs }
i:=paralength;
while (i>procdefinition.maxparacount) do
begin
include(pt.callparaflags,cpf_varargs_para);
oldppt:=@pt.right;
oldppt:=pcallparanode(@pt.right);
pt:=tcallparanode(pt.right);
dec(i);
end;
@ -1475,7 +1477,7 @@ type
if not assigned(pt) then
internalerror(200310052);
pt.parasym:=currpara;
oldppt:=@pt.right;
oldppt:=pcallparanode(@pt.right);
pt:=tcallparanode(pt.right);
end;

2
compiler/ogbase.pas
View File

@ -2026,7 +2026,7 @@ implementation
(stabexesec.ObjSectionlist.count=0) then
exit;
{ Create new stabsection }
stabRelocofs:=@hstab.nvalue-@hstab;
stabRelocofs:=pointer(@hstab.nvalue)-@hstab;
mergedstabsec:=internalObjData.CreateSection(sec_stab,'');
mergedstabstrsec:=internalObjData.CreateSection(sec_stabstr,'');

4
compiler/systems/t_emx.pas
View File

@ -114,7 +114,7 @@ type reloc=packed record {This is the layout of a relocation table
end;
var aout_str_size:longint;
aout_str_tab:array[0..2047] of byte;
aout_str_tab:array[0..2047] of char;
aout_sym_count:longint;
aout_sym_tab:array[0..5] of nlist;
@ -257,7 +257,7 @@ begin
blockwrite(out_file,aout_text,aout_text_size);
blockwrite(out_file,aout_treloc_tab,sizeof(reloc)*aout_treloc_count);
blockwrite(out_file,aout_sym_tab,sizeof(aout_sym_tab[0])*aout_sym_count);
longint((@aout_str_tab)^):=aout_str_size;
plongint(@aout_str_tab)^:=aout_str_size;
blockwrite(out_file,aout_str_tab,aout_str_size);
end;

4
compiler/systems/t_os2.pas
View File

@ -113,7 +113,7 @@ type reloc=packed record {This is the layout of a relocation table
end;
var aout_str_size:longint;
aout_str_tab:array[0..2047] of byte;
aout_str_tab:array[0..2047] of char;
aout_sym_count:longint;
aout_sym_tab:array[0..5] of nlist;
@ -256,7 +256,7 @@ begin
blockwrite(out_file,aout_text,aout_text_size);
blockwrite(out_file,aout_treloc_tab,sizeof(reloc)*aout_treloc_count);
blockwrite(out_file,aout_sym_tab,sizeof(aout_sym_tab[0])*aout_sym_count);
longint((@aout_str_tab)^):=aout_str_size;
plongint(@aout_str_tab)^:=aout_str_size;
blockwrite(out_file,aout_str_tab,aout_str_size);
end;

6
compiler/utils/fpcmkcfg.pp
View File

@ -83,7 +83,7 @@ begin
AddToList(List,'BUILDDATE',DateToStr(Date));
AddToList(List,'BUILDTIME',TimeToStr(Time));
Cfg:=TStringList.Create;
Cfg.Text:=StrPas(Addr(DefaultConfig));
Cfg.Text:=StrPas(Addr(DefaultConfig[0][1]));
end;
Procedure Done;
@ -191,9 +191,9 @@ begin
begin
case IDEBuildin of
1:
Cfg.Text:=StrPas(Addr(fpcfg));
Cfg.Text:=StrPas(Addr(fpcfg[0][1]));
2:
Cfg.Text:=StrPas(Addr(fpini));
Cfg.Text:=StrPas(Addr(fpini[0][1]));
end;
AddToList(List,'TEMPLATEFILE','builtin');

12
compiler/x86/aasmcpu.pas
View File

@ -1747,7 +1747,7 @@ implementation
ea_data : ea;
begin
len:=0;
codes:=@p^.code;
codes:=@p^.code[0];
{$ifdef x86_64}
rex:=0;
{$endif x86_64}
@ -2016,7 +2016,7 @@ implementation
$0, $A, $A, $B, $8, $4);
var
c : byte;
pb,
pb : pbyte;
codes : pchar;
bytes : array[0..3] of byte;
rfield,
@ -2298,16 +2298,16 @@ implementation
if not process_ea(oper[opidx]^,ea_data,rfield) then
Message(asmw_e_invalid_effective_address);
pb:=@bytes;
pb^:=chr(ea_data.modrm);
pb:=@bytes[0];
pb^:=ea_data.modrm;
inc(pb);
if ea_data.sib_present then
begin
pb^:=chr(ea_data.sib);
pb^:=ea_data.sib;
inc(pb);
end;
s:=pb-pchar(@bytes);
s:=pb-@bytes[0];
objdata.writebytes(bytes,s);
case ea_data.bytes of

69
fcl/db/sqldb/interbase/ibconnection.pp
View File

@ -53,7 +53,7 @@ type
procedure SetDateTime(CurrBuff: pointer; PTime : TDateTime; AType : integer);
procedure GetFloat(CurrBuff, Buffer : pointer; Field : TFieldDef);
procedure SetFloat(CurrBuff: pointer; Dbl: Double; Size: integer);
procedure CheckError(ProcName : string; Status : array of ISC_STATUS);
procedure CheckError(ProcName : string; Status : PISC_STATUS);
function getMaxBlobSize(blobHandle : TIsc_Blob_Handle) : longInt;
procedure SetParameters(cursor : TSQLCursor;AParams : TParams);
procedure FreeSQLDABuffer(var aSQLDA : PXSQLDA);
@ -113,19 +113,17 @@ type
__tm_zone : Pchar;
end;
procedure TIBConnection.CheckError(ProcName : string; Status : array of ISC_STATUS);
procedure TIBConnection.CheckError(ProcName : string; Status : PISC_STATUS);
var
buf : array [0..1024] of char;
p : pointer;
Msg : string;
E : EIBDatabaseError;
begin
if ((Status[0] = 1) and (Status[1] <> 0)) then
begin
p := @Status;
msg := '';
while isc_interprete(Buf, @p) > 0 do
while isc_interprete(Buf, @Status) > 0 do
Msg := Msg + LineEnding +' -' + StrPas(Buf);
E := EIBDatabaseError.CreateFmt('%s : %s : %s',[self.Name,ProcName,Msg]);
E.GDSErrorCode := Status[1];
@ -152,7 +150,7 @@ function TIBConnection.Commit(trans : TSQLHandle) : boolean;
begin
result := false;
with (trans as TIBTrans) do
if isc_commit_transaction(@Status, @TransactionHandle) <> 0 then
if isc_commit_transaction(@Status[0], @TransactionHandle) <> 0 then
CheckError('Commit', Status)
else result := true;
end;
@ -160,7 +158,7 @@ end;
function TIBConnection.RollBack(trans : TSQLHandle) : boolean;
begin
result := false;
if isc_rollback_transaction(@TIBTrans(trans).Status, @TIBTrans(trans).TransactionHandle) <> 0 then
if isc_rollback_transaction(@TIBTrans(trans).Status[0], @TIBTrans(trans).TransactionHandle) <> 0 then
CheckError('Rollback', TIBTrans(trans).Status)
else result := true;
end;
@ -210,7 +208,7 @@ begin
TransactionHandle := nil;
if isc_start_transaction(@Status, @TransactionHandle, 1,
if isc_start_transaction(@Status[0], @TransactionHandle, 1,
[@DBHandle, Length(TPB), @TPB[1]]) <> 0 then
CheckError('StartTransaction',Status)
else Result := True;
@ -221,14 +219,14 @@ end;
procedure TIBConnection.CommitRetaining(trans : TSQLHandle);
begin
with trans as TIBtrans do
if isc_commit_retaining(@Status, @TransactionHandle) <> 0 then
if isc_commit_retaining(@Status[0], @TransactionHandle) <> 0 then
CheckError('CommitRetaining', Status);
end;
procedure TIBConnection.RollBackRetaining(trans : TSQLHandle);
begin
with trans as TIBtrans do
if isc_rollback_retaining(@Status, @TransactionHandle) <> 0 then
if isc_rollback_retaining(@Status[0], @TransactionHandle) <> 0 then
CheckError('RollBackRetaining', Status);
end;
@ -258,7 +256,7 @@ begin
FSQLDatabaseHandle := nil;
if HostName <> '' then ADatabaseName := HostName+':'+DatabaseName
else ADatabaseName := DatabaseName;
if isc_attach_database(@FStatus, Length(ADatabaseName), @ADatabaseName[1], @FSQLDatabaseHandle,
if isc_attach_database(@FStatus[0], Length(ADatabaseName), @ADatabaseName[1], @FSQLDatabaseHandle,
Length(DPB), @DPB[1]) <> 0 then
CheckError('DoInternalConnect', FStatus);
SetDBDialect;
@ -285,12 +283,13 @@ procedure TIBConnection.SetDBDialect;
var
x : integer;
Len : integer;
Buffer : string;
Buffer : array [0..1] of byte;
ResBuf : array [0..39] of byte;
begin
Buffer := Chr(isc_info_db_sql_dialect) + Chr(isc_info_end);
if isc_database_info(@FStatus, @FSQLDatabaseHandle, Length(Buffer),
@Buffer[1], SizeOf(ResBuf), @ResBuf) <> 0 then
Buffer[0] := isc_info_db_sql_dialect;
Buffer[1] := isc_info_end;
if isc_database_info(@FStatus[0], @FSQLDatabaseHandle, Length(Buffer),
pchar(@Buffer[0]), SizeOf(ResBuf), pchar(@ResBuf[0])) <> 0 then
CheckError('SetDBDialect', FStatus);
x := 0;
while x < 40 do
@ -298,9 +297,9 @@ begin
isc_info_db_sql_dialect :
begin
Inc(x);
Len := isc_vax_integer(@ResBuf[x], 2);
Len := isc_vax_integer(pchar(@ResBuf[x]), 2);
Inc(x, 2);
FDialect := isc_vax_integer(@ResBuf[x], Len);
FDialect := isc_vax_integer(pchar(@ResBuf[x]), Len);
Inc(x, Len);
end;
isc_info_end : Break;
@ -449,20 +448,20 @@ begin
with cursor as TIBcursor do
begin
dh := GetHandle;
if isc_dsql_allocate_statement(@Status, @dh, @Statement) <> 0 then
if isc_dsql_allocate_statement(@Status[0], @dh, @Statement) <> 0 then
CheckError('PrepareStatement', Status);
tr := aTransaction.Handle;
if assigned(AParams) and (AParams.count > 0) then
buf := AParams.ParseSQL(buf,false,psInterbase,paramBinding);
if isc_dsql_prepare(@Status, @tr, @Statement, 0, @Buf[1], Dialect, nil) <> 0 then
if isc_dsql_prepare(@Status[0], @tr, @Statement, 0, @Buf[1], Dialect, nil) <> 0 then
CheckError('PrepareStatement', Status);
FPrepared := True;
if assigned(AParams) and (AParams.count > 0) then
begin
AllocSQLDA(in_SQLDA,Length(ParamBinding));
if isc_dsql_describe_bind(@Status, @Statement, 1, in_SQLDA) <> 0 then
if isc_dsql_describe_bind(@Status[0], @Statement, 1, in_SQLDA) <> 0 then
CheckError('PrepareStatement', Status);
if in_SQLDA^.SQLD > in_SQLDA^.SQLN then
DatabaseError(SParameterCountIncorrect,self);
@ -480,12 +479,12 @@ begin
if FStatementType = stselect then
begin
FPrepared := False;
if isc_dsql_describe(@Status, @Statement, 1, SQLDA) <> 0 then
if isc_dsql_describe(@Status[0], @Statement, 1, SQLDA) <> 0 then
CheckError('PrepareSelect', Status);
if SQLDA^.SQLD > SQLDA^.SQLN then
begin
AllocSQLDA(SQLDA,SQLDA^.SQLD);
if isc_dsql_describe(@Status, @Statement, 1, SQLDA) <> 0 then
if isc_dsql_describe(@Status[0], @Statement, 1, SQLDA) <> 0 then
CheckError('PrepareSelect', Status);
end;
{$R-}
@ -507,7 +506,7 @@ procedure TIBConnection.UnPrepareStatement(cursor : TSQLCursor);
begin
with cursor as TIBcursor do
begin
if isc_dsql_free_statement(@Status, @Statement, DSQL_Drop) <> 0 then
if isc_dsql_free_statement(@Status[0], @Statement, DSQL_Drop) <> 0 then
CheckError('FreeStatement', Status);
Statement := nil;
FPrepared := False;
@ -550,7 +549,7 @@ begin
tr := aTransaction.Handle;
if Assigned(APArams) and (AParams.count > 0) then SetParameters(cursor, AParams);
with cursor as TIBCursor do
if isc_dsql_execute2(@Status, @tr, @Statement, 1, in_SQLDA, nil) <> 0 then
if isc_dsql_execute2(@Status[0], @tr, @Statement, 1, in_SQLDA, nil) <> 0 then
CheckError('Execute', Status);
end;
@ -591,7 +590,7 @@ var
begin
with cursor as TIBCursor do
begin
retcode := isc_dsql_fetch(@Status, @Statement, 1, SQLDA);
retcode := isc_dsql_fetch(@Status[0], @Statement, 1, SQLDA);
if (retcode <> 0) and (retcode <> 100) then
CheckError('Fetch', Status);
end;
@ -663,7 +662,7 @@ begin
begin
TransactionHandle := transaction.Handle;
blobhandle := nil;
if isc_create_blob(@FStatus, @FSQLDatabaseHandle, @TransactionHandle, @blobHandle, @blobId) <> 0 then
if isc_create_blob(@FStatus[0], @FSQLDatabaseHandle, @TransactionHandle, @blobHandle, @blobId) <> 0 then
CheckError('TIBConnection.CreateBlobStream', FStatus);
s := AParams[ParNr].AsString;
@ -674,14 +673,14 @@ begin
while BlobBytesWritten < (BlobSize-BlobSegmentSize) do
begin
isc_put_segment(@FStatus, @blobHandle, BlobSegmentSize, @s[(i*BlobSegmentSize)+1]);
isc_put_segment(@FStatus[0], @blobHandle, BlobSegmentSize, @s[(i*BlobSegmentSize)+1]);
inc(BlobBytesWritten,BlobSegmentSize);
inc(i);
end;
if BlobBytesWritten <> BlobSize then
isc_put_segment(@FStatus, @blobHandle, BlobSize-BlobBytesWritten, @s[(i*BlobSegmentSize)+1]);
isc_put_segment(@FStatus[0], @blobHandle, BlobSize-BlobBytesWritten, @s[(i*BlobSegmentSize)+1]);
if isc_close_blob(@FStatus, @blobHandle) <> 0 then
if isc_close_blob(@FStatus[0], @blobHandle) <> 0 then
CheckError('TIBConnection.CreateBlobStream isc_close_blob', FStatus);
Move(blobId, in_sqlda^.SQLvar[SQLVarNr].SQLData^, in_SQLDA^.SQLVar[SQLVarNr].SQLLen);
end;
@ -998,7 +997,7 @@ var
blobInfo : array[0..50] of byte;
begin
if isc_blob_info(@Fstatus, @blobHandle, sizeof(iscInfoBlobMaxSegment), @iscInfoBlobMaxSegment, sizeof(blobInfo) - 2, @blobInfo) <> 0 then
if isc_blob_info(@Fstatus[0], @blobHandle, sizeof(iscInfoBlobMaxSegment), pchar(@iscInfoBlobMaxSegment), sizeof(blobInfo) - 2, pchar(@blobInfo[0])) <> 0 then
CheckError('isc_blob_info', FStatus);
if blobInfo[0] = isc_info_blob_max_segment then
begin
@ -1015,7 +1014,7 @@ const
var
blobHandle : Isc_blob_Handle;
blobSegment : pointer;
blobSegLen : smallint;
blobSegLen : word;
maxBlobSize : longInt;
TransactionHandle : pointer;
BlobBuf : TBufBlobField;
@ -1023,19 +1022,19 @@ var
begin
if not field.getData(@BlobBuf) then
exit;
blobId := @BlobBuf;
blobId := PISC_QUAD(@BlobBuf.ConnBlobBuffer);
TransactionHandle := Atransaction.Handle;
blobHandle := nil;
if isc_open_blob(@FStatus, @FSQLDatabaseHandle, @TransactionHandle, @blobHandle, blobId) <> 0 then
if isc_open_blob(@FStatus[0], @FSQLDatabaseHandle, @TransactionHandle, @blobHandle, blobId) <> 0 then
CheckError('TIBConnection.CreateBlobStream', FStatus);
maxBlobSize := getMaxBlobSize(blobHandle);
blobSegment := AllocMem(maxBlobSize);
while (isc_get_segment(@FStatus, @blobHandle, @blobSegLen, maxBlobSize, blobSegment) = 0) do begin
while (isc_get_segment(@FStatus[0], @blobHandle, @blobSegLen, maxBlobSize, blobSegment) = 0) do begin
AStream.writeBuffer(blobSegment^, blobSegLen);
end;
freemem(blobSegment);
@ -1043,7 +1042,7 @@ begin
if FStatus[1] = isc_segstr_eof then
begin
if isc_close_blob(@FStatus, @blobHandle) <> 0 then
if isc_close_blob(@FStatus[0], @blobHandle) <> 0 then
CheckError('TIBConnection.CreateBlobStream isc_close_blob', FStatus);
end
else

2
fcl/db/sqldb/postgres/pqconnection.pp
View File

@ -453,7 +453,7 @@ end;
procedure TPQConnection.Execute(cursor: TSQLCursor;atransaction:tSQLtransaction;AParams : TParams);
var ar : array of pointer;
var ar : array of pchar;
i : integer;
s : string;

2
fcl/db/sqldb/sqldb.pp
View File

@ -481,7 +481,7 @@ var blobId : pinteger;
begin
if not field.getData(@BlobBuf) then
exit;
blobId := @BlobBuf;
blobId := @BlobBuf.BufBlobId;
s := cursor.FBlobStrings.Strings[blobid^];

49
fcl/db/unmaintained/interbase/interbase.pp
View File

@ -339,16 +339,14 @@ type
__tm_zone : Pchar;
end;
procedure CheckError(ProcName : string; Status : array of ISC_STATUS);
procedure CheckError(ProcName : string; Status : PISC_STATUS);
var
buf : array [0..1024] of char;
p : pointer;
Msg : string;
begin
if ((Status[0] = 1) and (Status[1] <> 0)) then
begin
p := @Status;
while isc_interprete(Buf, @p) > 0 do
while isc_interprete(Buf, @Status) > 0 do
Msg := Msg + #10' -' + StrPas(Buf);
raise EInterBaseError.Create(ProcName + ': ' + Msg);
end;
@ -360,12 +358,13 @@ procedure TIBDatabase.SetDBDialect;
var
x : integer;
Len : integer;
Buffer : string;
Buffer : array [0..1] of byte;
ResBuf : array [0..39] of byte;
begin
Buffer := Chr(isc_info_db_sql_dialect) + Chr(isc_info_end);
if isc_database_info(@FStatus, @FIBDatabaseHandle, Length(Buffer),
@Buffer[1], SizeOf(ResBuf), @ResBuf) <> 0 then
Buffer[0] := isc_info_db_sql_dialect;
Buffer[1] := isc_info_end;
if isc_database_info(@FStatus[0], @FIBDatabaseHandle, sizeof(Buffer),
pchar(@Buffer[0]), SizeOf(ResBuf), pchar(@ResBuf)) <> 0 then
CheckError('TIBDatabse.SetDBDialect', FStatus);
x := 0;
while x < 40 do
@ -373,9 +372,9 @@ begin
isc_info_db_sql_dialect :
begin
Inc(x);
Len := isc_vax_integer(@ResBuf[x], 2);
Len := isc_vax_integer(pchar(@ResBuf[x]), 2);
Inc(x, 2);
FDialect := isc_vax_integer(@ResBuf[x], Len);
FDialect := isc_vax_integer(pchar(@ResBuf[x]), Len);
Inc(x, Len);
end;
isc_info_end : Break;
@ -430,7 +429,7 @@ begin
if (DatabaseName = '') then
raise EInterBaseError.Create('TIBDatabase.Open: Database connect string (DatabaseName) not filled in!');
FIBDatabaseHandle := nil;
if isc_attach_database(@FStatus, Length(DatabaseName), @DatabaseName[1], @FIBDatabaseHandle,
if isc_attach_database(@FStatus[0], Length(DatabaseName), @DatabaseName[1], @FIBDatabaseHandle,
Length(DPB), @DPB[1]) <> 0 then
CheckError('TIBDatabase.Open', FStatus);
SetDBDialect;
@ -532,7 +531,7 @@ end;
procedure TIBTransaction.Commit;
begin
if not FActive then Exit;
if isc_commit_transaction(@FStatus, @FTransactionHandle) <> 0 then
if isc_commit_transaction(@FStatus[0], @FTransactionHandle) <> 0 then
CheckError('TIBTransaction.Commit', FStatus)
else FActive := False;
end;
@ -540,14 +539,14 @@ end;
procedure TIBTransaction.CommitRetaining;
begin
if not FActive then Exit;
if isc_commit_retaining(@FStatus, @FTransactionHandle) <> 0 then
if isc_commit_retaining(@FStatus[0], @FTransactionHandle) <> 0 then
CheckError('TIBTransaction.CommitRetaining', FStatus);
end;
procedure TIBTransaction.Rollback;
begin
if not FActive then Exit;
if isc_rollback_transaction(@FStatus, @FTransactionHandle) <> 0 then
if isc_rollback_transaction(@FStatus[0], @FTransactionHandle) <> 0 then
CheckError('TIBTransaction.Rollback', FStatus)
else FActive := False;
end;
@ -555,7 +554,7 @@ end;
procedure TIBTransaction.RollbackRetaining;
begin
if not FActive then Exit;
if isc_rollback_retaining(@FStatus, @FTransactionHandle) <> 0 then
if isc_rollback_retaining(@FStatus[0], @FTransactionHandle) <> 0 then
CheckError('TIBTransaction.RollbackRetaining', FStatus);
end;
@ -575,7 +574,7 @@ begin
SetTPB;
FTransactionHandle := nil;
if isc_start_transaction(@FStatus, @FTransactionHandle, 1,
if isc_start_transaction(@FStatus[0], @FTransactionHandle, 1,
[@DBHandle, Length(FTPB), @FTPB[1]]) <> 0 then
CheckError('TIBTransaction.StartTransaction',FStatus)
else FActive := True;
@ -650,13 +649,13 @@ begin
FDatabase.Open;
dh := FDatabase.GetHandle;
if isc_dsql_allocate_statement(@FStatus, @dh, @FStatement) <> 0 then
if isc_dsql_allocate_statement(@FStatus[0], @dh, @FStatement) <> 0 then
CheckError('TIBQuery.AllocStatement', FStatus);
end;
procedure TIBQuery.FreeStatement;
begin
if isc_dsql_free_statement(@FStatus, @FStatement, DSQL_Drop) <> 0 then
if isc_dsql_free_statement(@FStatus[0], @FStatement, DSQL_Drop) <> 0 then
CheckError('TIBQuery.FreeStatement', FStatus);
FStatement := nil;
end;
@ -677,18 +676,18 @@ begin
for x := 0 to FSQL.Count - 1 do
Buf := Buf + FSQL[x] + ' ';
if isc_dsql_prepare(@FStatus, @tr, @FStatement, 0, @Buf[1], Database.Dialect, nil) <> 0 then
if isc_dsql_prepare(@FStatus[0], @tr, @FStatement, 0, @Buf[1], Database.Dialect, nil) <> 0 then
CheckError('TIBQuery.PrepareStatement', FStatus);
end;
procedure TIBQuery.DescribeStatement;
begin
if isc_dsql_describe(@FStatus, @FStatement, 1, FSQLDA) <> 0 then
if isc_dsql_describe(@FStatus[0], @FStatement, 1, FSQLDA) <> 0 then
CheckError('TIBQuery.DescribeStatement', FStatus);
if FSQLDA^.SQLD > FSQLDA^.SQLN then
begin
AllocSQLDA(FSQLDA^.SQLD);
if isc_dsql_describe(@FStatus, @FStatement, 1, FSQLDA) <> 0 then
if isc_dsql_describe(@FStatus[0], @FStatement, 1, FSQLDA) <> 0 then
CheckError('TIBQuery.DescribeStatement', FStatus);
end;
end;
@ -756,7 +755,7 @@ begin
if not (FStatementType in [stSelect]) then
Exit;
retcode := isc_dsql_fetch(@FStatus, @FStatement, 1, FSQLDA);
retcode := isc_dsql_fetch(@FStatus[0], @FStatement, 1, FSQLDA);
if (retcode <> 0) and (retcode <> 100) then
CheckError('TIBQuery.Fetch', FStatus);
@ -809,8 +808,8 @@ var
begin
FStatementType := stNone;
x := isc_info_sql_stmt_type;
if isc_dsql_sql_info(@FStatus, @FStatement, SizeOf(X),
@x, SizeOf(ResBuf), @ResBuf) <> 0 then
if isc_dsql_sql_info(@FStatus[0], @FStatement, SizeOf(X),
pchar(@x), SizeOf(ResBuf), @ResBuf[0]) <> 0 then
CheckError('TIBQuery.GetStatementType', FStatus);
if Ord(ResBuf[0]) = isc_info_sql_stmt_type then
begin
@ -910,7 +909,7 @@ begin
if not FTransaction.Active then
FTransaction.StartTransaction;
tr := FTransaction.GetHandle;
if isc_dsql_execute(@FStatus, @tr, @FStatement, 1, nil) <> 0 then
if isc_dsql_execute(@FStatus[0], @tr, @FStatement, 1, nil) <> 0 then
CheckError('TIBQuery.Execute', FStatus);
end;

14
fcl/image/fpimgcmn.pp
View File

@ -41,13 +41,8 @@ begin
end;
function Swap(This : integer): integer;
var r,p : ^longword;
res : integer;
begin
p := @This;
r := @res;
r^ := Swap (p^);
result := res;
result := integer(Swap(longword(This)));
end;
function Swap(This : longword): longword;
@ -82,13 +77,8 @@ begin
end;
function Swap(This : int64): int64;
var r,p : ^qword;
res : int64;
begin
p := @This;
r := @res;
r^ := Swap (p^);
result := res;
result := int64(Swap(qword(This)));
end;
var CRCtable : array[0..255] of longword;

2
fcl/image/fpreadjpeg.pas
View File

@ -270,7 +270,7 @@ begin
try
FProgressMgr.pub.progress_monitor := @ProgressCallback;
FProgressMgr.instance := Self;
FInfo.progress := @FProgressMgr;
FInfo.progress := @FProgressMgr.pub;
SetSource;
ReadHeader;
ReadPixels;

2
fcl/image/fpwritejpeg.pas
View File

@ -105,7 +105,7 @@ var
jpeg_create_compress(@FInfo);
FProgressMgr.pub.progress_monitor := @ProgressCallback;
FProgressMgr.instance := Self;
FInfo.progress := @FProgressMgr;
FInfo.progress := @FProgressMgr.pub;
end;
procedure SetDestination;

2
fcl/inc/contnrs.pp
View File

@ -1357,7 +1357,7 @@ var
psrc : PHashItem;
begin
NewCount:=0;
psrc:=@FHashList[0];
psrc:=FHashList[0];
pdest:=psrc;
For I:=0 To FCount-1 Do
begin

4
fcl/inc/gettext.pp
View File

@ -239,9 +239,9 @@ begin
Lang := '';
FallbackLang:='';
UserLCID := GetUserDefaultLCID;
if GetLocaleInfo(UserLCID, LOCALE_SABBREVLANGNAME, @Buffer, 4)<>0 then
if GetLocaleInfo(UserLCID, LOCALE_SABBREVLANGNAME, @Buffer[1], 4)<>0 then
FallbackLang := lowercase(copy(Buffer,1,2));
if GetLocaleInfo(UserLCID, LOCALE_SABBREVCTRYNAME, @Buffer, 4)<>0 then begin
if GetLocaleInfo(UserLCID, LOCALE_SABBREVCTRYNAME, @Buffer[1], 4)<>0 then begin
Country := copy(Buffer,1,2);
// some 2 letter codes are not the first two letters of the 3 letter code

12
fcl/inc/zstream.pp
View File

@ -218,7 +218,7 @@ const
(Z_NO_COMPRESSION, Z_BEST_SPEED, Z_DEFAULT_COMPRESSION, Z_BEST_COMPRESSION);
begin
inherited Create(Dest);
FZRec.next_out := @FBuffer;
FZRec.next_out := @FBuffer[0];
FZRec.avail_out := sizeof(FBuffer);
If ASkipHeader then
CompressionCheck(deflateInit2(FZRec, Levels[CompressionLevel],Z_DEFLATED, -MAX_WBITS, DEF_MEM_LEVEL, 0))
@ -236,7 +236,7 @@ begin
and (FZRec.avail_out = 0) do
begin
Source.WriteBuffer(FBuffer, sizeof(FBuffer));
FZRec.next_out := @FBuffer;
FZRec.next_out := @FBuffer[0];
FZRec.avail_out := sizeof(FBuffer);
end;
if FZRec.avail_out < sizeof(FBuffer) then
@ -275,7 +275,7 @@ begin
if FZRec.avail_out = 0 then
begin
Source.WriteBuffer(FBuffer, sizeof(FBuffer));
FZRec.next_out := @FBuffer;
FZRec.next_out := @FBuffer[0];
FZRec.avail_out := sizeof(FBuffer);
FStrmPos := Source.Position;
Progress(Self);
@ -309,7 +309,7 @@ end;
constructor TDecompressionStream.Create(ASource: TStream);
begin
inherited Create(ASource);
FZRec.next_in := @FBuffer;
FZRec.next_in := @FBuffer[0];
DecompressionCheck(inflateInit(FZRec));
end;
@ -346,7 +346,7 @@ begin
Result := Count - FZRec.avail_out;
Exit;
end;
FZRec.next_in := @FBuffer;
FZRec.next_in := @FBuffer[0];
FStrmPos := Source.Position;
Progress(Self);
end;
@ -373,7 +373,7 @@ begin
if (Offset = 0) and (Origin = soFromBeginning) then
begin
DecompressionCheck(inflateReset(FZRec));
FZRec.next_in := @FBuffer;
FZRec.next_in := @FBuffer[0];
FZRec.avail_in := 0;
Source.Position := 0;
FStrmPos := 0;

4
fcl/unix/process.inc
View File

@ -27,7 +27,7 @@ end;
Function TProcess.PeekExitStatus : Boolean;
begin
Result:=fpWaitPid(Handle,@FExitCode,WNOHANG)=Handle;
Result:=fpWaitPid(Handle,pcint(@FExitCode),WNOHANG)=Handle;
If Result then
FExitCode:=wexitstatus(FExitCode)
else
@ -338,7 +338,7 @@ end;
Function TProcess.WaitOnExit : Dword;
begin
Result:=fpWaitPid(Handle,@FExitCode,0);
Result:=fpWaitPid(Handle,pcint(@FExitCode),0);
If Result=Handle then
FExitCode:=WexitStatus(FExitCode);
FRunning:=False;

21
fcl/win/winreg.inc
View File

@ -74,7 +74,7 @@ Var
begin
P := @Name[1];
If RegQueryValueEx(fCurrentKey,P,Nil,
@RD,Buffer,@BufSize)<>ERROR_SUCCESS Then
@RD,Buffer,lpdword(@BufSize))<>ERROR_SUCCESS Then
Result:=-1
else
begin
@ -100,7 +100,7 @@ Var
begin
P:=@ValueName[1];
With Value do
Result:=RegQueryValueEx(fCurrentKey,P,Nil,@RegData,Nil,@DataSize)=ERROR_SUCCESS;
Result:=RegQueryValueEx(fCurrentKey,P,Nil,lpdword(@RegData),Nil,lpdword(@DataSize))=ERROR_SUCCESS;
If Not Result Then
begin
Value.RegData := rdUnknown;
@ -114,13 +114,20 @@ begin
end;
function TRegistry.GetKeyInfo(var Value: TRegKeyInfo): Boolean;
var
winFileTime: Windows.FILETIME;
sysTime: TSystemTime;
begin
FillChar(Value, SizeOf(Value), 0);
With Value do
Result:=RegQueryInfoKey(CurrentKey,nil,nil,nil,@NumSubKeys,
@MaxSubKeyLen,nil,@NumValues,@MaxValueLen,
@MaxDataLen,nil,@FileTime)=ERROR_SUCCESS;
Result:=RegQueryInfoKey(CurrentKey,nil,nil,nil,lpdword(@NumSubKeys),
lpdword(@MaxSubKeyLen),nil,lpdword(@NumValues),lpdword(@MaxValueLen),
lpdword(@MaxDataLen),nil,@winFileTime)=ERROR_SUCCESS;
if Result then
begin
FileTimeToSystemTime(@winFileTime, @sysTime);
Value.FileTime := SystemTimeToDateTime(sysTime);
end;
end;
function TRegistry.KeyExists(const Key: string): Boolean;
@ -155,7 +162,7 @@ begin
REG_OPTION_NON_VOLATILE,
fAccess,SecurityAttributes,Handle,
@Disposition)=ERROR_SUCCESS
pdword(@Disposition))=ERROR_SUCCESS
end
else

31
packages/base/netdb/netdb.pp
View File

@ -159,7 +159,7 @@ const
Type
TPayLoad = Array[0..511] of char;
TPayLoad = Array[0..511] of Byte;
TQueryData = packed Record
id : Array[0..1] of Byte;
flags1 : Byte;
@ -171,6 +171,7 @@ Type
Payload : TPayLoad;
end;
PRRData = ^TRRData;
TRRData = Packed record // RR record
Atype : Word; // Answer type
AClass : Word;
@ -514,7 +515,7 @@ Var
begin
Writeln('Payload : ',l);
For I:=0 to L-1 do
Write(Byte(Q.Payload[i]),' ');
Write(Q.Payload[i],' ');
Writeln;
end;
@ -529,7 +530,7 @@ begin
If length(Name)>506 then
Exit;
Result:=0;
P:=@Q.Payload;
P:=@Q.Payload[0];
Repeat
L:=Pos('.',Name);
If (L=0) then
@ -558,7 +559,7 @@ Function NextRR(Const PayLoad : TPayLoad;Var Start : LongInt; AnsLen : LongInt;
Var
I : Integer;
HaveName : Boolean;
PA : ^TRRData;
PA : PRRData;
begin
Result:=False;
@ -566,19 +567,19 @@ begin
// Skip labels and pointers. At least 1 label or pointer is present.
Repeat
HaveName:=True;
If (Payload[i]>#63) then // Pointer, skip
If (Payload[i]>63) then // Pointer, skip
Inc(I,2)
else If Payload[i]=#0 then // Null termination of label, skip.
else If Payload[i]=0 then // Null termination of label, skip.
Inc(i)
else
begin
Inc(I,Ord(Payload[i])+1); // Label, continue scan.
Inc(I,Payload[i]+1); // Label, continue scan.
HaveName:=False;
end;
Until HaveName or (I>(AnsLen-SizeOf(TRRData)));
Result:=(I<=(AnsLen-SizeOf(TRRData)));
// Check RR record.
PA:=@Payload[i];
PA:=PRRData(@Payload[i]);
RR:=PA^;
Start:=I+SizeOf(TRRData);
end;
@ -599,24 +600,24 @@ begin
O:=1;
// Copy labels and pointers. At least 1 label or pointer is present.
Repeat
If (Payload[i]>#63) then // Pointer, move.
If (Payload[i]>63) then // Pointer, move.
begin
Move(Payload[i],P,2);
I:=ntohs(p)-FIREDNS_POINTER_VALUE-12;
end
else if Payload[i]<>#0 then // Label, copy
else if Payload[i]<>0 then // Label, copy
begin
If O<>1 then
begin
Result[O]:='.';
Inc(O);
end;
P:=Ord(Payload[i]);
P:=Payload[i];
Move(Payload[i+1],Result[o],P);
Inc(I,P+1);
Inc(O,P);
end;
Until (Payload[I]=#0);
Until (Payload[I]=0);
setlength(result,o-1);
end;
@ -663,20 +664,20 @@ begin
q:=0;
While (Q<qdcount) and (i<l) do
begin
If Ord(Payload[i])>63 then
If Payload[i]>63 then
begin
Inc(I,6);
Inc(Q);
end
else
begin
If Payload[i]=#0 then
If Payload[i]=0 then
begin
inc(q);
Inc(I,5);
end
else
Inc(I,Ord(Payload[i])+1);
Inc(I,Payload[i]+1);
end;
end;
Result:=I;

4
packages/base/paszlib/inftrees.pas
View File

@ -274,7 +274,7 @@ Begin
{ Generate the Huffman codes and for each, make the table entries }
i := 0 ;
x[0] := 0 ; { first Huffman code is zero }
p := Addr(v) ; { grab values in bit order }
p := @v[0] ; { grab values in bit order }
h := -1 ; { no tables yet--level -1 }
w := -l ; { bits decoded = (l*h) }
@ -777,4 +777,4 @@ begin
end; { inflate_trees_fixed }
end.
end.

74
packages/base/paszlib/trees.pas
View File

@ -108,7 +108,7 @@ type
{ generic tree type }
tree_type = array[0..(maxint div SizeOf(ct_data))-1] of ct_data;
tree_ptr = ^tree_type;
tree_ptr = ^ct_data;
ltree_ptr = ^ltree_type;
dtree_ptr = ^dtree_type;
htree_ptr = ^htree_type;
@ -119,7 +119,7 @@ type
static_tree_desc =
record
{const} static_tree : tree_ptr; { static tree or NIL }
{const} extra_bits : Pintegerarray; { extra bits for each code or NIL }
{const} extra_bits : pinteger; { extra bits for each code or NIL }
extra_base : integer; { base index for extra_bits }
elems : integer; { max number of elements in the tree }
max_length : integer; { max bit length for the codes }
@ -686,8 +686,8 @@ var
{local}
const
static_l_desc : static_tree_desc =
(static_tree: {tree_ptr}(@(static_ltree)); { pointer to array of ct_data }
extra_bits: {pzIntfArray}(@(extra_lbits)); { pointer to array of integer }
(static_tree: {tree_ptr}@static_ltree[0]; { pointer to array of ct_data }
extra_bits: {pzIntfArray}@extra_lbits[0]; { pointer to array of integer }
extra_base: LITERALS+1;
elems: L_CODES;
max_length: MAX_BITS);
@ -695,8 +695,8 @@ const
{local}
const
static_d_desc : static_tree_desc =
(static_tree: {tree_ptr}(@(static_dtree));
extra_bits: {pzIntfArray}(@(extra_dbits));
(static_tree: {tree_ptr}@static_dtree[0];
extra_bits: {pzIntfArray}@extra_dbits[0];
extra_base : 0;
elems: D_CODES;
max_length: MAX_BITS);
@ -705,7 +705,7 @@ const
const
static_bl_desc : static_tree_desc =
(static_tree: {tree_ptr}(NIL);
extra_bits: {pzIntfArray}@(extra_blbits);
extra_bits: {pzIntfArray}@extra_blbits[0];
extra_base : 0;
elems: BL_CODES;
max_length: MAX_BL_BITS);
@ -868,21 +868,21 @@ begin
for n := 0 to max_code do
begin
len := tree^[n].dl.Len;
len := tree[n].dl.Len;
if (len = 0) then
continue;
{ Now reverse the bits }
tree^[n].fc.Code := bi_reverse(next_code[len], len);
tree[n].fc.Code := bi_reverse(next_code[len], len);
inc(next_code[len]);
{$ifdef ZLIB_DEBUG}
if (n>31) and (n<128) then
Tracecv(tree <> tree_ptr(@static_ltree),
(^M'n #'+IntToStr(n)+' '+char(n)+' l '+IntToStr(len)+' c '+
IntToStr(tree^[n].fc.Code)+' ('+IntToStr(next_code[len]-1)+')'))
IntToStr(tree[n].fc.Code)+' ('+IntToStr(next_code[len]-1)+')'))
else
Tracecv(tree <> tree_ptr(@static_ltree),
(^M'n #'+IntToStr(n)+' l '+IntToStr(len)+' c '+
IntToStr(tree^[n].fc.Code)+' ('+IntToStr(next_code[len]-1)+')'));
IntToStr(tree[n].fc.Code)+' ('+IntToStr(next_code[len]-1)+')'));
{$ENDIF}
end;
end;
@ -1157,7 +1157,7 @@ macro smaller(tree, n, m, depth)
{local}
procedure pqdownheap(var s : deflate_state;
var tree : tree_type; { the tree to restore }
tree : tree_ptr; { the tree to restore }
k : integer); { node to move down }
var
v : integer;
@ -1209,7 +1209,7 @@ var
tree : tree_ptr;
max_code : integer;
stree : tree_ptr; {const}
extra : Pintegerarray; {const}
extra : pinteger; {const}
base : integer;
max_length : integer;
h : integer; { heap index }
@ -1233,18 +1233,18 @@ begin
{ In a first pass, compute the optimal bit lengths (which may
overflow in the case of the bit length tree). }
tree^[s.heap[s.heap_max]].dl.Len := 0; { root of the heap }
tree[s.heap[s.heap_max]].dl.Len := 0; { root of the heap }
for h := s.heap_max+1 to HEAP_SIZE-1 do
begin
n := s.heap[h];
bits := tree^[tree^[n].dl.Dad].dl.Len + 1;
bits := tree[tree[n].dl.Dad].dl.Len + 1;
if (bits > max_length) then
begin
bits := max_length;
inc(overflow);
end;
tree^[n].dl.Len := word(bits);
tree[n].dl.Len := word(bits);
{ We overwrite tree[n].dl.Dad which is no longer needed }
if (n > max_code) then
@ -1253,11 +1253,11 @@ begin
inc(s.bl_count[bits]);
xbits := 0;
if (n >= base) then
xbits := extra^[n-base];
f := tree^[n].fc.Freq;
xbits := extra[n-base];
f := tree[n].fc.Freq;
inc(s.opt_len, longint(f) * (bits + xbits));
if (stree <> NIL) then
inc(s.static_len, longint(f) * (stree^[n].dl.Len + xbits));
inc(s.static_len, longint(f) * (stree[n].dl.Len + xbits));
end;
if (overflow = 0) then
exit;
@ -1294,15 +1294,15 @@ begin
m := s.heap[h];
if (m > max_code) then
continue;
if (tree^[m].dl.Len <> cardinal(bits)) then
if (tree[m].dl.Len <> cardinal(bits)) then
begin
{$ifdef ZLIB_DEBUG}
Trace('code '+IntToStr(m)+' bits '+IntToStr(tree^[m].dl.Len)
Trace('code '+IntToStr(m)+' bits '+IntToStr(tree[m].dl.Len)
+'.'+IntToStr(bits));
{$ENDIF}
inc(s.opt_len, (cardinal(bits) - cardinal(tree^[m].dl.Len))
* cardinal(tree^[m].fc.Freq) );
tree^[m].dl.Len := word(bits);
inc(s.opt_len, (cardinal(bits) - cardinal(tree[m].dl.Len))
* cardinal(tree[m].fc.Freq) );
tree[m].dl.Len := word(bits);
end;
dec(n);
end;
@ -1342,7 +1342,7 @@ begin
for n := 0 to elems-1 do
begin
if (tree^[n].fc.Freq <> 0) then
if (tree[n].fc.Freq <> 0) then
begin
max_code := n;
inc(s.heap_len);
@ -1351,7 +1351,7 @@ begin
end
else
begin
tree^[n].dl.Len := 0;
tree[n].dl.Len := 0;
end;
end;
@ -1374,11 +1374,11 @@ begin
s.heap[s.heap_len] := 0;
node := 0;
end;
tree^[node].fc.Freq := 1;
tree[node].fc.Freq := 1;
s.depth[node] := 0;
dec(s.opt_len);
if (stree <> NIL) then
dec(s.static_len, stree^[node].dl.Len);
dec(s.static_len, stree[node].dl.Len);
{ node is 0 or 1 so it does not have extra bits }
end;
desc.max_code := max_code;
@ -1387,7 +1387,7 @@ begin
establish sub-heaps of increasing lengths: }
for n := s.heap_len div 2 downto 1 do
pqdownheap(s, tree^, n);
pqdownheap(s, tree, n);
{ Construct the Huffman tree by repeatedly combining the least two
frequent nodes. }
@ -1398,7 +1398,7 @@ begin
n := s.heap[SMALLEST];
s.heap[SMALLEST] := s.heap[s.heap_len];
dec(s.heap_len);
pqdownheap(s, tree^, SMALLEST);
pqdownheap(s, tree, SMALLEST);
m := s.heap[SMALLEST]; { m := node of next least frequency }
@ -1408,26 +1408,26 @@ begin
s.heap[s.heap_max] := m;
{ Create a new node father of n and m }
tree^[node].fc.Freq := tree^[n].fc.Freq + tree^[m].fc.Freq;
tree[node].fc.Freq := tree[n].fc.Freq + tree[m].fc.Freq;
{ maximum }
if (s.depth[n] >= s.depth[m]) then
s.depth[node] := byte (s.depth[n] + 1)
else
s.depth[node] := byte (s.depth[m] + 1);
tree^[m].dl.Dad := word(node);
tree^[n].dl.Dad := word(node);
tree[m].dl.Dad := word(node);
tree[n].dl.Dad := word(node);
{$ifdef DUMP_BL_TREE}
if (tree = tree_ptr(@s.bl_tree)) then
begin
WriteLn(#13'node ',node,'(',tree^[node].fc.Freq,') sons ',n,
'(',tree^[n].fc.Freq,') ', m, '(',tree^[m].fc.Freq,')');
WriteLn(#13'node ',node,'(',tree[node].fc.Freq,') sons ',n,
'(',tree[n].fc.Freq,') ', m, '(',tree[m].fc.Freq,')');
end;
{$endif}
{ and insert the new node in the heap }
s.heap[SMALLEST] := node;
inc(node);
pqdownheap(s, tree^, SMALLEST);
pqdownheap(s, tree, SMALLEST);
until (s.heap_len < 2);
@ -2201,4 +2201,4 @@ begin
64K-1 bytes. }
end;
end.
end.

10
packages/extra/a52/a52.pas
View File

@ -372,7 +372,7 @@ begin
FillChar(Result^, Sizeof(a52_decoder), 0);
Result^.state := a52_init(mm_accel);
Result^.fsamples := a52_samples(Result^.state);
Result^.inbuf_ptr := @Result^.inbuf;
Result^.inbuf_ptr := @Result^.inbuf[0];
Result^.user := user;
Result^.read := read;
Result^.seek := seek;
@ -427,7 +427,7 @@ begin
(* no header seen : find one. We need at least 7 bytes to parse it *)
//WriteLn('no header seen (', len, ')');
len := a52_syncinfo(@decoder^.inbuf, decoder^.flags, sample_rate, bit_rate);
len := a52_syncinfo(@decoder^.inbuf[0], decoder^.flags, sample_rate, bit_rate);
if len = 0 then
begin
(* no sync found : move by one byte (inefficient, but simple!) *)
@ -456,9 +456,9 @@ begin
flags := A52_STEREO;//decoder^.flags;
level := High(Smallint)-30;
if a52_frame(decoder^.state, @decoder^.inbuf, flags, level, 0) <> 0 then
if a52_frame(decoder^.state, @decoder^.inbuf[0], flags, level, 0) <> 0 then
begin
decoder^.inbuf_ptr := @decoder^.inbuf;
decoder^.inbuf_ptr := @decoder^.inbuf[0];
decoder^.frame_size := 0;
Continue;
end;
@ -467,7 +467,7 @@ begin
begin
if a52_block(decoder^.state) <> 0 then
begin
decoder^.inbuf_ptr := @decoder^.inbuf;
decoder^.inbuf_ptr := @decoder^.inbuf[0];
decoder^.frame_size := 0;
Exit(-1);
end;

4
packages/extra/cdrom/wincd.pp
View File

@ -183,7 +183,7 @@ begin
DataTransferLength := SizeOf(tOC);
TimeOutValue := 5;
DataBuffer := @TOC;
SenseInfoOffset := @swb.ucSenseBuf-@swb.spt;
SenseInfoOffset := @swb.ucSenseBuf[0]-pbyte(@swb.spt);
Cdb[0] := $43; // read TOC
Cdb[1] := $02; // MSF mode
Cdb[7] := $03;
@ -376,7 +376,7 @@ var
begin
FillChar(Drives,SizeOf(Drives),0);
GetLogicalDriveStrings(105,Drives);
P:=@Drives;
P:=@Drives[0];
Result:=0;
While P[0]<>#0 do
begin

12
packages/extra/dts/dts.pas
View File

@ -390,7 +390,7 @@ begin
FillChar(Result^, Sizeof(dts_decoder), 0);
Result^.state := dts_init(mm_accel);
Result^.fsamples := dts_samples(Result^.state);
Result^.inbuf_ptr := @Result^.inbuf;
Result^.inbuf_ptr := @Result^.inbuf[0];
Result^.user := user;
Result^.read := read;
Result^.seek := seek;
@ -444,7 +444,7 @@ begin
begin
(* no header seen : find one. We need at least 7 bytes to parse it *)
len := dts_syncinfo(decoder^.state, @decoder^.inbuf, decoder^.flags, sample_rate, bit_rate, i{dummy});
len := dts_syncinfo(decoder^.state, @decoder^.inbuf[0], decoder^.flags, sample_rate, bit_rate, i{dummy});
if len = 0 then
begin
(* no sync found : move by one byte (inefficient, but simple!) *)
@ -474,9 +474,9 @@ begin
level := 0;//High(Smallint)-30;
(* FIXME dts_frame dont care on level parameters, so I set it to zero and multiply with High(Smallint) later *)
if dts_frame(decoder^.state, @decoder^.inbuf, flags, level, 0) <> 0 then
if dts_frame(decoder^.state, @decoder^.inbuf[0], flags, level, 0) <> 0 then
begin
decoder^.inbuf_ptr := @decoder^.inbuf;
decoder^.inbuf_ptr := @decoder^.inbuf[0];
decoder^.frame_size := 0;
Continue;
end;
@ -486,7 +486,7 @@ begin
begin
if dts_block(decoder^.state) <> 0 then
begin
decoder^.inbuf_ptr := @decoder^.inbuf;
decoder^.inbuf_ptr := @decoder^.inbuf[0];
decoder^.frame_size := 0;
Exit(-1);
end;
@ -526,4 +526,4 @@ begin
Result := ofs;
end;
end.
end.

8
packages/extra/fpgtk/fpgtk.pp
View File

@ -4964,7 +4964,7 @@ begin
end;
function TFPgtkImage.GetMask : PGdkBitMap;
var p : PGdkPixmap;
var p : PGdkImage;
begin
gtk_image_get (TheGtkObject, @p, @result);
end;
@ -7317,7 +7317,7 @@ var PT : PGtkPackType;
begin
pt := @PackType;
gtk_box_query_child_packing (TheGtkObject, ConvertToGtkWidget(Widget),
@expand, @fill, @padding, pt);
pgboolean(@expand), pgboolean(@fill), pguint(@padding), pt);
end;
procedure TFPgtkBox.SetChildPacking (Widget:TFPgtkWidget; Expand:boolean; Fill:boolean; Padding:integer; PackType:TGtkPackType);
@ -8788,7 +8788,7 @@ begin
s := nil;
r := gtk_ctree_get_node_info (TheGtkObject, aNode, s,
@aspacing, @pixmapClosed, @maskClosed, @pixmapOpened, @maskOpened,
@IsLeaf, @expanded);
pgboolean(@IsLeaf), pgboolean(@expanded));
if r = 0 then
begin
atext := '';
@ -9154,7 +9154,7 @@ var PT : PGtkPackType;
begin
pt := @PackType;
gtk_notebook_query_tab_label_packing (TheGtkObject, ConvertTogtkWidget(widget),
@expand, @fill, pt);
pgboolean(@expand), pgboolean(@fill), pt);
end;
procedure TFPgtkNotebook.SetTabLabelPacking (Widget:TFPgtkWidget; Expand:boolean; Fill:boolean; PackType:TGtkPackType);

63
packages/extra/ldap/ntlm.pas
View File

@ -216,7 +216,7 @@ var
m : Integer;
n : Integer;
begin
permute(@pk1, key, @perm1, 56);
permute(@pk1[0], key, @perm1[0], 56);
for i := 0 to 27 do
begin
@ -226,14 +226,14 @@ begin
for i := 0 to 15 do
begin
lshift(@c, sc[i], 28);
lshift(@d, sc[i], 28);
lshift(@c[0], sc[i], 28);
lshift(@d[0], sc[i], 28);
concat(@cd, @c, @d, 28, 28);
permute(@ki[i][0], @cd, @perm2, 48);
concat(@cd[0], @c[0], @d[0], 28, 28);
permute(@ki[i][0], @cd[0], @perm2[0], 48);
end;
permute(@pd1, _in, @perm3, 64);
permute(@pd1[0], _in, @perm3[0], 64);
for i := 0 to 31 do
begin
@ -243,11 +243,11 @@ begin
for i := 0 to 15 do
begin
permute(@er, @r, @perm4, 48);
permute(@er[0], @r[0], @perm4[0], 48);
if forw then
mxor(@erk, @er, @ki[i][0], 48) else
mxor(@erk, @er, @ki[15-i][0], 48);
mxor(@erk[0], @er[0], @ki[i][0], 48) else
mxor(@erk[0], @er[0], @ki[15-i][0], 48);
for j := 0 to 7 do
for k := 0 to 5 do
@ -267,9 +267,9 @@ begin
for k := 0 to 3 do
cb[j*4+k] := b[j][k];
permute(@pcb, @cb, @perm5, 32);
permute(@pcb[0], @cb[0], @perm5[0], 32);
mxor(@r2, @l, @pcb, 32);
mxor(@r2[0], @l[0], @pcb[0], 32);
for j := 0 to 31 do
begin
@ -278,9 +278,9 @@ begin
end;
end;
concat(@rl, @r, @l, 32, 32);
concat(@rl[0], @r[0], @l[0], 32, 32);
permute(_out, @rl, @perm6, 64);
permute(_out, @rl[0], @perm6[0], 64);
end;
procedure str_to_key({in} const str: PByte; {out} const key: PByte);
@ -307,7 +307,7 @@ var
keyb : array[0..63] of Byte;
key2 : array[0..7] of Byte;
begin
str_to_key(key, @key2);
str_to_key(key, @key2[0]);
for i := 0 to 63 do
begin
@ -316,7 +316,7 @@ begin
outb[i] := 0;
end;
dohash(@outb, @inb, @keyb, forw);
dohash(@outb[0], @inb[0], @keyb[0], forw);
for i := 0 to 7 do
_out[I] := 0;
@ -332,8 +332,8 @@ procedure E_P16({in} const p14: PByte; {out} const p16: PByte);
const
sp8: array[0..7] of Byte = ($4b, $47, $53, $21, $40, $23, $24, $25);
begin
smbhash(@p16[0], @sp8, @p14[0], True);
smbhash(@p16[8], @sp8, @p14[7], True);
smbhash(@p16[0], @sp8[0], @p14[0], True);
smbhash(@p16[8], @sp8[0], @p14[7], True);
end;
procedure E_P24({in} const p21: PByte; {in} const c8: PByte; {out} const p24: PByte);
@ -353,38 +353,41 @@ end;
* Creates the MD4 Hash of the users password in NT UNICODE.
*)
procedure E_md4hash({in} const pwd: PByte; {out} const p16: PByte);
procedure E_md4hash({in} const pwd: PChar; {out} const p16: PByte);
var
len : Integer;
wpwd : array[0..128] of Word;
len, pos: Integer;
wpwd : array[0..255] of Byte;
begin
FillChar(wpwd, Sizeof(wpwd), 0);
(* Password must be converted to NT unicode - null terminated *)
len := 0;
while (len < 128) and (pwd[len] <> 0) do
pos := 0;
while (len < 256) and (pwd[pos] <> #0) do
begin
wpwd[len] := pwd[len];
Inc(len);
wpwd[len] := byte(pwd[pos]);
inc(len);
wpwd[len] := 0;
inc(pos);
end;
mdfour(p16, @wpwd[0], 2*len);
mdfour(p16, @wpwd[0], len);
FillChar(wpwd, Sizeof(wpwd), 0);
end;
procedure E_deshash({in} const pwd: PByte; {out} const p16: PByte);
procedure E_deshash({in} const pwd: PChar; {out} const p16: PByte);
var
dospwd: array[0..14] of Byte;
begin
FillChar(dospwd, Sizeof(dospwd), 0);
(* Password must be converted to DOS charset - null terminated, uppercase *)
StrLCopy(@dospwd, @pwd[0], Sizeof(dospwd)-1);
StrUpper(@dospwd);
StrLCopy(pchar(@dospwd[0]), pchar(@pwd[0]), Sizeof(dospwd)-1);
StrUpper(pchar(@dospwd[0]));
(* ONly the first 14 chars are considered, password need not be null terminated *)
E_P16(@dospwd, p16);
E_P16(@dospwd[0], p16);
FillChar(dospwd, Sizeof(dospwd), 0);
end;
@ -403,11 +406,11 @@ begin
(* Calculate the MD4 hash (NT compatible) of the password *)
FillChar(nt_p16, Sizeof(nt_p16), 0);
E_md4hash(@passwd, @nt_p16);
E_md4hash(@passwd[0], @nt_p16[0]);
(* Calculate the SMB (lanman) hash functions of the password *)
FillChar(lm_p16, Sizeof(lm_p16), 0);
E_deshash(@passwd, @lm_p16);
E_deshash(@passwd[0], @lm_p16[0]);
(* clear out local copy of user's password (just being paranoid). *)
FillChar(passwd, Sizeof(passwd), 0);

22
packages/extra/md4/md4.pas
View File

@ -41,7 +41,7 @@ implementation
procedure mdfour({out} var _out: TMD4Hash; {in} _in: PByte; {in} n: Integer);
begin
mdfour(@_out, _in, n);
mdfour(@_out[0], _in, n);
end;
@ -167,8 +167,8 @@ begin
while n > 64 do
begin
copy64(@M, _in);
mdfour64(@M);
copy64(@M[0], _in);
mdfour64(@M[0]);
Inc(_in, 64);
Dec(n, 64);
end;
@ -180,18 +180,18 @@ begin
if n <= 55 then
begin
copy4(@buf[56], bb);
copy64(@M, @buf);
mdfour64(@M);
copy64(@M[0], @buf[0]);
mdfour64(@M[0]);
end else begin
copy4(@buf[120], bb);
copy64(@M, @buf);
mdfour64(@M);
copy64(@M, @buf[64]);
mdfour64(@M);
copy64(@M[0], @buf[0]);
mdfour64(@M[0]);
copy64(@M[0], @buf[64]);
mdfour64(@M[0]);
end;
FillChar(buf, sizeof(buf), 0);
copy64(@M, @buf);
copy64(@M[0], @buf[0]);
copy4(@_out[0], A);
copy4(@_out[4], B);
@ -199,4 +199,4 @@ begin
copy4(@_out[12], D);
end;
end.
end.

7
packages/extra/uuid/uuid.pp
View File

@ -36,6 +36,7 @@ Type
dma : byte;
port : byte;
end;
PIFrec = ^TIFrec;
TIFrec = record
ifr_ifrn : tifr_ifrn;
case integer of
@ -94,7 +95,7 @@ var
buf : Array[0..1023] of byte;
ifc : TIfConf;
ifr : TIFRec;
ifp : ^TIFRec;
ifp : PIFRec;
p : PChar;
begin
Result:=MacAddrTried>0;
@ -115,7 +116,7 @@ begin
i:=0;
While (Not Result) and (I<N) do
begin
ifp:=@PByte(ifc.ifcu_buf)[i];
ifp:=PIFRec(PByte(ifc.ifcu_buf)+i);
move(ifp^.ifr_ifrn.ifrn_name,ifr.ifr_ifrn.ifrn_name,IF_NAMESIZE);
if (fpioctl(sd, SIOCGIFHWADDR, @ifr) >= 0) then
begin
@ -192,7 +193,7 @@ Var
P : PByte;
begin
P:=@GUID;
P:=PByte(@GUID);
tmp:=uu.time_low;
P[3]:=tmp and $FF;

18
packages/extra/x11/xkb.pp
View File

@ -1797,7 +1797,7 @@ type
function XkbShapeDoodadColor (g : PXkbGeometryPtr; d : PXkbShapeDoodadPtr) : PXkbColorPtr;
function XkbShapeDoodadShape (g : PXkbGeometryPtr; d : PXkbShapeDoodadPtr) : PXkbShapePtr;
procedure XkbSetShapeDoodadColor (g : PXkbGeometryPtr; d : PXkbShapeDoodadPtr; c : PXkbColorPtr);
procedure XkbSetShapeDoodadShape (g : PXkbGeometryPtr; d : PXkbShapeDoodadPtr; s : PXkbShapeDoodadPtr);
procedure XkbSetShapeDoodadShape (g : PXkbGeometryPtr; d : PXkbShapeDoodadPtr; s : PXkbShapePtr);
function XkbTextDoodadColor (g : PXkbGeometryPtr; d : PXkbTextDoodadPtr) : PXkbColorPtr;
procedure XkbSetTextDoodadColor (g : PXkbGeometryPtr; d : PXkbTextDoodadPtr; c : PXkbColorPtr);
@ -2740,10 +2740,10 @@ begin
d^.color_ndx := c - @g^.colors [0];
end;
procedure XkbSetShapeDoodadShape (g : PXkbGeometryPtr; d : PXkbShapeDoodadPtr; s : PXkbShapeDoodadPtr);
procedure XkbSetShapeDoodadShape (g : PXkbGeometryPtr; d : PXkbShapeDoodadPtr; s : PXkbShapePtr);
begin
{#define XkbSetShapeDoodadShape(g,d,s) ((d)->shape_ndx= (s)-&(g)->shapes[0])}
d^.shape_ndx := s - @g^.shapes [0];
d^.shape_ndx := PXkbShapePtr(s) - @g^.shapes [0];
end;
function XkbTextDoodadColor (g : PXkbGeometryPtr; d : PXkbTextDoodadPtr) : PXkbColorPtr;
@ -2761,7 +2761,7 @@ end;
function XkbIndicatorDoodadShape (g : PXkbGeometryPtr; d : PXkbIndicatorDoodadPtr) : PXkbShapeDoodadPtr;
begin
{#define XkbIndicatorDoodadShape(g,d) (&(g)->shapes[(d)->shape_ndx])}
Result := @g^.shapes [d^.shape_ndx];
Result := PXkbShapeDoodadPtr(@g^.shapes [d^.shape_ndx]);
end;
function XkbIndicatorDoodadOnColor (g : PXkbGeometryPtr; d : PXkbIndicatorDoodadPtr) : PXkbColorPtr;
@ -2794,7 +2794,7 @@ procedure XkbSetIndicatorDoodadShape (g : PXkbGeometryPtr; d : PXkbIndicatorDood
s : PXkbShapeDoodadPtr);
begin
{#define XkbSetIndicatorDoodadShape(g,d,s) ((d)->shape_ndx= (s)-&(g)->shapes[0])}
d^.shape_ndx := s - @g^.shapes [0];
d^.shape_ndx := PXkbShapePtr(s) - @g^.shapes [0];
end;
function XkbLogoDoodadColor (g : PXkbGeometryPtr; d : PXkbLogoDoodadPtr) : PXkbColorPtr;
@ -2806,7 +2806,7 @@ end;
function XkbLogoDoodadShape (g : PXkbGeometryPtr; d : PXkbLogoDoodadPtr) : PXkbShapeDoodadPtr;
begin
{#define XkbLogoDoodadShape(g,d) (&(g)->shapes[(d)->shape_ndx])}
Result := @g^.shapes [d^.shape_ndx];
Result := PXkbShapeDoodadPtr(@g^.shapes [d^.shape_ndx]);
end;
procedure XkbSetLogoDoodadColor (g : PXkbGeometryPtr; d : PXkbLogoDoodadPtr; c : PXkbColorPtr);
@ -2818,13 +2818,13 @@ end;
procedure XkbSetLogoDoodadShape (g : PXkbGeometryPtr; d : PXkbLogoDoodadPtr; s : PXkbShapeDoodadPtr);
begin
{#define XkbSetLogoDoodadShape(g,d,s) ((d)->shape_ndx= (s)-&(g)->shapes[0])}
d^.shape_ndx := s - @g^.shapes [0];
d^.shape_ndx := PXkbShapePtr(s) - @g^.shapes [0];
end;
function XkbKeyShape (g : PXkbGeometryPtr; k : PXkbKeyPtr) : PXkbShapeDoodadPtr;
begin
{#define XkbKeyShape(g,k) (&(g)->shapes[(k)->shape_ndx])}
Result := @g^.shapes [k^.shape_ndx];
Result := PXkbShapeDoodadPtr(@g^.shapes [k^.shape_ndx]);
end;
function XkbKeyColor (g : PXkbGeometryPtr; k : PXkbKeyPtr) : PXkbColorPtr;
@ -2836,7 +2836,7 @@ end;
procedure XkbSetKeyShape (g : PXkbGeometryPtr; k : PXkbKeyPtr; s : PXkbShapeDoodadPtr);
begin
{#define XkbSetKeyShape(g,k,s) ((k)->shape_ndx= (s)-&(g)->shapes[0])}
k^.shape_ndx := s - @g^.shapes [0];
k^.shape_ndx := PXkbShapePtr(s) - @g^.shapes [0];
end;
procedure XkbSetKeyColor (g : PXkbGeometryPtr; k : PXkbKeyPtr; c : PXkbColorPtr);

6
rtl/inc/dynarr.inc
View File

@ -340,18 +340,18 @@ function fpc_dynarray_copy(psrc : pointer;ti : pointer;
procedure DynArraySetLength(var a: Pointer; typeInfo: Pointer; dimCnt: SizeInt; lengthVec: PSizeInt);
var
preallocated : array[0..10] of PSizeInt;
preallocated : array[0..10] of SizeInt;
i : SizeInt;
p : PSizeInt;
begin
if dimCnt<=high(preallocated)+1 then
p:=@preallocated
p:=@preallocated[0]
else
getmem(p,sizeof(SizeInt)*dimCnt);
for i:=0 to dimCnt-1 do
p[i]:=lengthVec[dimCnt-1-i];
int_dynarray_setlength(a,typeInfo,dimCnt,p);
if p<>@preallocated then
if p<>@preallocated[0] then
freemem(p);
end;

8
rtl/inc/mouse.inc
View File

@ -25,8 +25,8 @@ Var
Procedure ClearMouseEventQueue;
begin
PendingMouseHead:=@PendingMouseEvent;
PendingMouseTail:=@PendingMouseEvent;
PendingMouseHead:=@PendingMouseEvent[0];
PendingMouseTail:=@PendingMouseEvent[0];
PendingMouseEvents:=0;
FillChar(LastMouseEvent,sizeof(TMouseEvent),0);
end;
@ -119,7 +119,7 @@ begin
MouseEvent:=PendingMouseHead^;
inc(PendingMouseHead);
if PtrInt(PendingMouseHead)=Ptrint(@PendingMouseEvent)+sizeof(PendingMouseEvent) then
PendingMouseHead:=@PendingMouseEvent;
PendingMouseHead:=@PendingMouseEvent[0];
dec(PendingMouseEvents);
if (LastMouseEvent.x<>MouseEvent.x) or
(LastMouseEvent.y<>MouseEvent.y) then
@ -162,7 +162,7 @@ begin
PendingMouseTail^:=MouseEvent;
inc(PendingMouseTail);
if PtrInt(PendingMouseTail)=Ptrint(@PendingMouseEvent)+sizeof(PendingMouseEvent) then
PendingMouseTail:=@PendingMouseEvent;
PendingMouseTail:=@PendingMouseEvent[0];
inc(PendingMouseEvents);
end
else

5
rtl/inc/objects.pp
View File

@ -981,13 +981,14 @@ END;
FUNCTION TObject.Is_Object(P:Pointer):Boolean;
TYPE
PVMT=^VMT;
PPVMT=^PVMT;
VMT=RECORD
Size,NegSize:Longint;
ParentLink:PVMT;
END;
VAR SP:^PVMT; Q:PVMT;
VAR SP:PPVMT; Q:PVMT;
BEGIN
SP:=@SELF;
SP:=PPVMT(@SELF);
Q:=SP^;
Is_Object:=False;
While Q<>Nil Do Begin

4
rtl/inc/objpas.inc
View File

@ -304,7 +304,7 @@
FieldTable := PFieldTable((Pointer(CurClassType) + vmtFieldTable)^);
if FieldTable <> nil then
begin
FieldInfo := @FieldTable^.Fields;
FieldInfo := @FieldTable^.Fields[0];
for i := 0 to FieldTable^.FieldCount - 1 do
begin
if UpCase(FieldInfo^.Name) = UName then
@ -312,7 +312,7 @@
fieldaddress := Pointer(Self) + FieldInfo^.FieldOffset;
exit;
end;
FieldInfo := @FieldInfo^.Name + 1 + Length(FieldInfo^.Name);
FieldInfo := PFieldInfo(PByte(@FieldInfo^.Name) + 1 + Length(FieldInfo^.Name));
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
{ align to largest field of TFieldInfo }
FieldInfo := Align(FieldInfo, SizeOf(PtrUInt));

12
rtl/inc/sockovl.inc
View File

@ -42,7 +42,7 @@ end;
Function RecvFrom(Sock : Longint; Var Buf; Buflen,Flags : Longint; Var Addr ; var AddrLen :longint) : longint;
begin
RecvFrom:=fprecvfrom(Sock,@buf,buflen,flags,@Addr,@AddrLen);
RecvFrom:=fprecvfrom(Sock,@buf,buflen,flags,@Addr,psocklen(@AddrLen));
end;
Function Bind(Sock:Longint;Const Addr;AddrLen:Longint):Boolean;
@ -57,7 +57,7 @@ end;
Function Accept(Sock:Longint;Var Addr;Var Addrlen:Longint):Longint;
begin
Accept:=fpaccept(sock,@addr,@addrlen);
Accept:=fpaccept(sock,@addr,psocklen(@addrlen));
end;
Function Connect(Sock:Longint;Const Addr;Addrlen:Longint): boolean;
@ -73,12 +73,12 @@ end;
Function GetSocketName(Sock:Longint;Var Addr;Var Addrlen:Longint):Longint;
begin
GetSocketName:=fpgetsockname(sock,@addr,@addrlen);
GetSocketName:=fpgetsockname(sock,@addr,psocklen(@addrlen));
end;
Function GetPeerName(Sock:Longint;Var Addr;Var Addrlen:Longint):Longint;
begin
GetPeerName:=fpgetPeerName(sock,@addr,@addrlen);
GetPeerName:=fpgetPeerName(sock,@addr,psocklen(@addrlen));
end;
Function SetSocketOptions(Sock,Level,OptName:Longint;const OptVal;optlen:longint):Longint;
@ -88,12 +88,12 @@ end;
Function GetSocketOptions(Sock,Level,OptName:Longint;Var OptVal;Var optlen:longint):Longint;
begin
GetSocketOptions:=fpgetsockopt(Sock,Level,OptName,@OptVal,@OptLen);
GetSocketOptions:=fpgetsockopt(Sock,Level,OptName,@OptVal,psocklen(@OptLen));
end;
Function SocketPair(Domain,SocketType,Protocol:Longint;var Pair:TSockArray):Longint;
begin
SocketPair:=fpsocketpair(domain,sockettype,protocol,@pair);
SocketPair:=fpsocketpair(domain,sockettype,protocol,@pair[1]);
end;
{******************************************************************************

2
rtl/inc/text.inc
View File

@ -939,7 +939,7 @@ Begin
inc(p);}
while p<maxp do
begin
q:=@stop_chars;
q:=@stop_chars[0];
while (q^<>#0) and (p^<>q^) do
inc(q);
if p^=q^ then

2
rtl/linux/gpm.pp
View File

@ -534,7 +534,7 @@ begin
strcopy(addr.path, GPM_NODE_CTL);
i:=sizeof(addr.family)+length(GPM_NODE_CTL);
if fpconnect(gpm_fd,@addr,i)<0 then
if fpconnect(gpm_fd,psockaddr(@addr),i)<0 then
begin
{ gpm_report(GPM_PR_INFO,GPM_MESS_DOUBLE_S,GPM_NODE_CTL,strerror(errno));}
{Well, try to open a chr device called /dev/gpmctl. This should

28
rtl/linux/oldlinux.pp
View File

@ -2792,7 +2792,7 @@ begin
sr.reg2:=Textrec(F).Handle;
SysCall (syscall_nr_close,sr);
{ closed our side, Now wait for the other - this appears to be needed ?? }
pl:=@(textrec(f).userdata[2]);
pl:=plongint(@(textrec(f).userdata[2]));
waitpid(pl^,@res,0);
pclose:=res shr 8;
end;
@ -2807,7 +2807,7 @@ begin
sr.reg2:=FileRec(F).Handle;
SysCall (Syscall_nr_close,sr);
{ closed our side, Now wait for the other - this appears to be needed ?? }
pl:=@(filerec(f).userdata[2]);
pl:=plongint(@(filerec(f).userdata[2]));
waitpid(pl^,@res,0);
pclose:=res shr 8;
end;
@ -4516,7 +4516,7 @@ begin
textrec(f).bufptr:=@textrec(f).buffer;
end;
{Save the process ID - needed when closing }
pl:=@(textrec(f).userdata[2]);
pl:=plongint(@(textrec(f).userdata[2]));
pl^:=pid;
textrec(f).closefunc:=@PCloseText;
end;
@ -4602,7 +4602,7 @@ begin
f:=pipi;
end;
{Save the process ID - needed when closing }
pl:=@(filerec(f).userdata[2]);
pl:=plongint(@(filerec(f).userdata[2]));
pl^:=pid;
end;
end;
@ -4666,11 +4666,11 @@ begin
close(pipo);
close(pipi);
{Save the process ID - needed when closing }
pl:=@(textrec(StreamIn).userdata[2]);
pl:=plongint(@(textrec(StreamIn).userdata[2]));
pl^:=pid;
textrec(StreamIn).closefunc:=@PCloseText;
{Save the process ID - needed when closing }
pl:=@(textrec(StreamOut).userdata[2]);
pl:=plongint(@(textrec(StreamOut).userdata[2]));
pl^:=pid;
textrec(StreamOut).closefunc:=@PCloseText;
AssignStream:=Pid;
@ -4757,15 +4757,15 @@ begin
Close(PipeOut);
Close(PipeIn);
// Save the process ID - needed when closing
pl := @(TextRec(StreamIn).userdata[2]);
pl := plongint(@(TextRec(StreamIn).userdata[2]));
pl^ := pid;
TextRec(StreamIn).closefunc := @PCloseText;
// Save the process ID - needed when closing
pl := @(TextRec(StreamOut).userdata[2]);
pl := plongint(@(TextRec(StreamOut).userdata[2]));
pl^ := pid;
TextRec(StreamOut).closefunc := @PCloseText;
// Save the process ID - needed when closing
pl := @(TextRec(StreamErr).userdata[2]);
pl := plongint(@(TextRec(StreamErr).userdata[2]));
pl^ := pid;
TextRec(StreamErr).closefunc := @PCloseText;
AssignStream := pid;
@ -5059,15 +5059,15 @@ var
d:=Readdir(dirstream);
while (d<>nil) do
begin
name:=n+'/'+strpas(@(d^.name));
name:=n+'/'+strpas(@(d^.name[0]));
fstat(name,st);
if linuxerror=0 then
begin
if ((st.mode and $E000)=$4000) and { if it is a directory }
(strpas(@(d^.name))<>'.') and { but not ., .. and fd subdirs }
(strpas(@(d^.name))<>'..') and
(strpas(@(d^.name))<>'') and
(strpas(@(d^.name))<>'fd') then
(strpas(@(d^.name[0]))<>'.') and { but not ., .. and fd subdirs }
(strpas(@(d^.name[0]))<>'..') and
(strpas(@(d^.name[0]))<>'') and
(strpas(@(d^.name[0]))<>'fd') then
begin {we found a directory, search inside it}
if mysearch(name) then
begin {the device is here}

6
rtl/linux/unxfunc.inc
View File

@ -33,13 +33,13 @@ end;
Function PClose(Var F:text) :cint;
var
pl : ^cint;
pl : pcint;
res : cint;
pid : cint;
begin
fpclose(Textrec(F).Handle);
{ closed our side, Now wait for the other - this appears to be needed ?? }
pl:=@(textrec(f).userdata[2]);
pl:=pcint(@(textrec(f).userdata[2]));
{ avoid alignment error on sparc }
move(pl^,pid,sizeof(pid));
fpwaitpid(pid,@res,0);
@ -54,7 +54,7 @@ var
begin
fpclose(filerec(F).Handle);
{ closed our side, Now wait for the other - this appears to be needed ?? }
pl:=@(filerec(f).userdata[2]);
pl:=pcint(@(filerec(f).userdata[2]));
{ avoid alignment error on sparc }
move(pl^,pid,sizeof(pid));
fpwaitpid(pid,@res,0);

4
rtl/objpas/sysutils/dati.inc
View File

@ -707,10 +707,10 @@ begin
DecodeDateFully(DateTime, Year, Month, Day, DayOfWeek);
DecodeTime(DateTime, Hour, Minute, Second, MilliSecond);
ResultLen := 0;
ResultCurrent := @ResultBuffer;
ResultCurrent := @ResultBuffer[0];
StoreFormat(FormatStr);
ResultBuffer[ResultLen] := #0;
result := StrPas(@ResultBuffer);
result := StrPas(@ResultBuffer[0]);
end ;
{ DateTimeToString formats DateTime to the given format in FormatStr }

2
rtl/objpas/sysutils/sysstr.inc
View File

@ -1937,7 +1937,7 @@ Var
Begin
Buf[FloatToTextFmt(@Buf[0],Value,Pchar(Format))]:=#0;
Result:=StrPas(@Buf);
Result:=StrPas(@Buf[0]);
End;
function FormatCurr(const Format: string; Value: Currency): string;

9
rtl/objpas/sysutils/sysuintf.inc
View File

@ -73,19 +73,20 @@ function StringToGUID(const S: string): TGUID;
end;
end;
function HexByte(p: PChar): Char;
function HexByte(p: PChar): Byte;
begin
Result:=Char((HexChar(p[0]) shl 4) + HexChar(p[1]));
Result:=(HexChar(p[0]) shl 4) + HexChar(p[1]);
end;
var
i: integer;
src, dest: PChar;
src: PChar;
dest: PByte;
begin
if ((Length(S)<>38) or
(s[1]<>'{')) then
raise EConvertError.CreateFmt(SInvalidGUID, [s]);
dest:=@Result;
dest:=PByte(@Result);
src:=PChar(s);
inc(src);
for i:=0 to 3 do

2
rtl/objpas/typinfo.pp
View File

@ -501,7 +501,7 @@ begin
hp:=GetTypeData(Typeinfo);
// the class info rtti the property rtti follows immediatly
pd:=aligntoptr(pointer(pointer(@hp^.UnitName)+Length(hp^.UnitName)+1));
Result:=@pd^.PropList;
Result:=PPropInfo(@pd^.PropList);
for i:=1 to pd^.PropCount do
begin
// found a property of that name ?

2
rtl/unix/cthreads.pp
View File

@ -227,7 +227,7 @@ Type PINTRTLEvent = ^TINTRTLEvent;
// don't create detached, we need to be able to join (waitfor) on
// the newly created thread!
//pthread_attr_setdetachstate(@thread_attr, PTHREAD_CREATE_DETACHED);
if pthread_create(@threadid, @thread_attr, @ThreadMain,ti) <> 0 then begin
if pthread_create(ppthread_t(@threadid), @thread_attr, @ThreadMain,ti) <> 0 then begin
threadid := TThreadID(0);
end;
CBeginThread:=threadid;

6
rtl/unix/cwstring.pp
View File

@ -153,7 +153,7 @@ procedure Wide2AnsiMove(source:pwidechar;var dest:ansistring;len:SizeInt);
destpos:=pchar(dest);
outleft:=outlength;
lockiconv(lock_wide2ansi);
while iconv(iconv_wide2ansi,@srcpos,@srclen,@destpos,@outleft)=size_t(-1) do
while iconv(iconv_wide2ansi,ppchar(@srcpos),@srclen,@destpos,@outleft)=size_t(-1) do
begin
case fpgetCerrno of
ESysEILSEQ:
@ -210,7 +210,7 @@ procedure Ansi2WideMove(source:pchar;var dest:widestring;len:SizeInt);
destpos:=pchar(dest);
outleft:=outlength*2;
lockiconv(lock_ansi2wide);
while iconv(iconv_ansi2wide,@srcpos,@len,@destpos,@outleft)=size_t(-1) do
while iconv(iconv_ansi2wide,@srcpos,psize(@len),@destpos,@outleft)=size_t(-1) do
begin
case fpgetCerrno of
ESysEILSEQ:
@ -286,7 +286,7 @@ procedure Ansi2UCS4Move(source:pchar;var dest:UCS4String;len:SizeInt);
destpos:=pchar(dest);
outleft:=outlength*4;
lockiconv(lock_ansi2ucs4);
while iconv(iconv_ansi2ucs4,@srcpos,@len,@destpos,@outleft)=size_t(-1) do
while iconv(iconv_ansi2ucs4,@srcpos,psize(@len),@destpos,@outleft)=size_t(-1) do
begin
case fpgetCerrno of
ESysE2BIG:

10
rtl/unix/dos.pp
View File

@ -648,7 +648,7 @@ Begin
Move(f.SearchSpec[1], DirName[0], f.NamePos);
DirName[f.NamePos] := #0;
End;
f.DirPtr := fpopendir(@(DirName));
f.DirPtr := fpopendir(@DirName[0]);
If f.DirPtr <> nil Then
begin
ArrayPos:=FindLastUsed;
@ -673,7 +673,7 @@ Begin
if p=nil then
FName:=''
else
FName:=Strpas(@p^.d_name);
FName:=Strpas(@p^.d_name[0]);
If FName='' Then
Finished:=True
Else
@ -767,7 +767,7 @@ Var
LinAttr : longint;
Begin
DosError:=0;
if FPStat(@textrec(f).name,info)<0 then
if FPStat(@textrec(f).name[0],info)<0 then
begin
Attr:=0;
DosError:=3;
@ -779,7 +779,7 @@ Begin
Attr:=$10
else
Attr:=$0;
if fpAccess(@textrec(f).name,W_OK)<0 then
if fpAccess(@textrec(f).name[0],W_OK)<0 then
Attr:=Attr or $1;
if filerec(f).name[0]='.' then
Attr:=Attr or $2;
@ -816,7 +816,7 @@ Begin
UnPackTime(Time,DT);
modtime:=DTToUnixDate(DT);
end;
if fputime(@filerec(f).name,@utim)<0 then
if fputime(@filerec(f).name[0],@utim)<0 then
begin
Time:=0;
doserror:=3;

8
rtl/unix/sysdir.inc
View File

@ -32,7 +32,7 @@ Begin
exit;
Move(s[1], Buffer, Length(s));
Buffer[Length(s)] := #0;
If Fpmkdir(@buffer, MODE_MKDIR)<0 Then
If Fpmkdir(@buffer[0], MODE_MKDIR)<0 Then
Errno2Inoutres
Else
InOutRes:=0;
@ -49,7 +49,7 @@ Begin
exit;
Move(s[1], Buffer, Length(s));
Buffer[Length(s)] := #0;
If Fprmdir(@buffer)<0 Then
If Fprmdir(@buffer[0])<0 Then
Errno2Inoutres
Else
InOutRes:=0;
@ -64,7 +64,7 @@ Begin
exit;
Move(s[1], Buffer, Length(s));
Buffer[Length(s)] := #0;
If Fpchdir(@buffer)<0 Then
If Fpchdir(@buffer[0])<0 Then
Errno2Inoutres
Else
InOutRes:=0;
@ -93,7 +93,7 @@ var
begin
dir:='';
{$ifdef usegetcwd}
if Fpgetcwd(@buf,sizeof(buf))<>nil then
if Fpgetcwd(@buf[0],sizeof(buf))<>nil then
dir:=strpas(buf);
{$else}
thedir:='';

14
rtl/unix/unix.pp
View File

@ -858,7 +858,7 @@ begin
end;
textrec(f).bufptr:=@textrec(f).buffer;
{Save the process ID - needed when closing }
pl:=@(textrec(f).userdata[2]);
pl:=pcint(@textrec(f).userdata[2]);
{ avoid alignment error on sparc }
move(pid,pl^,sizeof(pid));
textrec(f).closefunc:=@PCloseText;
@ -972,7 +972,7 @@ begin
f:=pipi;
end;
{Save the process ID - needed when closing }
pl:=@(filerec(f).userdata[2]);
pl:=pcint(@filerec(f).userdata[2]);
{ avoid alignment error on sparc }
move(pid,pl^,sizeof(pid));
end;
@ -1036,12 +1036,12 @@ begin
close(pipo);
close(pipi);
{Save the process ID - needed when closing }
pl:=@(textrec(StreamIn).userdata[2]);
pl:=pcint(@textrec(StreamIn).userdata[2]);
{ avoid alignment error on sparc }
move(pid,pl^,sizeof(pid));
textrec(StreamIn).closefunc:=@PCloseText;
{Save the process ID - needed when closing }
pl:=@(textrec(StreamOut).userdata[2]);
pl:=pcint(@textrec(StreamOut).userdata[2]);
{ avoid alignment error on sparc }
move(pid,pl^,sizeof(pid));
textrec(StreamOut).closefunc:=@PCloseText;
@ -1128,17 +1128,17 @@ begin
Close(PipeOut);
Close(PipeIn);
// Save the process ID - needed when closing
pl := @(TextRec(StreamIn).userdata[2]);
pl := pcint(@TextRec(StreamIn).userdata[2]);
{ avoid alignment error on sparc }
move(pid,pl^,sizeof(pid));
TextRec(StreamIn).closefunc := @PCloseText;
// Save the process ID - needed when closing
pl := @(TextRec(StreamOut).userdata[2]);
pl := pcint(@TextRec(StreamOut).userdata[2]);
{ avoid alignment error on sparc }
move(pid,pl^,sizeof(pid));
TextRec(StreamOut).closefunc := @PCloseText;
// Save the process ID - needed when closing
pl := @(TextRec(StreamErr).userdata[2]);
pl := pcint(@TextRec(StreamErr).userdata[2]);
{ avoid alignment error on sparc }
move(pid,pl^,sizeof(pid));
TextRec(StreamErr).closefunc := @PCloseText;

2
rtl/win/sockets.pp
View File

@ -284,7 +284,7 @@ end;
Function SocketPair(Domain,SocketType,Protocol:Longint;var Pair:TSockArray):Longint;
begin
SocketPair:=fpsocketpair(domain,sockettype,protocol,@pair);
SocketPair:=fpsocketpair(domain,sockettype,protocol,@pair[1]);
end;
{$ifdef unix}

10
rtl/win/sysutils.pp
View File

@ -310,7 +310,7 @@ begin
WinToDosTime(F.FindData.ftLastWriteTime,F.Time);
f.size:=F.FindData.NFileSizeLow;
f.attr:=F.FindData.dwFileAttributes;
f.Name:=StrPas(@F.FindData.cFileName);
f.Name:=StrPas(@F.FindData.cFileName[0]);
Result:=0;
end;
@ -435,14 +435,14 @@ begin
end;
if assigned(GetDiskFreeSpaceEx) then
begin
if GetDiskFreeSpaceEx(@disk,qwcaller,qwtotal,qwfree) then
if GetDiskFreeSpaceEx(@disk[1],qwcaller,qwtotal,qwfree) then
diskfree:=qwfree
else
diskfree:=-1;
end
else
begin
if GetDiskFreeSpace(@disk,secs,bytes,free,total) then
if GetDiskFreeSpace(@disk[1],secs,bytes,free,total) then
diskfree:=int64(free)*secs*bytes
else
diskfree:=-1;
@ -471,14 +471,14 @@ begin
end;
if assigned(GetDiskFreeSpaceEx) then
begin
if GetDiskFreeSpaceEx(@disk,qwcaller,qwtotal,qwfree) then
if GetDiskFreeSpaceEx(@disk[1],qwcaller,qwtotal,qwfree) then
disksize:=qwtotal
else
disksize:=-1;
end
else
begin
if GetDiskFreeSpace(@disk,secs,bytes,free,total) then
if GetDiskFreeSpace(@disk[1],secs,bytes,free,total) then
disksize:=int64(total)*secs*bytes
else
disksize:=-1;

2
rtl/win/wininc/ascdef.inc
View File

@ -138,7 +138,7 @@ function OpenEventLog(lpUNCServerName:LPCSTR; lpSourceName:LPCSTR):HANDLE; exter
function RegisterEventSource(lpUNCServerName:LPCSTR; lpSourceName:LPCSTR):HANDLE; external 'advapi32' name 'RegisterEventSourceA';
function OpenBackupEventLog(lpUNCServerName:LPCSTR; lpFileName:LPCSTR):HANDLE; external 'advapi32' name 'OpenBackupEventLogA';
function ReadEventLog(hEventLog:HANDLE; dwReadFlags:DWORD; dwRecordOffset:DWORD; lpBuffer:LPVOID; nNumberOfBytesToRead:DWORD;pnBytesRead:LPDWORD; pnMinNumberOfBytesNeeded:LPDWORD):WINBOOL; external 'advapi32' name 'ReadEventLogA';
function ReportEvent(hEventLog:HANDLE; wType:WORD; wCategory:WORD; dwEventID:DWORD; lpUserSid:PSID;wNumStrings:WORD; dwDataSize:DWORD; lpStrings:LPCSTR; lpRawData:LPVOID):WINBOOL; external 'advapi32' name 'ReportEventA';
function ReportEvent(hEventLog:HANDLE; wType:WORD; wCategory:WORD; dwEventID:DWORD; lpUserSid:PSID;wNumStrings:WORD; dwDataSize:DWORD; lpStrings:LPPCSTR; lpRawData:LPVOID):WINBOOL; external 'advapi32' name 'ReportEventA';
function AccessCheckAndAuditAlarm(SubsystemName:LPCSTR; HandleId:LPVOID; ObjectTypeName:LPSTR; ObjectName:LPSTR; SecurityDescriptor:PSECURITY_DESCRIPTOR;DesiredAccess:DWORD; GenericMapping:PGENERIC_MAPPING;
ObjectCreation:WINBOOL; GrantedAccess:LPDWORD;AccessStatus:LPBOOL;pfGenerateOnClose:LPBOOL):WINBOOL; external 'advapi32' name 'AccessCheckAndAuditAlarmA';
function ObjectOpenAuditAlarm(SubsystemName:LPCSTR; HandleId:LPVOID; ObjectTypeName:LPSTR; ObjectName:LPSTR; pSecurityDescriptor:PSECURITY_DESCRIPTOR;ClientToken:HANDLE; DesiredAccess:DWORD; GrantedAccess:DWORD;

2
rtl/win/wininc/ascfun.inc
View File

@ -137,7 +137,7 @@ function OpenEventLogA(lpUNCServerName:LPCSTR; lpSourceName:LPCSTR):HANDLE; exte
function RegisterEventSourceA(lpUNCServerName:LPCSTR; lpSourceName:LPCSTR):HANDLE; external 'advapi32' name 'RegisterEventSourceA';
function OpenBackupEventLogA(lpUNCServerName:LPCSTR; lpFileName:LPCSTR):HANDLE; external 'advapi32' name 'OpenBackupEventLogA';
function ReadEventLogA(hEventLog:HANDLE; dwReadFlags:DWORD; dwRecordOffset:DWORD; lpBuffer:LPVOID; nNumberOfBytesToRead:DWORD;pnBytesRead:LPDWORD; pnMinNumberOfBytesNeeded:LPDWORD):WINBOOL; external 'advapi32' name 'ReadEventLogA';
function ReportEventA(hEventLog:HANDLE; wType:WORD; wCategory:WORD; dwEventID:DWORD; lpUserSid:PSID;wNumStrings:WORD; dwDataSize:DWORD; lpStrings:LPCSTR; lpRawData:LPVOID):WINBOOL; external 'advapi32' name 'ReportEventA';
function ReportEventA(hEventLog:HANDLE; wType:WORD; wCategory:WORD; dwEventID:DWORD; lpUserSid:PSID;wNumStrings:WORD; dwDataSize:DWORD; lpStrings:LPPCSTR; lpRawData:LPVOID):WINBOOL; external 'advapi32' name 'ReportEventA';
function AccessCheckAndAuditAlarmA(SubsystemName:LPCSTR; HandleId:LPVOID; ObjectTypeName:LPSTR; ObjectName:LPSTR; SecurityDescriptor:PSECURITY_DESCRIPTOR;DesiredAccess:DWORD; GenericMapping:PGENERIC_MAPPING;
ObjectCreation:WINBOOL; GrantedAccess:LPDWORD;AccessStatus:LPBOOL;pfGenerateOnClose:LPBOOL):WINBOOL; external 'advapi32' name 'AccessCheckAndAuditAlarmA';
function ObjectOpenAuditAlarmA(SubsystemName:LPCSTR; HandleId:LPVOID; ObjectTypeName:LPSTR; ObjectName:LPSTR; pSecurityDescriptor:PSECURITY_DESCRIPTOR;ClientToken:HANDLE; DesiredAccess:DWORD; GrantedAccess:DWORD;

4
rtl/win/wininc/base.inc
View File

@ -155,6 +155,10 @@
LPCWCH = Pwidechar;
LPCWSTR = Pwidechar;
LPPCSTR = ^LPCSTR;
LPPCTSTR = ^LPCTSTR;
LPPCWSTR = ^LPCWSTR;
LPDWORD = ^DWORD;
LPHANDLE = ^HANDLE;

2
rtl/win/wininc/unidef.inc
View File

@ -137,7 +137,7 @@ function OpenEventLog(lpUNCServerName:LPCWSTR; lpSourceName:LPCWSTR):HANDLE; ext
function RegisterEventSource(lpUNCServerName:LPCWSTR; lpSourceName:LPCWSTR):HANDLE; external 'advapi32' name 'RegisterEventSourceW';
function OpenBackupEventLog(lpUNCServerName:LPCWSTR; lpFileName:LPCWSTR):HANDLE; external 'advapi32' name 'OpenBackupEventLogW';
function ReadEventLog(hEventLog:HANDLE; dwReadFlags:DWORD; dwRecordOffset:DWORD; lpBuffer:LPVOID; nNumberOfBytesToRead:DWORD;pnBytesRead:LPDWORD; pnMinNumberOfBytesNeeded:LPDWORD):WINBOOL; external 'advapi32' name 'ReadEventLogW';
function ReportEvent(hEventLog:HANDLE; wType:WORD; wCategory:WORD; dwEventID:DWORD; lpUserSid:PSID;wNumStrings:WORD; dwDataSize:DWORD; lpStrings:LPCWSTR; lpRawData:LPVOID):WINBOOL; external 'advapi32' name 'ReportEventW';
function ReportEvent(hEventLog:HANDLE; wType:WORD; wCategory:WORD; dwEventID:DWORD; lpUserSid:PSID;wNumStrings:WORD; dwDataSize:DWORD; lpStrings:LPPCWSTR; lpRawData:LPVOID):WINBOOL; external 'advapi32' name 'ReportEventW';
function AccessCheckAndAuditAlarm(SubsystemName:LPCWSTR; HandleId:LPVOID; ObjectTypeName:LPWSTR; ObjectName:LPWSTR; SecurityDescriptor:PSECURITY_DESCRIPTOR;DesiredAccess:DWORD; GenericMapping:PGENERIC_MAPPING; ObjectCreation:WINBOOL;
GrantedAccess:LPDWORD; AccessStatus:LPBOOL;pfGenerateOnClose:LPBOOL):WINBOOL; external 'advapi32' name 'AccessCheckAndAuditAlarmW';
function ObjectOpenAuditAlarm(SubsystemName:LPCWSTR; HandleId:LPVOID; ObjectTypeName:LPWSTR; ObjectName:LPWSTR; pSecurityDescriptor:PSECURITY_DESCRIPTOR;ClientToken:HANDLE; DesiredAccess:DWORD; GrantedAccess:DWORD;

2
rtl/win/wininc/unifun.inc
View File

@ -137,7 +137,7 @@ function OpenEventLogW(lpUNCServerName:LPCWSTR; lpSourceName:LPCWSTR):HANDLE; ex
function RegisterEventSourceW(lpUNCServerName:LPCWSTR; lpSourceName:LPCWSTR):HANDLE; external 'advapi32' name 'RegisterEventSourceW';
function OpenBackupEventLogW(lpUNCServerName:LPCWSTR; lpFileName:LPCWSTR):HANDLE; external 'advapi32' name 'OpenBackupEventLogW';
function ReadEventLogW(hEventLog:HANDLE; dwReadFlags:DWORD; dwRecordOffset:DWORD; lpBuffer:LPVOID; nNumberOfBytesToRead:DWORD;pnBytesRead:LPDWORD; pnMinNumberOfBytesNeeded:LPDWORD):WINBOOL; external 'advapi32' name 'ReadEventLogW';
function ReportEventW(hEventLog:HANDLE; wType:WORD; wCategory:WORD; dwEventID:DWORD; lpUserSid:PSID;wNumStrings:WORD; dwDataSize:DWORD; lpStrings:LPCWSTR; lpRawData:LPVOID):WINBOOL; external 'advapi32' name 'ReportEventW';
function ReportEventW(hEventLog:HANDLE; wType:WORD; wCategory:WORD; dwEventID:DWORD; lpUserSid:PSID;wNumStrings:WORD; dwDataSize:DWORD; lpStrings:LPPCWSTR; lpRawData:LPVOID):WINBOOL; external 'advapi32' name 'ReportEventW';
function AccessCheckAndAuditAlarmW(SubsystemName:LPCWSTR; HandleId:LPVOID; ObjectTypeName:LPWSTR; ObjectName:LPWSTR; SecurityDescriptor:PSECURITY_DESCRIPTOR;DesiredAccess:DWORD; GenericMapping:PGENERIC_MAPPING; ObjectCreation:WINBOOL;
GrantedAccess:LPDWORD; AccessStatus:LPBOOL;pfGenerateOnClose:LPBOOL):WINBOOL; external 'advapi32' name 'AccessCheckAndAuditAlarmW';
function ObjectOpenAuditAlarmW(SubsystemName:LPCWSTR; HandleId:LPVOID; ObjectTypeName:LPWSTR; ObjectName:LPWSTR; pSecurityDescriptor:PSECURITY_DESCRIPTOR;ClientToken:HANDLE; DesiredAccess:DWORD; GrantedAccess:DWORD;