搜索

分享

QQ空间 QQ好友新浪微博微信

LoadTypeLib

quasiceo 2012-12-09

展开全文

#include <windows.h>
#include <ole2.h>
int main(int argc, char* argv[])
{
CoInitialize(0);
ITypeLib* typeLib;
HRESULT hr = LoadTypeLib((wchar_t *)argv[1], typeLib);
.
.
.
CoUninitialize();
}

//--------------------------------------------------------------
function TtfAutoUpdate.pRegLib(fileName : String):boolean;
var
sFileName : String;
ptlib: ITypeLib;
begin
sFileName := fileName;
try
result := true;
OleCheck(LoadTypeLib(PWideChar(sFileName), ptlib));
OleCheck(RegisterTypeLib(ptlib, PWideChar(sFileName),nil));
pWriteLog('注册' + fileName + '成功');
Except
on e:Exception do
begin
result := false;
pWriteLog('注册' + fileName + '失败，错误:' + e.Message);
end;
end;
end;
//--------------------------------------------------------------
function TtfAutoUpdate.pUnRegLib(fileName : String):boolean;
var
sFileName : String;
ptlib : ITypeLib;
ptla : PTLibAttr;
begin
sFileName := fileName;
try
result := true;
OleCheck(LoadTypeLib(PWideChar(sFileName), ptlib));
OleCheck(ptlib.GetLibAttr(ptla));
OleCheck(UnRegisterTypeLib(ptla.guid,ptla.wMajorVerNum,ptla.wMinorVerNum,ptla.lcid,ptla.syskind));
ptlib.ReleaseTLibAttr(ptla);
pWriteLog('卸载' + fileName + '成功');
Except
on e:Exception do
begin
result := false;
pWriteLog('卸载' + fileName + '失败，错误:' + e.Message);
end;
end;
end;

