X000XActiveX.pas
markieren
unit X000XActiveX;
interface
uses Windows;
type
OLE_HANDLE = LongWord;
OLE_XPOS_HIMETRIC = Longint;
OLE_YPOS_HIMETRIC = Longint;
OLE_XSIZE_HIMETRIC = Longint;
OLE_YSIZE_HIMETRIC = Longint;
Largeint = Int64;
POleStr = PWideChar;
TIID = TGUID;
TCLSID = TGUID;
IStream = interface;
{ IStream interface }
PStatStg = ^TStatStg;
tagSTATSTG = record
pwcsName: POleStr;
dwType: Longint;
cbSize: Largeint;
mtime: TFileTime;
ctime: TFileTime;
atime: TFileTime;
grfMode: Longint;
grfLocksSupported: Longint;
clsid: TCLSID;
grfStateBits: Longint;
reserved: Longint;
end;
TStatStg = tagSTATSTG;
STATSTG = TStatStg;
ISequentialStream = interface(IUnknown)
['{0c733a30-2a1c-11ce-ade5-00aa0044773d}']
function Read(pv: Pointer; cb: Longint; pcbRead: PLongint): HResult;
stdcall;
function Write(pv: Pointer; cb: Longint; pcbWritten: PLongint): HResult;
stdcall;
end;
IStream = interface(ISequentialStream)
['{0000000C-0000-0000-C000-000000000046}']
function Seek(dlibMove: Largeint; dwOrigin: Longint;
out libNewPosition: Largeint): HResult; stdcall;
function SetSize(libNewSize: Largeint): HResult; stdcall;
function CopyTo(stm: IStream; cb: Largeint; out cbRead: Largeint;
out cbWritten: Largeint): HResult; stdcall;
function Commit(grfCommitFlags: Longint): HResult; stdcall;
function Revert: HResult; stdcall;
function LockRegion(libOffset: Largeint; cb: Largeint;
dwLockType: Longint): HResult; stdcall;
function UnlockRegion(libOffset: Largeint; cb: Largeint;
dwLockType: Longint): HResult; stdcall;
function Stat(out statstg: TStatStg; grfStatFlag: Longint): HResult;
stdcall;
function Clone(out stm: IStream): HResult; stdcall;
end;
type
IPicture = interface
['{7BF80980-BF32-101A-8BBB-00AA00300CAB}']
function get_Handle(out handle: OLE_HANDLE): HResult; stdcall;
function get_hPal(out handle: OLE_HANDLE): HResult; stdcall;
function get_Type(out typ: Smallint): HResult; stdcall;
function get_Width(out width: OLE_XSIZE_HIMETRIC): HResult; stdcall;
function get_Height(out height: OLE_YSIZE_HIMETRIC): HResult; stdcall;
function Render(dc: HDC; x, y, cx, cy: Longint;
xSrc: OLE_XPOS_HIMETRIC; ySrc: OLE_YPOS_HIMETRIC;
cxSrc: OLE_XSIZE_HIMETRIC; cySrc: OLE_YSIZE_HIMETRIC;
const rcWBounds: TRect): HResult; stdcall;
function set_hPal(hpal: OLE_HANDLE): HResult; stdcall;
function get_CurDC(out dcOut: HDC): HResult; stdcall;
function SelectPicture(dcIn: HDC; out hdcOut: HDC;
out bmpOut: OLE_HANDLE): HResult; stdcall;
function get_KeepOriginalFormat(out fkeep: BOOL): HResult; stdcall;
function put_KeepOriginalFormat(fkeep: BOOL): HResult; stdcall;
function PictureChanged: HResult; stdcall;
function SaveAsFile(const stream: IStream; fSaveMemCopy: BOOL;
out cbSize: Longint): HResult; stdcall;
function get_Attributes(out dwAttr: Longint): HResult; stdcall;
end;
type
TFNCreateStreamOnHGlobalX = function(hglob: HGlobal; fDeleteOnRelease: BOOL;
out stm: IStream): HResult; stdcall;
TFNOleLoadPictureX = function(stream: IStream; lSize: Longint; fRunmode: BOOL;
const iid: TIID; out vObject): HResult; stdcall;
{function CreateStreamOnHGlobal(hglob: HGlobal; fDeleteOnRelease: BOOL;
out stm: IStream): HResult; stdcall;
function OleLoadPicture(stream: IStream; lSize: Longint; fRunmode: BOOL;
const iid: TIID; out vObject): HResult; stdcall;}
var
CreateStreamOnHGlobalX : TFNCreateStreamOnHGlobalX = nil;
OleLoadPictureX : TFNOleLoadPictureX = nil;
function LoadPictureFromFile(AFile: String; var pPicture: IPicture) : Boolean;
function LoadPictureFromRes(Instance: THandle; const szResName, szResType : String; var pPicture: IPicture) : Boolean;
implementation
const
OLE32 = 'ole32.dll';
OLEPRO32 = 'olepro32.dll';
var LibOle32,
LibOlePro32 : HMODULE;
function LoadX000XActiveX: Boolean;
begin
Result := False;
LibOle32 := LoadLibrary(@OLE32[1]);
if LibOle32 <> 0 then begin
LibOlePro32 := LoadLibrary(@OLEPRO32[1]);
if LibOlePro32 <> 0 then begin
CreateStreamOnHGlobalX := GetProcAddress(LibOle32, PChar('CreateStreamOnHGlobal'));
OleLoadPictureX := GetProcAddress(LibOlePro32, PChar('OleLoadPicture'));
if Assigned(CreateStreamOnHGlobalX) And
Assigned(OleLoadPictureX) then begin
Result := True;
Exit;
end else begin
CreateStreamOnHGlobalX := nil;
OleLoadPictureX := nil;
FreeLibrary(LibOle32);
FreeLibrary(LibOlePro32);
end;
end else
FreeLibrary(LibOle32);
end;
end;
procedure UnloadX000XActiveX;
begin
CreateStreamOnHGlobalX := nil;
OleLoadPictureX := nil;
FreeLibrary(LibOle32);
FreeLibrary(LibOlePro32);
end;
(* Funktion lädt ein Bild von der HDD in eine Variable vom Typ IPicture (X000XActiveX.pas) *)
function LoadPictureFromFile(AFile: String; var pPicture: IPicture) : Boolean;
const IID_IPicture : TGUID = '{7BF80980-BF32-101A-8BBB-00AA00300CAB}';
var
hFile, hMem : THandle;
dwFileSize,
dwBytesRead : DWord;
pData : Pointer;
bRead : Boolean;
hRes : HResult;
pStream : IStream;
Begin
Result := False;
if LoadX000XActiveX then begin
hMem := 0;
(* Datei öffnen *)
hFile := CreateFile(PChar(AFile), GENERIC_READ, 0, nil, OPEN_EXISTING, 0, 0);
if hFile = INVALID_HANDLE_VALUE then Exit;
(* Sollte was schief laufen, steigen wir mit exit aus, aufgeräumt wird im Finally Block *)
try
(* Dateigröße holen *)
dwFileSize := GetFileSize(hFile, nil);
if dwFileSize = INVALID_FILE_SIZE then
Exit;
(* "Dateigröße" an Bytes vom Heap anfordern *)
hMem := GlobalAlloc(GHND or GMEM_NODISCARD, dwFileSize);
if hMem = 0 then
Exit;
(* Einen Zeiger auf den soeben angeforderten Speicherblock holen *)
pData := GlobalLock(hMem);
if Not Assigned(pData) then
Exit;
(* Datei in den Speicher lesen *)
(* Dateigröße und gelesene Bytes sollten hiernach übereinstimmen *)
bRead := ReadFile(hFile, pData^ , dwFileSize, dwBytesRead, nil);
GlobalUnlock(hMem);
if not bRead then
Exit;
(* Ein StreamObject erstellen (wir geben den HeapSpeicher selber frei - 2. Parameter) *)
pStream := nil;
hRes := CreateStreamOnHGlobalX(hMem, False, pStream);
if FAILED(hRes) or (pStream = nil) then
Exit;
(* Das Picture in die Variable pPicture (IPicture) laden und bei Erfolg True zurückgeben *)
hRes := OleLoadPictureX(pStream, dwFileSize, False, IID_IPicture, pPicture);
if (hRes = S_OK) and (pPicture <> nil) then
Result := True;
(* StreamObjekt zerstören *)
pStream := nil;
finally
(* Wenn wir vorhin erfolgreich Speicher angefordert haben, ihn hier *)
(* auf jedenfall wieder frei geben *)
if hMem <> 0 then
GlobalFree(hMem);
(* und zu guterletzt die Datei wieder schließen *)
CloseHandle(hFile);
UnloadX000XActiveX;
end;
end;
End;
function LoadPictureFromRes(Instance: THandle; const szResName, szResType : String; var pPicture: IPicture) : Boolean;
const IID_IPicture : TGUID = '{7BF80980-BF32-101A-8BBB-00AA00300CAB}';
var
hResInfo,
hResGlobal,
hMem : THandle;
dwFileSize : DWord;
pData,
pResData : Pointer;
hRes : HResult;
pStream : IStream;
Begin
Result := False;
if LoadX000XActiveX then begin
hMem := 0;
(* Resource suchen und wenn vorhanden... *)
hResInfo := FindResource(Instance, Pointer(szResName), Pointer(szResType));
if hResInfo = 0 then Exit;
(* ... laden *)
hResGlobal := LoadResource(Instance, hResInfo);
if hResGlobal = 0 then Exit;
(* Sollte was schief laufen, steigen wir mit exit aus, aufgeräumt wird im Finally Block *)
try
(* Handle auf die Daten holen *)
pResData := LockResource(hResGlobal);
if Not Assigned(pResData) then Exit;
(* Größe der Resource in Bytes holen *)
dwFileSize := SizeofResource(Instance, hResInfo);
if dwFileSize = 0 then Exit;
(* "Dateigröße" an Bytes vom Heap anfordern *)
hMem := GlobalAlloc(GHND or GMEM_NODISCARD, dwFileSize);
if hMem = 0 then
Exit;
(* Einen Zeiger auf den soeben angeforderten Speicherblock holen *)
pData := GlobalLock(hMem);
if Not Assigned(pData) then
Exit;
(* Daten in den Speicher lesen *)
Move(pResData^, pData^, dwFileSize);
GlobalUnlock(hMem);
(* Ein StreamObject erstellen (wir geben den HeapSpeicher selber frei - 2. Parameter) *)
pStream := nil;
hRes := CreateStreamOnHGlobalX(hMem, False, pStream);
if FAILED(hRes) or (pStream = nil) then
Exit;
(* Das Picture in die Variable pPicture (IPicture) laden und bei Erfolg True zurückgeben *)
hRes := OleLoadPictureX(pStream, dwFileSize, False, IID_IPicture, pPicture);
if (hRes = S_OK) and (pPicture <> nil) then
Result := True;
(* StreamObjekt zerstören *)
pStream := nil;
finally
(* Wenn wir vorhin erfolgreich Speicher angefordert haben, ihn hier *)
(* auf jedenfall wieder frei geben *)
if hMem <> 0 then
GlobalFree(hMem);
(* und zu guterletzt die Resource freigeben *)
if hResGlobal <> 0 then
FreeResource(hResGlobal);
UnloadX000XActiveX;
end;
end;
End;
end.