Componentes.Terceros.RemObj.../internal/5.0.24.615/1/RemObjects SDK for Delphi/Source/uRODLLHelpers.pas

89 lines
2.9 KiB
ObjectPascal

unit uRODLLHelpers;
{----------------------------------------------------------------------------}
{ RemObjects SDK Library - Core Library }
{ }
{ compiler: Delphi 5 and up, Kylix 2 and up }
{ platform: Win32, Linux }
{ }
{ (c)opyright RemObjects Software. all rights reserved. }
{ }
{ Using this code requires a valid license of the RemObjects SDK }
{ which can be obtained at http://www.remobjects.com. }
{----------------------------------------------------------------------------}
{$I RemObjects.inc}
interface
uses Windows, Classes;
{ Description:
Creates a hGlobal object that contains the contents of the stream.
The Stream is positioned at it's end when the function returns
The Caller is responsible for freeing the returnd hGloba using the
GlobalFree API call. }
function StreamToHGlobal(iStream:TStream):THandle;
{ Description:
Loads an hGlobal into the passed Stream. The stream is completeley
cleared before loading the memory; It's positioned at 0 when the
function returns. }
procedure HGlobalToStream(lHandle:THandle; iStream:TStream);
type
IRODllEventCallback = interface
['{39084976-A3F5-43DB-B2F0-B9EE3137C6EF}']
procedure ProcessEvent(Data: Pointer; DataSize: Integer);
end;
implementation
uses SysUtils;
type PInteger = ^Integer;
function StreamToHGlobal(iStream:TStream):THandle;
var lPointer:Pointer;
begin
Result := GlobalAlloc(0,iStream.Size+sizeof(Integer));
if Result = 0 then RaiseLastOSError();
try
lPointer := GlobalLock(Result);
if not Assigned(lPointer) then RaiseLastOSError();
try
iStream.Seek(0,soFromBeginning);
PInteger(lPointer)^ := iStream.Size;
inc(PInteger(lPointer));
iStream.ReadBuffer(lPointer^,iStream.Size);
finally
//if not GlobalUnlock(Result) then RaiseLastOSError();
//ToDo: it seesm the return value on success is also zero (and GetLastError will yield NO_ERROR) on Win9x systems.
GlobalUnlock(Result);
end;
except
if GlobalFree(Result) <> 0 then RaiseLastOSError();
raise;
end;
end;
procedure HGlobalToStream(lHandle:THandle; iStream:TStream);
var
lPointer:Pointer;
lSize:integer;
begin
lPointer := GlobalLock(lHandle);
if not Assigned(lPointer) then RaiseLastOSError();
try
iStream.Size := 0;
lSize := PInteger(lPointer)^;
inc(PInteger(lPointer));
iStream.WriteBuffer(lPointer^,lSize);
iStream.Seek(0,soFromBeginning);
finally
GlobalUnlock(lHandle);
end;
end;
end.