怎样在程序里面向系统注册一个cab包或者dll?

Question

如题。

Answer 1

如果不用regsvr32的话，你看一下以下的资料，我没试过ＯＬＥ／ＣＯＭ控件是需要首先注册才能使用的。通常使用ＯＬＥ／ＣＯＭ控件，首先需要用ＷＩＮＤＯＷＳ自己提供的注册程序RegSvr32.EXE来注册或卸载，如“RegSvr32.EXE Mp3Play.OCX”或“RegSvr32.EXE Mp3Play.OCX /u”。不过如果要求我们的软件用户自己来注册ＯＬＥ／ＣＯＭ控件，那可不是一个好主意，因为我们完全可以自己在程序中注册ＯＬＥ／ＣＯＭ控件的。下面将讨论如何在ＤＥＬＰＨＩ程序中注册最为常见的ＤＬＬ／ＯＣＸ类型的ＯＬＥ／ＣＯＭ控件。
一、注册ＯＬＥ／ＣＯＭ控件的原理　　在标准ＯＬＥ／ＣＯＭ控件中，有两个函数DllRegisterServer、DllUnregisterServer可调用，其中DllRegisterServer函数用于注册ＯＬＥ／ＣＯＭ控件，DllUnregisterServer用于卸载ＯＬＥ／ＣＯＭ控件，两个函数的原型均为：function : HResult。我们可用LoadLibrary装载ＤＬＬ／ＯＣＸ文件，用GetProcAddress获取DllRegisterServer和DllUnregisterServer两个函数的指针，然后再直接运行这两个函数即可实现注册和卸载ＯＬＥ／ＣＯＭ控件的操作，从而代替ＷＩＮＤＯＷＳ系统的RegSvr32.exe实现ＯＬＥ／ＣＯＭ控件的注册和卸载。
二、实现过程　　上面的原理很简单，实现起来也就不难了，前提是必须熟悉动态加载ＤＬＬ函数的过程。具体的实现过程我们可以通过下面的程序代码及注释来理解。{ 注册一个DLL形式或OCX形式的OLE/COM控件参数strOleFileName为一个DLL或OCX文件名，参数OleAction表示注册操作类型，1表示注册，0表示卸载返回值True表示操作执行成功，False表示操作执行失败}function RegisterOleFile (strOleFileName : STRING; OleAction : Byte ) : BOOLEAN;constRegisterOle = 1;//注册UnRegisterOle = 0;//卸载typeTOleRegisterFunction = function : HResult;//注册或卸载函数的原型varhLibraryHandle : THandle;//由LoadLibrary返回的DLL或OCX句柄hFunctionAddress: TFarProc;//DLL或OCX中的函数句柄，由GetProcAddress返回RegFunction : TOleRegisterFunction;//注册或卸载函数指针beginResult := FALSE;//打开OLE/DCOM文件，返回的DLL或OCX句柄hLibraryHandle := LoadLibrary(PCHAR(strOleFileName));if (hLibraryHandle > 0) then//DLL或OCX句柄正确try//返回注册或卸载函数的指针if (OleAction = RegisterOle) then//返回注册函数的指针hFunctionAddress := GetProcAddress(hLibraryHandle, pchar('DllRegisterServer'))else//返回卸载函数的指针hFunctionAddress := GetProcAddress(hLibraryHandle, pchar('DllUnregisterServer'));if (hFunctionAddress <> NIL) then//注册或卸载函数存在beginRegFunction := TOleRegisterFunction(hFunctionAddress);//获取操作函数的指针if RegFunction >= 0 then //执行注册或卸载操作，返回值>=0表示执行成功result := true;end;finallyFreeLibrary(hLibraryHandle);//关闭已打开的OLE/DCOM文件end;end;
三、应用举例　　在我们的应用例子中，OpenDialog1（TOpenDialog）用于选择一个DLL/COM文件，editOleFileName（TEdit）用于保存DLL/COM文件名称，radiogroupOleAction（TRadioGroup）用于选择操作类型（０－卸载、１－注册），memo1（TMemo）用来显示操作成功或失败的信息。具体的例子还是看程序源码吧。
//选择一个DLL/COM文件procedure TForm1.Button2Click(Sender: TObject);beginif OpenDialog1.execute then //指定一个DLL/COM文件editOleFileName.text := OpenDialog1.FileName ;end;
//注册一个DLL形式或OCX形式的OLE/COM控件procedure TForm1.Button1Click(Sender: TObject);beginif editOleFileName.text = '' then exit;//没有指定文件名则不予处理if RegisterOleFile( editOleFileName.text, radiogroupOleAction.ItemIndex )then//操作成功memo1.lines.add( DatetimeToStr( now ) + '----'+ editOleFileName.text+ radiogroupOleAction.Items[ radiogroupOleAction.ItemIndex ] + '成功！' )else//操作失败memo1.lines.add( DatetimeToStr( now ) + '----'+ editOleFileName.text+ radiogroupOleAction.Items[ radiogroupOleAction.ItemIndex ] + '失败！' );end;
　　把注册ＯＬＥ／ＣＯＭ控件功能作成一个ＯＬＥ／ＣＯＭ或一般的ＤＬＬ供其它程序调用，可以使其它应用程序也具有注册ＯＬＥ／ＣＯＭ控件的功能。

Answer 2

在程序里向系统注册dll
源码如下:type
  TForm1 = class(TForm)
    Button2: TButton;
    Edit1: TEdit;
    ......function RegisterActiveX(const FileName: string;Unregister:Boolean): Boolean;
var
  SystemDir: string;  function NormalDir(const DirName: string): string;
  begin
    Result := DirName;
    if (Result <> '') and not (Result[Length(Result)] in [':', '\']) then
    begin
      if (Length(Result) = 1) and (UpCase(Result[1]) in ['A'..'Z']) then
        Result := Result + ':\'
      else
        Result := Result + '\';
    end;
  end;  function GetSystemDir: string;
  var
    Buffer: array[0..1023] of Char;
  begin
    SetString(Result, Buffer, GetSystemDirectory(Buffer, SizeOf(Buffer)));
  end;
  
  function RegisterIt(const FileName: string): Boolean;
  var
    si: TStartupInfo;
    pi: TProcessInformation;
  begin
    FillChar(si, SizeOf(si), 0);
    with si do
    begin
      cb          := SizeOf(si);
      wShowWindow := SW_HIDE;
      dwFlags     := STARTF_USESHOWWINDOW;
    end;
    if Unregister then
      Result := CreateProcess(PChar(SystemDir + 'RegSvr32.exe'),
                              PChar(' /s /u "' + FileName + '"'),
                              nil, nil, False, 0, nil, nil, si, pi)
    else
      Result := CreateProcess(PChar(SystemDir + 'RegSvr32.exe'),
                              PChar(' /s "' + FileName + '"'),
                              nil, nil, False, 0, nil, nil, si, pi);  end;
begin
  SystemDir := NormalDir(GetSystemDir);
  if FileExists(FileName) then
    Result := RegisterIt(FileName)
  else
    Result := false;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
  RegisterActiveX(Edit1.text,False);
end;
end.请加分,我一直在用!