12.05.2008, 20:43
общий
это ответ
<i>Здравствуйте, <b>Mirimas</b>!</i>
Код с комментариями находится в приложении.
По своей сути, программа TRegSvr является аналогом программы <a target=_blank href=http://support.microsoft.com/kb/249873/ru>RegSvr32</a> от Microsoft.
Основные функции программы:
DecodeOptions - анализирует параметры запуска.
RegisterAxLib - производит регистрацию или отмену регистрации DLL или OCX файла путем вызова одной из ее функций: DllRegisterServer или DllUnRegisterServer соответственно.
RegisterTLB - регистрация или ее отмена TLB (Type Library) файла путем вызова функции RegisterTypeLib или функции UnRegisterTypeLib библиотеки OLEAUT32.
RegisterEXE - регистрация или ее отмена EXE-файла путем запуска данного файла с параметрами /regserver или /unregserver
<em>Удачи!</em>
Приложение:
program TRegSvr;// Тип приложения - консольный{$APPTYPE CONSOLE}...// Процедура вывода текстаprocedure OutputStr(S: string);begin // Если "тихий режим", // то ничего не выводим if not QuietMode then begin // Преобразуем текст в DOS-кодировку 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; // Убираем двойные кавычки из // начала и конца имени файла 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; // Тип файла - TLB ‘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;// Регистрация ActiveX библиотеки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;// Регистрация TLB-файла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 // Подключаемся к библиотеке OLEAUT32.DLL OleAutLib := GetModuleHandle(‘OLEAUT32.DLL‘); // Получаем адрес функции отмены регистрации if OleAutLib <> 0 then @UnRegTlbProc := GetProcAddress(OleAutLib, ‘UnRegisterTypeLib‘); if @UnRegTlbProc = nil then raise Exception.Create(SCantUnregTlb); // Отменяем регистрацию TLB with LibAttr^ do OleCheck(UnRegTlbProc(Guid, wMajorVerNum, wMinorVerNum, LCID, SysKind)); end; finally TypeLib.ReleaseTLibAttr(LibAttr); end; OutputStr(Format(STlbRegSuccessful, [RegMessage[RegAction]]));end;// Регистрация EXE-файлаprocedure RegisterEXE;var SI: TStartupInfo; PI: TProcessInformation; RegisterExitCode: BOOL;begin FillChar(SI, SizeOf(SI), 0); SI.cb := SizeOf(SI); // Запускаем EXE файл с соответствующими параметрами 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 // Регистрируем ActiveX библиотеку rtAxLib: RegisterAxLib; // Регистрируем TLB-файл rtTypeLib: RegisterTLB; // Регистрируем EXE-файл rtExeLib: RegisterEXE; end; except // Если произошла ошибка, // выводим соответствующее сообщение on E:Exception do OutputStr(E.Message); end;end.