paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-25 23:51:09 +02:00
Code Issues Packages Projects Releases Wiki Activity

* result buffers must be allocated

Browse Source
This commit is contained in:
Tomas Hajny 2003-10-05 22:06:43 +00:00
parent da9f5e2319
commit 1bcce4c618
1 changed files with 16 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
rtl/os2/dos.pas
View File

@ -191,24 +191,26 @@ const FindResvdMask = $00003737; {Allowed bits in attribute
function fsearch(path:pathstr;dirlist:string):pathstr; function fsearch(path:pathstr;dirlist:string):pathstr;
Var Var
R: PChar; A: array [0..255] of char;
D, P: AnsiString; D, P: AnsiString;
begin begin
P:=Path; P:=Path;
D:=DirList; D:=DirList;
DosError:=DosSearchPath(0, PChar(D), PChar(P), R, 255); DosError:=DosSearchPath(0, PChar(D), PChar(P), @A, 255);
fsearch:=R; fsearch := StrPas (@A);
end; end;
procedure getftime(var f;var time:longint); procedure getftime(var f;var time:longint);
var var
FStat: PFileStatus3; FStat: PFileStatus3;
begin begin
New (FStat);
DosError:=DosQueryFileInfo(FileRec(F).Handle, 1, FStat, SizeOf(FStat^)); DosError:=DosQueryFileInfo(FileRec(F).Handle, 1, FStat, SizeOf(FStat^));
If DosError=0 then If DosError=0 then
Time:=FStat^.timelastwrite+FStat^.DateLastWrite*256 Time:=FStat^.timelastwrite+FStat^.DateLastWrite*256
else else
Time:=0; Time:=0;
Dispose (FStat);
end; end;
procedure SetFTime (var F; Time: longint); procedure SetFTime (var F; Time: longint);
@ -216,8 +218,8 @@ var FStat: PFileStatus3;
RC: longint; RC: longint;
begin begin
New (FStat); New (FStat);
RC := DosQueryFileInfo (FileRec (F).Handle, ilStandard, FStat, RC := DosQueryFileInfo (FileRec (F).Handle, ilStandard, @FStat,
SizeOf (FStat^)); SizeOf (FStat));
if RC = 0 then if RC = 0 then
begin begin
FStat^.DateLastAccess := Hi (Time); FStat^.DateLastAccess := Hi (Time);
@ -567,7 +569,7 @@ begin
pop eax pop eax
mov P, edi { place pointer to variable contents in P } mov P, edi { place pointer to variable contents in P }
@End: @End:
end ['eax','ebx','ecx','edx','esi','edi']; end ['eax','ecx','edx','esi','edi'];
GetEnvPChar := P; GetEnvPChar := P;
end; end;
{$ASMMODE ATT} {$ASMMODE ATT}
@ -577,7 +579,6 @@ function GetEnv (const EnvVar: string): string;
begin begin
GetEnv := StrPas (GetEnvPChar (EnvVar)); GetEnv := StrPas (GetEnvPChar (EnvVar));
end; end;
{$ASMMODE ATT}
procedure fsplit(path:pathstr;var dir:dirstr;var name:namestr; procedure fsplit(path:pathstr;var dir:dirstr;var name:namestr;
var ext:extstr); var ext:extstr);
@ -681,29 +682,36 @@ procedure getfattr(var f;var attr : word);
var var
PathInfo: PFileStatus3; PathInfo: PFileStatus3;
begin begin
New (PathInfo);
Attr:=0; Attr:=0;
DosError:=DosQueryPathInfo(FileRec(F).Name, ilStandard, PathInfo, SizeOf(PathInfo^)); DosError:=DosQueryPathInfo(FileRec(F).Name, ilStandard, PathInfo, SizeOf(PathInfo^));
if DosError=0 then if DosError=0 then
Attr := PathInfo^.attrFile; Attr := PathInfo^.attrFile;
Dispose (PathInfo);
end; end;
procedure setfattr(var f;attr : word); procedure setfattr(var f;attr : word);
var var
PathInfo: PFileStatus3; PathInfo: PFileStatus3;
begin begin
New (PathInfo);
DosError:=DosQueryPathInfo(FileRec(F).Name, ilStandard, PathInfo, SizeOf(PathInfo^)); DosError:=DosQueryPathInfo(FileRec(F).Name, ilStandard, PathInfo, SizeOf(PathInfo^));
if DosError=0 then if DosError=0 then
begin begin
PathInfo^.attrFile:=Attr; PathInfo^.attrFile:=Attr;
DosError:=DosSetPathInfo(FileRec(F).Name, ilStandard, PathInfo, SizeOf(PathInfo^), doWriteThru); DosError:=DosSetPathInfo(FileRec(F).Name, ilStandard, PathInfo, SizeOf(PathInfo^), doWriteThru);
end; end;
Dispose (PathInfo);
end; end;
begin begin
end. end.
{ {
$Log$ $Log$
Revision 1.27 2003-10-03 21:46:41 peter Revision 1.28 2003-10-05 22:06:43 hajny
* result buffers must be allocated
Revision 1.27 2003/10/03 21:46:41 peter
* stdcall fixes * stdcall fixes
Revision 1.26 2003/09/24 08:59:16 yuri Revision 1.26 2003/09/24 08:59:16 yuri