unit AddonSysUtils;

interface
uses Windows, SysUtils, Classes, ActiveX, Graphics;

	function CheckHResult(AResult: HResult; const AnErrText: string): HResult;

	procedure SaveBitmapToIStream(aBitmapHandle: HBitmap; const anOleStm: IStream);
	function  LoadBitmapFromIStream(const anOleStm: IStream): HBitmap;

	procedure CopyStreamToIStream(aSrc: TStream; const aDst: IStream);
	procedure CopyIStreamToStream(const aSrc: IStream; aDst: TStream);


implementation

function CheckHResult(AResult: HResult; const AnErrText: string): HResult;
begin
	Result := AResult;
	if FAILED(AResult) then
		raise Exception.Create(AnErrText);
end;

procedure SaveBitmapToIStream(aBitmapHandle: HBitmap; const anOleStm: IStream);
const
	kWriteError = 'Ошибка при записи в OLE-поток';
var
	aBitmap: Graphics.TBitmap;
	aMemStm: TMemoryStream;
	aSize: Longint;
begin
	aBitmap := Graphics.TBitmap.Create;
	try
		aBitmap.Handle := aBitmapHandle;
		aMemStm := TMemoryStream.Create;
		try
			aBitmap.SaveToStream(aMemStm);
			aSize := aMemStm.Size;
			CheckHResult(anOleStm.Write(@aSize, sizeof(aSize), nil), kWriteError);
			CheckHResult(anOleStm.Write(aMemStm.Memory, aSize, nil), kWriteError);
		finally
			aMemStm.Free;
		end;
	finally
		aBitmap.ReleaseHandle;
		aBitmap.Free;
	end;
end;

function LoadBitmapFromIStream(const anOleStm: IStream): HBitmap;
const
	kReadError = 'Ошибка при чтении из OLE-потока';
var
	aBitmap: Graphics.TBitmap;
	aMemStm: TMemoryStream;
	aSize, aReaded: Longint;
begin
	Result := 0;
	aBitmap := Graphics.TBitmap.Create;
	try
		aMemStm := TMemoryStream.Create;
		try
			CheckHResult(anOleStm.Read(@aSize, sizeof(aSize), @aReaded), kReadError);
			if aReaded <> sizeof(aSize) then
				raise Exception.Create(kReadError);
			aMemStm.SetSize(aSize);
			CheckHResult(anOleStm.Read(aMemStm.Memory, aSize, @aReaded), kReadError);
			if aReaded <> aSize then
				raise Exception.Create(kReadError);
			aMemStm.Position := 0;
			aBitmap.LoadFromStream(aMemStm);
			Result := aBitmap.ReleaseHandle;
		finally
			aMemStm.Free;
		end;
	finally
		aBitmap.ReleaseHandle;
		aBitmap.Free;
	end;
end;

procedure CopyStreamToIStream(aSrc: TStream; const aDst: IStream);
const
	kWriteError = 'Ошибка при записи в OLE-поток';
var
	aMemStm: TMemoryStream;
	aMustFree: Boolean;
	aSize: Longint;
begin
	aSrc.Position := 0;
	aSize := aSrc.Size;

	aMustFree := not (aSrc is TMemoryStream);
	if aMustFree then
		aMemStm := TMemoryStream.Create
	else
		aMemStm := TMemoryStream(aSrc);

	try
		if aMustFree then
			aMemStm.CopyFrom(aSrc, aSize);
		CheckHResult(aDst.Write(aMemStm.Memory, aSize, nil), kWriteError);
	finally
		if aMustFree then
			aMemStm.Free;
	end;
end;

procedure CopyIStreamToStream(const aSrc: IStream; aDst: TStream);
const
	kSeekError = 'Ошибка при установке позиции в OLE-потоке';
	kReadError = 'Ошибка при чтении из OLE-потока';
var
	aMemStm: TMemoryStream;
	aSize, aReaded: Longint;
	aStmEndPos, aStmBeginPos: Largeint;
begin
	CheckHResult(aSrc.Seek(0, STREAM_SEEK_END, aStmEndPos), kSeekError);
	CheckHResult(aSrc.Seek(0, STREAM_SEEK_SET, aStmBeginPos), kSeekError);
	aSize := aStmEndPos-aStmBeginPos;

	aMemStm := TMemoryStream.Create;
	try
		aMemStm.SetSize(aSize);
		CheckHResult(aSrc.Read(aMemStm.Memory, aSize, @aReaded), kReadError);
		if aReaded <> aSize then
			raise Exception.Create(kReadError);
		aDst.CopyFrom(aMemStm, 0);
	finally
		aMemStm.Free;
	end;
end;

end.
