paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-20 11:29:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Patch from Ocean, Mantis #25798

Browse Source 
git-svn-id: trunk@26906 -
This commit is contained in:
marco 2014-02-28 15:19:08 +00:00
parent 14590fb859
commit 17330b94e3
1 changed files with 13 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
packages/winunits-base/src/comobj.pp
View File

@ -288,6 +288,8 @@ unit comobj;
function ProgIDToClassID(const id : string) : TGUID;
function ClassIDToProgID(const classID: TGUID): string;
function StringToLPOLESTR(const Source: string): POLEStr;
procedure DispatchInvoke(const Dispatch: IDispatch; CallDesc: PCallDesc;
DispIDs: PDispIDList; Params: Pointer; Result: PVariant);
procedure DispatchInvokeError(Status: HRESULT; const ExceptInfo: TExcepInfo);
@ -573,6 +575,17 @@ implementation
end;
function StringToLPOLESTR(const Source: string): POLEStr;
var
Src: WideString;
begin
Src := WideString(Source);
Result := CoTaskMemAlloc((Length(Src)+1) * SizeOf(WideChar));
if Result <> nil then
Move(PWideChar(Src)^, Result^, (Length(Src)+1) * SizeOf(WideChar));
end;
procedure SafeCallErrorHandler(err : HResult;addr : pointer);
{$ifndef wince}
var