我不知道BCB与Delphi在调用控件方面有什么区别,
但我在Delphi中是利用了[purple]Tom Lee[/purple]先生1997年写的一个控件来实现了Ocx的注册的,
我的感觉是这个控件相当好,甚至连M$的Mscomm(是需要一个Licence的控件)都注册上了
下面是[blue]该控件的原玛[/blue],看看是不是对你有帮助吧!
[
][
][8D][
][
!][^][?][?][^][
!][
][8D][
][
]
[green]
unit ActXInst;
// Auto ActiveX Controls Register/Unregsiter Component
// ver 1.03
// Last Modify 1997 JUN 28
// By Tom Lee (tom@libra.aaa.hinet.net)
// http://www.aaa.hinet.net/delphi ( Chinese BIG-5 Encoding Page )
// for Delphi 3
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, MyRegistry , ComObj, ActiveX
type
TOCXDirType=(dtSystem,dtWindows,dtApplication);
TActiveXInstaller = class(TComponent)
private
{ Private declarations }
FActive:Boolean;
FAllOcxCLSID:TStrings;
FAllOcxName:TStrings;
FAllOcxPath:TStrings;
FAutoRegList:TStrings;
FOCXDir:TOCXDirType;
function InstallOcx(const sFileName: AnsiString;bSetup: boolean): boolean;
procedure AutoRegOCX;
procedure ClearRegInfo;
procedure Dumb(value:TStrings);
procedure GetRegInfo;
procedure SetActive(value:Boolean);
procedure SetAutoRegList(value:TStrings);
procedure SetOCXDir(value:TOCXDirType);
protected
{ Protected declarations }
procedure Loaded;override;
public
{ Public declarations }
constructor Create(AOwner: TComponent)
override;
destructor Destroy
override;
procedure Refresh;
function OCXListUnregister(id:integer):Boolean;
function OCXFileRegister(FullPathFileName:String):Boolean;
function OCXFileUnRegister(FullPathFileName:String):Boolean;
function ShowRegDialog:Boolean;
function ShowUnRegDialog:Boolean;
function IsInstallOK(OCXFileName:String):Boolean;
published
{ Published declarations }
property Active:Boolean read FActive write SetActive default True;
property AutoRegister:TStrings read FAutoRegList write SetAutoRegList;
property OCXDir:TOCXDirType read FOCXDir write SetOCXDir default dtSystem;
property OCXCLSID:TStrings read FAllOcxCLSID write Dumb;
property OCXName:TStrings read FAllOcxName write Dumb;
property OCXFullPathName:TStrings read FAllOcxPath write Dumb;
end;
procedure Register;
implementation
constructor TActiveXInstaller.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FAllOcxCLSID:=TStringList.Create;
FAllOcxName:=TStringList.Create;
FAllOcxPath:=TStringList.Create;
FAutoRegList:=TStringList.Create;
FActive:=True;
FOCXDir:=dtSystem;
GetRegInfo;
end;
procedure TActiveXInstaller.Loaded;
begin
inherited;
if FActive then
begin
GetRegInfo;
AutoRegOCX;
end
else
ClearRegInfo;
end;
destructor TActiveXInstaller.Destroy;
begin
FAllOcxCLSID.Free;
FAllOcxName.Free;
FAllOcxPath.Free;
FAutoRegList.Free;
inherited Destroy;
end;
procedure TActiveXInstaller.Refresh;
begin
if FActive then GetRegInfo;
end;
procedure TActiveXInstaller.SetAutoRegList(value:TStrings);
begin
FAutoRegList.Clear;
FAutoRegList.Assign(value);
end;
procedure TActiveXInstaller.SetOCXDir(value:TOCXDirType);
begin
if value<>FOCXDir then FOCXDir:=value;
end;
function TActiveXInstaller.OCXListUnregister(id:integer):Boolean;
begin
if (FActive) and (id>=0) and (id<FAllOCXPath.Count) then
Result:=InstallOcx(FAllOCXPath[id],False)
else
Result:=False;
end;
function TActiveXInstaller.OCXFileUnRegister(FullPathFileName:String):Boolean;
begin
Result:=InstallOcx(FullPathFileName,False);
end;
function TActiveXInstaller.OCXFileRegister(FullPathFileName:String):Boolean;
begin
Result:=InstallOcx(FullPathFileName,True);
end;
function TActiveXInstaller.ShowRegDialog:Boolean;
begin
with TOpenDialog.Create(Self) do
begin
Title:='请选择需要注册的ActiveX控件';
Filter:='OCX 郎 (*.OCX)|*.OCX|DLL文件(*.DLL)|*.DLL|全部文件(*.*)|*.*';
if Execute then
Result:=InstallOcx(FileName,True)
else
Result:=False;
Free;
end;
end;
function TActiveXInstaller.ShowUnRegDialog:Boolean;
begin
with TOpenDialog.Create(Self) do
begin
Title:='请选择需要销册的ActiveX控件';
Filter:='OCX 郎 (*.OCX)|*.OCX|DLL文件(*.DLL)|*.DLL|全部文件(*.*)|*.*';
if Execute then
Result:=InstallOcx(FileName,False)
else
Result:=False;
Free;
end;
end;
procedure TActiveXInstaller.SetActive(value:Boolean);
begin
if Value<>FActive then
begin
FActive:=value;
if FActive then
begin
GetRegInfo;
AutoRegOCX;
end
else
ClearRegInfo;
end;
end;
procedure TActiveXInstaller.ClearRegInfo;
begin
FAllOcxCLSID.Clear;
FAllOcxName.Clear;
FAllOcxPath.Clear;
end;
procedure TActiveXInstaller.GetRegInfo;
var
tmpReg1,tmpReg2:TRegistry;
idx:integer;
begin
ClearRegInfo;
// Get All CLSID
tmpReg1 := TRegistry.Create;
tmpReg1.Access := KEY_READ
tmpReg1.RootKey := HKEY_CLASSES_ROOT;
if tmpReg1.OpenKey('/CLSID', False) then
begin
tmpReg1.GetKeyNames(FAllOcxCLSID);
FAllOcxName.Assign(FAllOcxCLSID);
FAllOcxPath.Assign(FAllOcxCLSID);
end;
tmpReg1.Free;
// Get All ActiveX Controls CLSID,Name,Full Path Name
for idx:=FAllOcxCLSID.Count-1 downto 0 do
begin
tmpReg1 := TRegistry.Create;
tmpReg1.Access := KEY_READ
tmpReg1.RootKey := HKEY_CLASSES_ROOT;
if not tmpReg1.KeyExists('/CLSID/'+FAllOcxCLSID[idx]+'/Control') then
begin
FAllOcxCLSID.Delete(idx);
FAllOcxName.Delete(idx);
FAllOcxPath.Delete(idx);
end
else
begin
tmpReg1.OpenKey('/CLSID/'+FAllOcxCLSID[idx],False);
FAllOcxName[idx]:=tmpReg1.ReadString('');
tmpReg2 := TRegistry.Create;
tmpReg2.Access := KEY_READ
tmpReg2.RootKey := HKEY_CLASSES_ROOT;
tmpReg2.OpenKey('/CLSID/'+FAllOcxCLSID[idx]+'/InprocServer32',False);
FAllOcxPath[idx]:=tmpReg2.ReadString('');
tmpReg2.Free;
end;
tmpReg1.Free;
end;
end;
procedure TActiveXInstaller.Dumb(value:TStrings);
begin
end;
function TActiveXInstaller.IsInstallOK(OCXFileName:String):Boolean;
var
idx:integer;
begin
for idx:=0 to FAllOcxPath.Count-1 do
begin
if UpperCase(ExtractFileName(FAllOcxPath[idx]))=UpperCase(OCXFileName) then
begin
Result:=True;
exit;
end;
end;
result:=False;
end;
procedure TActiveXInstaller.AutoRegOCX;
var
idx1,idx2,size:integer;
Buf
Char;
Dir:string;
tmpOCXList:TStringList;
begin
Buf:=nil;
if not (csDesigning in ComponentState) then
begin
tmpOCXList:=TStringList.Create;
tmpOCXList.Assign(FAutoRegList);
for idx1:=0 to FAllOcxPath.Count-1 do
begin
for idx2:=tmpOCXList.Count-1 downto 0 do
begin
if UpperCase(ExtractFileName(FAllOcxPath[idx1]))=UpperCase(tmpOCXList[idx2]) then
tmpOCXList.Delete(idx2);
end;
end;
if tmpOCXList.Count>0 then
begin
size:=MAX_PATH;
setlength(Dir,size);
for idx1:=0 to tmpOCXList.Count-1 do
begin
case FOCXDir of
dtSystem:
begin
try
GetMem(Buf,Size);
GetSystemDirectory(Buf,size);
Dir:= StrPas(Buf);
finally
FreeMem(Buf);
end;
try
OCXFileRegister(Dir+'/'+tmpOCXList[idx1]);
except
on E:exception do
MessageDlg(tmpOCXList[idx1]+'自动注册未成功('+E.Message+')',mtWarning,[mbOk],0);
end;
end;
dtWindows:
begin
try
GetMem(Buf,Size);
GetWindowsDirectory(Buf,size);
Dir:= StrPas(Buf);
finally
FreeMem(Buf);
end;
try
OCXFileRegister(Dir+'/'+tmpOCXList[idx1]);
except
on E:exception do
MessageDlg(tmpOCXList[idx1]+'自动注册未成功('+E.Message+')',mtWarning,[mbOk],0);
end;
end;
dtApplication:
begin
Dir:=ExtractFilePath(Application.EXEName);
try
OCXFileRegister(Dir+'/'+tmpOCXList[idx1]);
except
on E:exception do
MessageDlg(tmpOCXList[idx1]+'自动注册未成功('+E.Message+')',mtWarning,[mbOk],0);
end;
end;
end;
end;
GetRegInfo;
end;
tmpOCXList.Free;
end;
end;
function TActiveXInstaller.InstallOcx(const sFileName: AnsiString;bSetup: boolean): boolean;
var
hOcx: THandle;
funcRegister: TDllRegisterServer;
funcUnRegister: TDllUnRegisterServer;
begin
Result := False;
// Check File Exist ?
if not FileExists(sFileName) then
Raise EOleError.CreateFmt('%s不存在，无法载入', [sFileName]);
// Load a ActiveX File (.OCX , .DLL )
hOcx := LoadLibrary(pchar(sFileName));
if hOcx < 32 then
Raise EOleError.CreateFmt('无法载入文件，请检查%s请检查是否为.Ocx或.Dll格式', [sFileName]);
try
// uses DllRegisterServer get call address
if bSetup then
begin
funcRegister := GetProcAddress(hOcx, 'DllRegisterServer');
if @funcRegister = nil then
Raise EOleError.CreateFmt('无法载入%s中的DllRegisterServer，请确认此文件为Self-Register类型的OCX控件',[sFileName]);
// Execute DllRegisterServer
Result := funcRegister = S_OK;
end
else
begin
funcUnRegister := GetProcAddress(hOcx, 'DllUnregisterServer');
if @funcUnRegister = nil then
Raise EOleError.CreateFmt('无法载入%s中的DllUnRegisterServer，请确认此文件为Self-UnRegister类型的OCX控件',[sFileName]);
// Execute DllUnregisterServer
Result := funcUnRegister = S_OK;
end;
// Prompt Error Message
if not Result then
begin
if bSetup then
Raise EOleError.CreateFmt('无法登陆注册%s', [sFileName])
else
Raise EOleError.CreateFmt('无法取消注册%s', [sFileName]);
end;
finally
FreeLibrary(hOcx);
end;
end;
procedure Register;
begin
RegisterComponents('Win32', [TActiveXInstaller]);
end;
end.
[/green]
