Componentes.Terceros.RemObj.../internal/5.0.23.613/1/RemObjects SDK for Delphi/Source/uRODLLHelpers.pas
david 2824855ea7 - Modificación del paquete RemObjects_Core_D10 para que sea un paquete de runtime/designtime (antes era designtime sólo)
- Recompilación en Delphi10 de todos los paquetes de RO para generar las DCU's en Lib\D10
- Recompilación en Delphi10 de todos los paquetes de DA para generar las DCU's en Lib\D10

git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@9 b6239004-a887-0f4b-9937-50029ccdca16
2007-09-10 14:06:19 +00:00

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.