// Register a DLL
function RegisterDLL(dllname:
string) : boolean ;
type
TRegFunc =
function : HResult;
stdcall;
var
ARegFunc : TRegFunc;
aHandle : THandle;
ocxPath :
string;
begin
try
Result := true ;
if DirectoryExists(ExtractFilePath(dllname))
then ocxPath := dllname
else ocxPath := ExtractFilePath(Application.ExeName) + dllname ;
aHandle := LoadLibrary(PChar(ocxPath));
if aHandle <> 0
then
begin
ARegFunc := GetProcAddress(aHandle,'
DllRegisterServer');
if Assigned(ARegFunc)
then
begin
ExecAndWait('
regsvr32','
/s "' + ocxPath + '
"');
end;
FreeLibrary(aHandle);
end
else
Result := false ;
except
Result := false ;
end;
end;
// Execute something and wait till finished
function ExecAndWait(
const ExecuteFile :
string;
const ParamString :
string = '
';
const ExecWindowStatus: Integer = SW_NORMAL): boolean;
var
SEInfo: TShellExecuteInfo;
ExitCode: DWORD;
begin
FillChar(SEInfo, SizeOf(SEInfo), 0);
SEInfo.cbSize := SizeOf(TShellExecuteInfo);
with SEInfo
do begin
fMask := SEE_MASK_NOCLOSEPROCESS;
Wnd := Application.Handle;
lpFile := PChar(ExecuteFile);
lpParameters := PChar(ParamString);
nShow := ExecWindowStatus;
end;
if ShellExecuteEx(@SEInfo)
then
begin
repeat
Application.ProcessMessages;
GetExitCodeProcess(SEInfo.hProcess, ExitCode);
sleep(1) ;
until (ExitCode <> STILL_ACTIVE)
or Application.Terminated;
Result:=True;
end
else Result:=False;
end;