Консультация № 136487
12.05.2008, 15:45
50.00 руб.
0 4 1
Необходимо разобраться в программе TRegSvr.dpr (папка вашего компилятора: \Borland\Delphi7\Demos\ActiveX\TRegSvr). В чём заключается функция программы и папки в целом. Прокомментируйте построчно если возможно:<p><fieldset style=‘background-color:#EFEFEF; width:80%; border:1px solid; padding:10px;‘ class=fieldset><font color=#777777><i>Код перенесен в приложение.</i>
-----
</font><font size=1 color=#777777><b>• Отредактировал: <a href=http://rusfaq.ru/info/user/18359 target=_blank>Николай Владимирович / Н.В.</a></b> (Профессор)
<b>• Дата редактирования:</b> 13.05.2008, 20:51</font></fieldset>

Приложение:
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.

Обсуждение

Неизвестный
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.
Неизвестный
12.05.2008, 20:44
общий
Если есть какие-то отдельные вопросы по данному коду, задавайте в мини-форум, не стесняйтесь.
Неизвестный
12.05.2008, 21:10
общий
Здравствуйте, спасиба за помощь - появились некоторые вопросы:1. что за "тихий режим"?2. что такое ParamCount в функции function DecodeOptions: Boolean; - обозначено как строка - для чего она, что определяет?
Неизвестный
12.05.2008, 23:21
общий
"Тихий режим" - это когда программа не выводит в консоль никаких сообщений.Как строка обозначена не ParamCount, а Param. ParamCount - это стандартная функция:<code><b>function</b> ParamCount: Integer;</code>Данная функция возвращает количество параметров запуска.Чтобы считать эти параметры, используется функция ParamStr:<code><b>function</b> ParamStr(ParmIndex: Integer): <b>String</b>;</code>
Форма ответа