请问用程序怎么注册DLL的控件?(100分)

  • 主题发起人 主题发起人 星月
  • 开始时间 开始时间

星月

Unregistered / Unconfirmed
GUEST, unregistred user!
我有一个控件是DLL形式的。我想在程序开始时检测它是否已经注册。如果没有注册,则
使用程序注册。我找到的注册控件的代码。但是怎么调试也不通过
uses OLEctl,....
var
OCXHand: THandle;
RegFunc: TDllRegisterServer;
begin
OCXHand:= LoadLibrary('c:/temp/test.dll');
RegFunc:= GetProcAddress(OCXHand, 'DllRegisterServer')

if RegFunc <> 0 then ShowMessage('Error!');
FreeLibrary(OCXHand);
end;
老告诉没有TDllRegisterServer;定义。
另外,使用 RegSvr32 c:/temp/test.dll 这个命令可以注册这个控件。

我想知道使用程序怎么调用这个命令行,和在98,NT,2000下这个命令行都通用吗?

 
可以用WinExec来调用这个命令行
 
给你一个完整的注册函数:
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;
 
winexec('c:/windows/system/regsvr32 winflic.ocx',SW_HIDE);

 
winexec('c:/windows/system/regsvr32 c:/temp/test.dll' ,SW_HIDE);
 
uses ActiveX,....
var
OCXHand: THandle;
RegFunc: TDllRegisterServer;
begin
OCXHand:= LoadLibrary('c:/temp/test.dll');
RegFunc:= GetProcAddress(OCXHand, 'DllRegisterServer')

if RegFunc <> 0 then ShowMessage('Error!');
FreeLibrary(OCXHand);
end;
Delphi6.0下通过
 
regsvr32 有几个参数的, /s 参数会不知不觉的完成注册,没有如何提示信息,自己Run
一下regsvr32看看参数吧
 
谢谢大家。DreamTiger给了好长一段代码。我就多给他20分。
 
DreamTiger大侠,真是个大好人
 
在文件头加上ActiveX就OK
 
按Osiris说的就行了
 
我现在有一个网站空间的ISAPI权限,请问注册DLL(BCB下),
 
program TRegSvr;

{$APPTYPE CONSOLE}

uses
SysUtils, Windows, ActiveX, ComObj, RegConst;

type
TRegType = (rtAxLib, rtTypeLib, rtExeLib);
TRegAction = (raReg, raUnreg);
TRegProc = function : HResult
stdcall;
TUnRegTlbProc = function (const libID: TGUID
wVerMajor, wVerMinor: Word;
lcid: TLCID
syskind: TSysKind): HResult
stdcall;


const
ProcName: array[TRegAction] of PChar = (
'DllRegisterServer', 'DllUnregisterServer');
ExeFlags: array[TRegAction] of string = (' /regserver', ' /unregserver');

var
RegType: TRegType = rtAxLib;
RegAction: TRegAction = raReg;
QuietMode: Boolean = False;
FileName: string;
RegProc: TRegProc;
LibHandle: THandle;
OleAutLib: THandle;
UnRegTlbProc: TUnRegTlbProc;


procedure OutputStr(S: string);
begin
if not QuietMode then
begin
CharToOEM(PChar(S), PChar(S));
Writeln(S);
end;
end;

function DecodeOptions: Boolean;
var
i: Integer;
FileStart: Boolean;
Param, FileExt: string;
begin
Result := False;
if ParamCount = 0 then Exit;
FileName := '';
for i := 1 to ParamCount do
begin
Param := ParamStr(i);
FileStart := not (Param[1] in ['-', '/']);
if FileStart then
begin
if FileName = '' then FileName := Param
else FileName := FileName + ' ' + Param;
// strip open and/or close quote if present
if (FileName[1] = '"') then
begin
if (FileName[Length(FileName)] = '"') then
FileName := Copy(FileName, 2, Length(FileName) - 2)
else if FileName[1] = '"' then Delete(FileName, 1, 1);
end;
end
else
begin
if Length(Param) < 2 then Exit;
case Param[2] of
'U', 'u': RegAction := raUnreg;
'Q', 'q': QuietMode := True;
'T', 't': RegType := rtTypeLib;
end;
end;
end;
FileExt := ExtractFileExt(FileName);
if FileExt = '' then raise Exception.CreateFmt(SNeedFileExt, [FileName]);
if RegType <> rtTypeLib then
begin
if CompareText(FileExt, '.TLB') = 0 then RegType := rtTypeLib
else if CompareText(FileExt, '.EXE') = 0 then RegType := rtExeLib
else RegType := rtAxLib;
end;
Result := True;
end;

