paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-13 12:26:58 +02:00
Code Issues Packages Projects Releases Wiki Activity

* TStreamAdapter + relevant constants. From 10608

Browse Source 
git-svn-id: trunk@13988 -
This commit is contained in:
marco 2009-10-31 20:13:41 +00:00
parent 54f0caad4d
commit 09b22de964
2 changed files with 57 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

59
rtl/objpas/classes/streams.inc
View File

@ -833,23 +833,50 @@ end;
{$warnings off}
function TStreamAdapter.Read(pv: Pointer; cb: DWORD; pcbRead: PDWORD): HResult; stdcall;
var
readcount: Longint;
begin
runerror(217);
end;
if pv = nil then
begin
Result := E_INVALIDARG;
Exit;
end;
readcount := FStream.Read(pv^, cb);
if pcbRead <> nil then pcbRead^ := readcount;
Result := S_OK;
end;
function TStreamAdapter.Write(pv: Pointer; cb: DWORD; pcbWritten: PDWORD): HResult; stdcall;
var
writecount: Longint;
begin
runerror(217);
end;
if pv = nil then
begin
Result := E_INVALIDARG;
Exit;
end;
writecount := FStream.Write(pv^, cb);
if pcbWritten <> nil then pcbWritten^ := writecount;
Result := S_OK;
end;
function TStreamAdapter.Seek(dlibMove: Largeint; dwOrigin: Longint; out libNewPosition: Largeint): HResult; stdcall;
var
newpos: Int64;
begin
runerror(217);
case dwOrigin of
STREAM_SEEK_SET: newpos := FStream.Seek(dlibMove, soBeginning);
STREAM_SEEK_CUR: newpos := FStream.Seek(dlibMove, soCurrent);
STREAM_SEEK_END: newpos := FStream.Seek(dlibMove, soEnd);
else begin Result := E_INVALIDARG; exit; end;
end;
if @libNewPosition <> nil then
libNewPosition := newpos;
Result := S_OK;
end;
function TStreamAdapter.SetSize(libNewSize: Largeint): HResult; stdcall;
begin
runerror(217);
@ -888,9 +915,25 @@ end;
function TStreamAdapter.Stat(out statstg: TStatStg; grfStatFlag: Longint): HResult; stdcall;
begin
runerror(217);
end;
if grfStatFlag in [STATFLAG_DEFAULT,STATFLAG_NOOPEN,STATFLAG_NONAME] then
begin
if @statstg <> nil then
begin
fillchar(statstg, sizeof(TStatStg),#0);
{ //TODO handle pwcsName
if grfStatFlag = STATFLAG_DEFAULT then
runerror(217) //Result :={$ifdef windows} STG_E_INVALIDFLAG{$else}E_INVALID_FLAG{$endif}
}
statstg.dwType := STGTY_STREAM;
statstg.cbSize := FStream.Size;
statstg.grfLocksSupported := LOCK_WRITE;
end;
Result := S_OK;
end else
Result := STG_E_INVALIDFLAG
end;
function TStreamAdapter.Clone(out stm: IStream): HResult; stdcall;
begin

7
rtl/objpas/types.pp
View File

@ -148,7 +148,8 @@ const
LOCK_EXCLUSIVE = 2;
LOCK_ONLYONCE = 4;
E_FAIL = HRESULT($80004005);
E_FAIL = HRESULT($80004005);
E_INVALIDARG = HRESULT($80070057);
STG_E_INVALIDFUNCTION = HRESULT($80030001);
STG_E_FILENOTFOUND = HRESULT($80030002);
@ -193,6 +194,10 @@ const
STG_S_RETRYNOW = $00030202;
STG_S_MONITORING = $00030203;
STATFLAG_DEFAULT = 0;
STATFLAG_NONAME = 1;
STATFLAG_NOOPEN = 2;
type
PCLSID = PGUID;
TCLSID = TGUID;