unit InstFnc2;
{
Inno Setup
Copyright (C) 1997-2004 Jordan Russell
Portions by Martijn Laan
For conditions of distribution and use, see LICENSE.TXT.
OLE-related installation functions
$jrsoftware: issrc/Projects/InstFnc2.pas,v 1.21 2005/04/09 07:28:51 jr Exp $
}
interface
{$I VERSION.INC}
function CreateShellLink(const Filename, Description, ShortcutTo, Parameters,
WorkingDir, IconFilename: String; const IconIndex, ShowCmd: Integer;
const HotKey: Word; FolderShortcut: Boolean): String;
procedure RegisterTypeLibrary(const Filename: String);
procedure UnregisterTypeLibrary(const Filename: String);
implementation
uses
Windows, SysUtils, PathFunc, CmnFunc2, InstFunc, Main, Msgs, MsgIDs,
{$IFNDEF Delphi3orHigher} OLE2, {$ELSE} ActiveX, ComObj, {$ENDIF}
ShellAPI, ShlObj;
function IsWindowsXP: Boolean;
{ Returns True if running Windows XP or later }
begin
Result := (WindowsVersion >= Cardinal($05010000));
end;
function GetResultingFilename(const PF: IPersistFile;
const OriginalFilename: String): String;
{ Determines the actual resulting filename. IPersistFile::Save doesn't always
save to the specified filename; it may rename the extension to .pif if the
shortcut points to an MS-DOS application. }
var
CurFilename: PWideChar;
OleResult: HRESULT;
begin
Result := '';
CurFilename := nil;
OleResult := PF.GetCurFile(CurFilename);
{ Note: Prior to Windows 2000/Me, GetCurFile succeeds but returns a NULL
pointer }
if SUCCEEDED(OleResult) and Assigned(CurFilename) then begin
if OleResult = S_OK then
Result := WideCharToString(CurFilename);
CoTaskMemFree(CurFilename);
end;
{ If GetCurFile didn't work (e.g. not running Windows 2000/Me or later), we
have no choice but to try to guess the filename }
if Result = '' then begin
if NewFileExists(OriginalFilename) then
Result := OriginalFilename
else if NewFileExists(PathChangeExt(OriginalFilename, '.pif')) then
Result := PathChangeExt(OriginalFilename, '.pif')
else begin
{ Neither exist? Shouldn't happen, but return something anyway }
Result := OriginalFilename;
end;
end;
end;
function CreateShellLink(const Filename, Description, ShortcutTo, Parameters,
WorkingDir, IconFilename: String; const IconIndex, ShowCmd: Integer;
const HotKey: Word; FolderShortcut: Boolean): String;
{ Creates a lnk file named Filename, with a description of Description, with a
HotKey hotkey, which points to ShortcutTo.
NOTE! If you want to copy this procedure for use in your own application
be sure to call CoInitialize at application startup and CoUninitialize at
application shutdown. See the bottom of this unit for an example. But this
is not necessary if you are using Delphi 3 and your project already 'uses'
the ComObj RTL unit. }
const
CLSID_FolderShortcut: TGUID = (
D1:$0AFACED1; D2:$E828; D3:$11D1; D4:($91,$87,$B5,$32,$F1,$E9,$57,$5D));
{$IFNDEF Delphi3OrHigher}
var
OleResult: HRESULT;
SL: IShellLink;
PF: IPersistFile;
WideFilename: PWideChar;
begin
if FolderShortcut then
OleResult := CoCreateInstance(CLSID_FolderShortcut, nil, CLSCTX_INPROC_SERVER,
IID_IShellLink, SL)
else
OleResult := E_FAIL;
{ If a folder shortcut wasn't requested, or if CoCreateInstance failed
because the user isn't running Windows 2000/Me or later, create a normal
shell link instead }
if OleResult <> S_OK then begin
FolderShortcut := False;
OleResult := CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER,
IID_IShellLink, SL);
if OleResult <> S_OK then
RaiseOleError('CoCreateInstance', OleResult);
end;
PF := nil;
WideFilename := nil;
try
SL.SetPath(PChar(ShortcutTo));
SL.SetArguments(PChar(Parameters));
if WorkingDir <> '' then
SL.SetWorkingDirectory(PChar(WorkingDir));
if IconFilename <> '' then
SL.SetIconLocation(PChar(IconFilename), IconIndex);
SL.SetShowCmd(ShowCmd);
if Description <> '' then
SL.SetDescription(PChar(Description));
if HotKey <> 0 then
SL.SetHotKey(HotKey);
OleResult := SL.QueryInterface(IID_IPersistFile, PF);
if OleResult <> S_OK then
RaiseOleError('IShellLink::QueryInterface', OleResult);
{ When creating a folder shortcut on 2000/Me, IPersistFile::Save will strip
off everything past the last '.' in the filename, so we keep the .lnk
extension on to give it something harmless to strip off. XP doesn't do
that, so we must remove the .lnk extension ourself. }
if FolderShortcut and IsWindowsXP then
WideFilename := StringToOleStr(PathChangeExt(Filename, ''))
else
WideFilename := StringToOleStr(Filename);
if WideFilename = nil then
OutOfMemoryError;
OleResult := PF.Save(WideFilename, True);
if OleResult <> S_OK then
RaiseOleError('IPersistFile::Save', OleResult);
Result := GetResultingFilename(PF, Filename);
finally
if Assigned(WideFilename) then
SysFreeString(WideFilename);
if Assigned(PF) then
PF.Release;
SL.Release;
end;
{$ELSE}
var
OleResult: HRESULT;
Obj: IUnknown;
SL: IShellLink;
PF: IPersistFile;
WideFilename: WideString;
begin
if FolderShortcut then begin
try
Obj := CreateComObject(CLSID_FolderShortcut);
except
{ Folder shortcuts aren't supported prior to Windows 2000/Me. Fall back
to creating a normal shell link. }
Obj := nil;
end;
end;
if Obj = nil then begin
FolderShortcut := False;
Obj := CreateComObject(CLSID_ShellLink);
end;
SL := Obj as IShellLink;
SL.SetPath(PChar(ShortcutTo));
SL.SetArguments(PChar(Parameters));
if WorkingDir <> '' then
SL.SetWorkingDirectory(PChar(WorkingDir));
if IconFilename <> '' then
SL.SetIconLocation(PChar(IconFilename), IconIndex);
SL.SetShowCmd(ShowCmd);
if Description <> '' then
SL.SetDescription(PChar(Description));
if HotKey <> 0 then
SL.SetHotKey(HotKey);
PF := SL as IPersistFile;
{ When creating a folder shortcut on 2000/Me, IPersistFile::Save will strip
off everything past the last '.' in the filename, so we keep the .lnk
extension on to give it something harmless to strip off. XP doesn't do
that, so we must remove the .lnk extension ourself. }
if FolderShortcut and IsWindowsXP then
WideFilename := PathChangeExt(Filename, '')
else
WideFilename := Filename;
OleResult := PF.Save(PWideChar(WideFilename), True);
if OleResult <> S_OK then
RaiseOleError('IPersistFile::Save', OleResult);
Result := GetResultingFilename(PF, Filename);
{ Delphi 3 automatically releases COM objects when they go out of scope }
{$ENDIF}
end;
procedure RegisterTypeLibrary(const Filename: String);
{$IFNDEF Delphi3OrHigher}
var
WideFilename: PWideChar;
OleResult: HRESULT;
TypeLib: ITypeLib;
begin
WideFilename := StringToOleStr(PathExpand(Filename));
if WideFilename = nil then
OutOfMemoryError;
try
OleResult := LoadTypeLib(WideFilename, TypeLib);
if OleResult <> S_OK then
RaiseOleError('LoadTypeLib', OleResult);
try
OleResult := RegisterTypeLib(TypeLib, WideFilename, nil);
if OleResult <> S_OK then
RaiseOleError('RegisterTypeLib', OleResult);
finally
TypeLib.Release;
end;
finally
SysFreeString(WideFilename);
end;
end;
{$ELSE}
var
WideFilename: WideString;
OleResult: HRESULT;
TypeLib: ITypeLib;
begin
WideFilename := PathExpand(Filename);
OleResult := LoadTypeLib(PWideChar(WideFilename), TypeLib);
if OleResult <> S_OK then
RaiseOleError('LoadTypeLib', OleResult);
OleResult := RegisterTypeLib(TypeLib, PWideChar(WideFilename), nil);
if OleResult <> S_OK then
RaiseOleError('RegisterTypeLib', OleResult);
end;
{$ENDIF}
procedure UnregisterTypeLibrary(const Filename: String);
type
TUnRegTlbProc = function(const libID: TGUID; wVerMajor, wVerMinor: Word;
lcid: TLCID; syskind: TSysKind): HResult; stdcall;
{$IFNDEF Delphi3OrHigher}
var
UnRegTlbProc: TUnRegTlbProc;
WideFilename: PWideChar;
OleResult: HRESULT;
TypeLib: ITypeLib;
LibAttr: PTLibAttr;
begin
{ Dynamically import UnRegisterTypeLib since older OLEAUT32.DLL versions
don't have this function }
@UnRegTlbProc := GetProcAddress(GetModuleHandle('OLEAUT32.DLL'),
'UnRegisterTypeLib');
if @UnRegTlbProc = nil then
Win32ErrorMsg('GetProcAddress');
WideFilename := StringToOleStr(PathExpand(Filename));
if WideFilename = nil then
OutOfMemoryError;
try
OleResult := LoadTypeLib(WideFilename, TypeLib);
if OleResult <> S_OK then
RaiseOleError('LoadTypeLib', OleResult);
try
OleResult := TypeLib.GetLibAttr(LibAttr);
if OleResult <> S_OK then
RaiseOleError('ITypeLib::GetLibAttr', OleResult);
try
with LibAttr^ do
OleResult := UnRegTlbProc(Guid, wMajorVerNum, wMinorVerNum, LCID, SysKind);
if OleResult <> S_OK then
RaiseOleError('UnRegisterTypeLib', OleResult);
finally
TypeLib.ReleaseTLibAttr(LibAttr);
end;
finally
TypeLib.Release;
end;
finally
SysFreeString(WideFilename);
end;
end;
{$ELSE}
var
UnRegTlbProc: TUnRegTlbProc;
WideFilename: WideString;
OleResult: HRESULT;
TypeLib: ITypeLib;
LibAttr: PTLibAttr;
begin
{ Dynamically import UnRegisterTypeLib since older OLEAUT32.DLL versions
don't have this function }
@UnRegTlbProc := GetProcAddress(GetModuleHandle('OLEAUT32.DLL'),
'UnRegisterTypeLib');
if @UnRegTlbProc = nil then
Win32ErrorMsg('GetProcAddress');
WideFilename := PathExpand(Filename);
OleResult := LoadTypeLib(PWideChar(WideFilename), TypeLib);
if OleResult <> S_OK then
RaiseOleError('LoadTypeLib', OleResult);
OleResult := TypeLib.GetLibAttr(LibAttr);
if OleResult <> S_OK then
RaiseOleError('ITypeLib::GetLibAttr', OleResult);
try
with LibAttr^ do
OleResult := UnRegTlbProc(Guid, wMajorVerNum, wMinorVerNum, LCID, SysKind);
if OleResult <> S_OK then
RaiseOleError('UnRegisterTypeLib', OleResult);
finally
TypeLib.ReleaseTLibAttr(LibAttr);
end;
end;
{$ENDIF}
procedure InitOle;
var
OleResult: HRESULT;
begin
OleResult := CoInitialize(nil);
if FAILED(OleResult) then
raise Exception.CreateFmt('CoInitialize failed (0x%.8x)', [OleResult]);
{ ^ doesn't use a SetupMessage since messages probably aren't loaded
during 'initialization' section below, which calls this procedure }
end;
initialization
InitOle;
finalization
CoUninitialize;
end.

本站是提供个人知识管理的网络存储空间，所有内容均由用户发布，不代表本站观点。请注意甄别内容中的联系方式、诱导购买等信息，谨防诈骗。如发现有害或侵权内容，请点击一键举报。

转藏分享

QQ空间 QQ好友新浪微博微信

献花（0） +1

来自： quasiceo > 《delphi》

举报/认领

0条评论

请遵守用户评论公约

类似文章 更多

quasiceo

关注对话

TA的最新馆藏

[转] 又一个用了就离不开的Obsidian插件，真的太好用了
[转] 你想要的Obsidian文件（夹）排序终于来了！（文末福利）
[转] 暗时间管理术--高维度精准时间管理技巧让你真正实现人生高效能
[转] 用这个“两步走”策略，解决你遇到的所有问题
[转] 挣大钱的男人需要研究什么？绝不是钱？而是钱的本质：道法术器！
[转] 作为Ob玩家，不得不知的24个Obsidian使用技巧

喜欢该文的人也喜欢更多

热门阅读换一换