unit BDrvUtil;

interface

uses
  Windows, SysUtils, Registry, ComObj, Dialogs;

function GetDriverFileByCLSID(const CLSID: TGUID): String;
function CLSIDToLIBID(const CLSID: TGUID): TGUID;
// Производит регистрацию ActiveX по имени регистрируемого файла
function RegisterDriverByFileName(const FileName: String;
  const CLSID: TGUID): Boolean;
// Проверяет наличие файла драйвера
function HasDriverByCLSID(const CLSID: TGUID): Boolean;

// Функции для работы с EXE-серверами
function RegisterExeServer(const FileName: string): Boolean;
function GetExeDriverFileByCLSID(const CLSID: TGUID): String;
function RegisterExeDriverByFileName(const FileName: string;
  const CLSID: TGUID): Boolean;
function RunExeServerByCLSID(const CLSID: TGUID): Boolean;

function CLSIDToFileName(const CLSID: TGUID): String;

implementation

function ExtractQuotedStr(const Src: String): String;
begin
  Result := Src;
  if Src[1] = '"' then Delete(Result, 1, 1);;
  if Result[Length(Result)] = '"' then SetLength(Result, Length(Result) - 1);
end;

function CLSIDToFileName(const CLSID: TGUID): String;
var
  Reg: TRegistry;
  strCLSID: String;
begin
  Result := '';
  Reg := TRegistry.Create;
  try
    Reg.RootKey:= HKEY_CLASSES_ROOT;
    strCLSID := GUIDToString(CLSID);
    if Reg.OpenKey(Format('CLSID\%s\InProcServer32', [strCLSID]), False)
       or Reg.OpenKey(Format('CLSID\%s\LocalServer32', [strCLSID]), False) then
    begin
      try
        Result := ExtractQuotedStr(Reg.ReadString(''));
      finally
        Reg.CloseKey;
      end;
    end;
  finally
    Reg.Free;
  end;
end;

function GetDriverFileByCLSID(const CLSID: TGUID): String;
begin
  Result := CLSIDToFileName(CLSID);
end;

function GetExeDriverFileByCLSID(const CLSID: TGUID): String;
begin
  Result := CLSIDToFileName(CLSID);
end;

function CLSIDToLIBID(const CLSID: TGUID): TGUID;
var
  Reg: TRegistry;
begin
  Result := IUnknown;
  Reg := TRegistry.Create;
  try
    Reg.RootKey:= HKEY_CLASSES_ROOT;
    if Reg.OpenKey(Format('CLSID\%s\TypeLib', [GUIDToString(CLSID)]), False) then
    begin
      try
        Result := StringToGUID(ExtractQuotedStr(Reg.ReadString('')));
      finally
        Reg.CloseKey;
      end;
    end;
  finally
    Reg.Free;
  end;
end;

function HasDriverByCLSID(const CLSID: TGUID): Boolean;
begin
  Result := FileExists(GetDriverFileByCLSID(CLSID));
end;

// Производит регистрацию ActiveX по имени регистрируемого файла
function RegisterDriverByFileName(const FileName: string; const CLSID: TGUID): Boolean;
begin
  try
    RegisterComServer(FileName);
    Result := AnsiCompareFileName(GetDriverFileByCLSID(CLSID), FileName) = 0;
  except
    Result := False;
  end;
end;

function RegisterExeServer(const FileName: string): Boolean;
var
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
  Directory: String;
  Command: String;
begin
  Result := False;
  Directory := ExtractFilePath(FileName);
  Command := ExtractFileName(FileName) + ' /RegServer';

  FillChar(StartupInfo, SizeOf(StartupInfo) , 0 );
  with StartupInfo do
  begin
    cb := SizeOf(StartupInfo);
    dwFlags := STARTF_USESHOWWINDOW;
    wShowWindow := SW_HIDE;
  end;
  if CreateProcess(
       nil,             // lpApplicationName
       PChar(Command),              // lpCommandLine
       nil,                         // lpProcessAttributes
       nil,                         // lpThreadAttributes
       False,                       // bInheritHandles
       NORMAL_PRIORITY_CLASS,       // dwCreationFlags
       nil,                         // pEnvironment
       PChar(Directory),            // lpCurrentDirectory
       StartupInfo,                 // lpStartupInfo
       ProcessInfo)                 // lpProcessInformation
  then
  begin
    CloseHandle(ProcessInfo.hThread);
    WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
    CloseHandle(ProcessInfo.hProcess);
    Result := True;
  end;
end;

function RegisterExeDriverByFileName(const FileName: string;
  const CLSID: TGUID): Boolean;
begin
  try
    RegisterExeServer(FileName);
    Result := AnsiCompareFileName(GetExeDriverFileByCLSID(CLSID), FileName) = 0;
  except
    Result := False;
  end;
end;

function RunExeServerByCLSID(const CLSID: TGUID): Boolean;
var
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
  ApplicationName: String;
begin
  ApplicationName := GetExeDriverFileByCLSID(CLSID);

  FillChar(StartupInfo, SizeOf(StartupInfo) , 0 );
  with StartupInfo do
  begin
    cb := SizeOf(StartupInfo);
    // dwFlags := STARTF_USESHOWWINDOW;
    // wShowWindow := SW_SHOWDEFAULT;
  end;
  Result := CreateProcess(
       PChar(ApplicationName),      // lpApplicationName
       nil,                         // lpCommandLine
       nil,                         // lpProcessAttributes
       nil,                         // lpThreadAttributes
       False,                       // bInheritHandles
       NORMAL_PRIORITY_CLASS,       // dwCreationFlags
       nil,                         // pEnvironment
       nil,                         // lpCurrentDirectory
       StartupInfo,                 // lpStartupInfo
       ProcessInfo);                // lpProcessInformation
  if Result then
    WaitForInputIdle(ProcessInfo.hProcess, INFINITE)
  else
    RaiseLastWin32Error;  
  CloseHandle(ProcessInfo.hThread);
  CloseHandle(ProcessInfo.hProcess);
end;

end.