drum sagte ich ja, daß man diese eventuell noch implementieren muß
(hatte es vorhin nur nicht gemacht, da ich alles Vorhandene erstmal nur zusammenkopiert hatte und nichts direkt "neu" schrieb)
Delphi-Quellcode:
type
IDelphiStreamIntern = interface
{private}
function GetPosition: Int64;
procedure SetPosition(const Pos: Int64);
procedure SetSize64(const NewSize: Int64);
function GetSize: Int64;
end;
IDelphiStream = interface(IDelphiStreamIntern)
['{65805750-623E-4719-AD79-A30FF6FCA3CA}']
procedure SetSize(NewSize: Longint);
function Write(const Buffer; Count: Longint): Longint;
function Read(var Buffer; Count: Longint): Longint;
function Seek(Offset: Longint; Origin: Word): Longint;
procedure Clear;
procedure LoadFromStream(Stream: IDelphiStream);
procedure SaveToStream(Stream: IDelphiStream);
procedure LoadFromFile(const FileName: WideString);
procedure SaveToFile(const FileName: WideString);
property Position: Int64 read GetPosition write SetPosition;
property Size: Int64 read GetSize write SetSize64;
end;
TInterfacedMemoryStream = class(TMemoryStream, IDelphiStream, IInterface)
private
function GetPosition: Int64;
procedure SetPosition(const Pos: Int64);
procedure SetSize64(const NewSize: Int64);
protected
FRefCount: Integer;
function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
function _AddRef: Integer; stdcall;
function _Release: Integer; stdcall;
public
procedure AfterConstruction; override;
procedure BeforeDestruction; override;
class function NewInstance: TObject; override;
property RefCount: Integer read FRefCount;
procedure LoadFromStream(Stream: IDelphiStream); overload;
procedure SaveToStream(Stream: IDelphiStream); overload;
procedure LoadFromFile(const FileName: WideString); overload;
procedure SaveToFile(const FileName: WideString); overload;
end;
function TInterfacedMemoryStream.GetPosition: Int64;
begin
Result := inherited Position;
end;
procedure TInterfacedMemoryStream.SetPosition(const Pos: Int64);
begin
inherited Position := Pos;
end;
procedure TInterfacedMemoryStream.SetSize64(const NewSize: Int64);
begin
inherited Size := NewSize;
end;
function TInterfacedMemoryStream.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
if GetInterface(IID, Obj) then
Result := 0
else
Result := E_NOINTERFACE;
end;
function TInterfacedMemoryStream._AddRef: Integer;
begin
Result := InterlockedIncrement(FRefCount);
end;
function TInterfacedMemoryStream._Release: Integer;
begin
Result := InterlockedDecrement(FRefCount);
if Result = 0 then
Destroy;
end;
procedure TInterfacedMemoryStream.AfterConstruction;
begin
InterlockedDecrement(FRefCount);
end;
procedure TInterfacedMemoryStream.BeforeDestruction;
begin
if RefCount <> 0 then
System.Error(reInvalidPtr);
end;
class function TInterfacedMemoryStream.NewInstance: TObject;
begin
Result := inherited NewInstance;
TInterfacedMemoryStream(Result).FRefCount := 1;
end;
procedure TInterfacedMemoryStream.LoadFromStream(Stream: IDelphiStream);
var
buf: array[0..65535] of Byte;
i: Integer;
begin
Clear;
while true do
begin
i := Stream.Read(buf, Length(buf));
if i = 0 then break;
if Write(buf, i) <> i then System.Error(reOutOfMemory);
end;
end;
procedure TInterfacedMemoryStream.SaveToStream(Stream: IDelphiStream);
var
buf: array[0..65535] of Byte;
i: Integer;
begin
Stream.Clear;
while true do
begin
i := Read(buf, Length(buf));
if i = 0 then break;
if Stream.Write(buf, i) <> i then System.Error(reOutOfMemory);
end;
end;
procedure TInterfacedMemoryStream.LoadFromFile(const FileName: WideString);
begin
inherited LoadFromFile(String(FileName));
end;
procedure TInterfacedMemoryStream.SaveToFile(const FileName: WideString);
begin
inherited SaveToFile(String(FileName));
end;
LoadFromStream und SaveToStream arbeiten hier intern aber nur mit String, also bis Delphi 2007 mit AnsiString.
Wenn man auch da wirklich den WideString unterstüzen will, dann muß man sich einen
Unicode-fähigen FileStream besorgen (also
Unicode bei den Dateinamen).
Und direkt AnsiString/UnicodeString geht halt wegen der getrennten Speicherverwaltung nicht so einfach ... stickwort
SharedMemoryManager