procedure RegisterAxLib;
begin
LibHandle := LoadLibrary(PChar(FileName));
if LibHandle = 0 then raise Exception.CreateFmt(SLoadFail, [FileName]);
try
@RegProc := GetProcAddress(LibHandle, ProcName[RegAction]);
if @RegProc = Nil then
raise Exception.CreateFmt(SCantFindProc, [ProcName[RegAction],
FileName]);
if RegProc <> 0 then
raise Exception.CreateFmt(SRegFail, [ProcName[RegAction], FileName]);
OutputStr(Format(SRegSuccessful, [ProcName[RegAction]]))
finally
FreeLibrary(LibHandle);
end;
end;

procedure RegisterTLB;
const
RegMessage: array[TRegAction] of string = (SRegStr, SUnregStr);
var
WFileName, DocName: WideString;
TypeLib: ITypeLib;
LibAttr: PTLibAttr;
DirBuffer: array[0..MAX_PATH] of char;
begin
if ExtractFilePath(FileName) = '' then
begin
GetCurrentDirectory(SizeOf(DirBuffer), DirBuffer);
FileName := '/' + FileName;
FileName := DirBuffer + FileName;
end;
if not FileExists(FileName) then
raise Exception.CreateFmt(SFileNotFound, [FileName]);
WFileName := FileName;
OleCheck(LoadTypeLib(PWideChar(WFileName), TypeLib));
OutputStr(Format(STlbName, [WFileName]));
OleCheck(TypeLib.GetLibAttr(LibAttr));
try
OutputStr(Format(STlbGuid, [GuidToString(LibAttr^.Guid)]) + #13#10);
if RegAction = raReg then
begin
OleCheck(TypeLib.GetDocumentation(-1, nil, nil, nil, @DocName));
DocName := ExtractFilePath(DocName);
OleCheck(RegisterTypeLib(TypeLib, PWideChar(WFileName), PWideChar(DocName)));
end
else begin
OleAutLib := GetModuleHandle('OLEAUT32.DLL');
if OleAutLib <> 0 then
@UnRegTlbProc := GetProcAddress(OleAutLib, 'UnRegisterTypeLib');
if @UnRegTlbProc = nil then raise Exception.Create(SCantUnregTlb);
with LibAttr^ do
OleCheck(UnRegTlbProc(Guid, wMajorVerNum, wMinorVerNum, LCID, SysKind));
end;
finally
TypeLib.ReleaseTLibAttr(LibAttr);
end;
OutputStr(Format(STlbRegSuccessful, [RegMessage[RegAction]]));
end;

procedure RegisterEXE;
var
SI: TStartupInfo;
PI: TProcessInformation;
RegisterExitCode: BOOL;
begin
FillChar(SI, SizeOf(SI), 0);
SI.cb := SizeOf(SI);
RegisterExitCode := Win32Check(CreateProcess(PChar(FileName), PChar(FileName + ExeFlags[RegAction]),
nil, nil, True, 0, nil, nil, SI, PI));
CloseHandle(PI.hThread);
CloseHandle(PI.hProcess);
if RegisterExitCode then
OutputStr(Format(SExeRegSuccessful, [PChar(FileName + ExeFlags[RegAction])]))
else
OutputStr(Format(SExeRegUnsuccessful, [PChar(FileName + ExeFlags[RegAction])]));
end;

begin
try
if not DecodeOptions then
raise Exception.Create(SAbout + #13#10 + SUsage);
OutputStr(SAbout);
if not FileExists(FileName) then
raise Exception.CreateFmt(SFileNotFound, [FileName]);
case RegType of
rtAxLib: RegisterAxLib;
rtTypeLib: RegisterTLB;
rtExeLib: RegisterEXE;
end;
except
on E:Exception do OutputStr(E.Message);
end;
end.
 
老兄,有简单的不用,非喜欢复杂的,wagxu和htw,都可以,非要那么长代码的
真有够苯的。你以为编程是卖冬储大白菜么?越多越好
 
我认为DreamTiger和htw的方法是最好的!不过我也没有这方面的经验!
 
DLL的注册会了!
可是怎么取消注册DLL阿?
 
风中的沙粒,DreamTiger和htw是怎么使用的,能给我一些资料吗?
谢谢!!!!
 
后退
顶部