⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 ucommandparameters.pas

📁 DelphiDoc is a program for automatic generation of documentation on a Delphi-Project. At the momen
💻 PAS
📖 第 1 页 / 共 3 页
字号:

 {Handles the next parameter. }
 procedure HandleNextParameter;
 var       Parameter          :String;   //the next parameter
 begin
  Parameter := FParameters[0];           //get the next one
  FParameters.Delete(0);
  //is a valid option?
  if (Parameter = '') or not (Parameter[1] in OptionPrefixCharacters) then
   ErrorFmt('Parameter does not start with "-" or value without parameter found: "%s"!',
            [Parameter])
  else                                     //is a long option?
   if (Parameter[1] = '-') and (Parameter[2] = '-') then
    HandleLongParameter(Copy(Parameter, 3, High(Length(Parameter))))
   else
    begin
     //just assign the short parameters and let it be handled in the next
     //iteration
     FShortParameters := Copy(Parameter, 2, High(Length(Parameter)));
     if FShortParameters = '' then           //no options after character?
      ErrorFmt('Option character "%s" found, but no option characters followed!!',
               [Parameter]);

     HandleShortParameter;                   //handle the next one
    end;
 end;


begin
 Result := True;                       //not aborted so far
 repeat                                //until parameters handled or aborted
   if FShortParameters <> '' then        //short options still available?
    HandleShortParameter                   //handle the next one
   else
    if FParameters.Count > 0 then          //other parameters available?
     HandleNextParameter;                    //handle the next one

   //until error occured or pause requested, or all parameters handled
 until not Result or ((FShortParameters = '') and (FParameters.Count = 0));
end;

















































{$IFNDEF LINUX}



{Checks whether the file is associated with this program.
~param Kind   the kind of the file to check for association
~param Status out: a text expressing the status of the association
~result if the file type is associated with this program }
function GetFileExtRegisterState(Kind: TDelphiDocFile;
                                 var Status: String): Boolean;
var      Reg                    :TRegistry;  //object to access the registry
         S                      :String;     //associated program
         i                      :Integer;    //index of end of the program
begin
 Result := False;                            //no association found so far

 Reg := TRegistry.Create;                    //"open" the registry
 try
   Reg.RootKey := HKEY_CLASSES_ROOT;         //dealing with file extensions

   //open the file extension
   if not Reg.OpenKeyReadOnly('\' + DelphiDocFiles[Kind].Extension) then
    Status := 'Not registered.'
   else
    //check if it is registered as the correct file type
    if Reg.ReadString('') <> DelphiDocFiles[Kind].RegType then
     Status := 'Registered, but not with DelphiDoc.'
    else
     begin
      //read program associated with the file type
      if not Reg.OpenKeyReadOnly('\' + DelphiDocFiles[Kind].RegType +
                                 '\shell\open\command\') then
       Status := 'Invalid registered!'
      else
       begin
        S := Reg.ReadString('');                     //read the program

        if (S <> '') and (S[1] = '"') then           //name is quoted?
         begin
          Delete(S, 1, 1);
          i := pos('"', S)                             //search end of quote
         end
        else
         i := Pos(' ', S);                             //search end of program

        S := Copy(S, 1, i - 1);                      //get the program name

        Result := CompareText(S, ParamStr(0)) = 0;   //is this program?
        if Result then
         Status := 'Registered!'
        else
         begin
          S := LowerCase(Copy(ExtractFileName(S), 1, 8));
          if (S = 'delphidoc') or (Copy(S, 1, 4) = 'jadd') then
           Status := 'Registered with another DelphiDoc.'
          else
           Status := 'Registered with another program!'
         end; //else Result
       end; //if not Reg.OpenKeyReadOnly "file type"
     end; //if Reg.ReadString('') <> DelphiDocFiles[Kind].RegType

 finally
  Reg.Free;                                  //"close" the registry
 end;
end;


{Registers the file association with this program.
~param Kind the kind of the file to associate with this program }
procedure RegisterExtension(Kind: TDelphiDocFile);
var       FileType         :String;          //the name of the file type
          Reg              :TRegistry;       //object to access the registry
          S                :String;          //previous file type
begin
 FileType := DelphiDocFiles[Kind].RegType;   //get the file type

 Reg := TRegistry.Create;                    //"open" the registry
 try
   Reg.RootKey := HKEY_CLASSES_ROOT;         //dealing with file extensions

   //go to the file extension
   if not Reg.OpenKey('\' + DelphiDocFiles[Kind].Extension, True) then
    raise Exception.CreateFmt('Can''t create/change to file extension ("\%s").',
                              [DelphiDocFiles[Kind].Extension]);

   S := Reg.ReadString('');                  //get previous file type
   if (S <> '') and (S <> FileType) then     //other file type?
    Reg.WriteString(SavePreviousTypeKeyName, S);  //save the type for restore
   Reg.WriteString('', FileType);            //set the new file type

   //got to the file type
   if not Reg.OpenKey('\' + FileType, True) then
    raise Exception.CreateFmt('Can''t create/change to file type ("\%s").',
                              [FileType]);
   Reg.WriteString('', DelphiDocFiles[Kind].Description); //write description

   if not Reg.OpenKey('shell', True) then    //the shell is important
    raise Exception.CreateFmt('Can''t create/change to commands ("\%s\shell").',
                              [FileType]);

   if not Reg.OpenKey('open', True) then     //and especially opening files
    raise Exception.CreateFmt('Can''t create/change to open command ("\%s\shell\open").',
                              [FileType]);
   //write menu item caption
   Reg.WriteString('', DelphiDocFiles[Kind].OpenCaption);

   if not Reg.OpenKey('command', True) then  //and the command to open
    raise Exception.CreateFmt('Can''t create/change to open command ("\%s\shell\open\command").',
                              [FileType]);
   if DelphiDocFiles[Kind].Parameter <> '' then  //write the command
    Reg.WriteString('', Format('"%s" %s "%%1"',
                               [ParamStr(0), DelphiDocFiles[Kind].Parameter]))
   else
    Reg.WriteString('', Format('"%s"', [ParamStr(0)]));



   //go to the location to set the default icon
   if not Reg.OpenKey('\' + FileType + '\DefaultIcon', True) then
    raise Exception.CreateFmt('Can''t create/change to icon ("\%s\DefaultIcon").',
                              [FileType]);
   Reg.WriteString('', Format('%s,%d',       //write the icon
                              [ParamStr(0), DelphiDocFiles[Kind].Icon]));
 finally
  Reg.Free;                                  //"close" the registry
 end;

 //notify the system, that file associations have been changed
 SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, nil, nil);
end;



{Unregisters the file association with this program.
~param Kind the kind of the file to remove the association to this program
            from }
procedure UnregisterExtension(Kind: TDelphiDocFile);
var       Reg                :TRegistry;     //object to access the registry
          S                  :String;        //previous file type
begin
 Reg := TRegistry.Create;                    //"open" the registry
 try
   Reg.RootKey := HKEY_CLASSES_ROOT;         //dealing with file extensions

                                             //delete the file type
   if Reg.OpenKey('\' + DelphiDocFiles[Kind].RegType, False) and
      not Reg.DeleteKey('\' + DelphiDocFiles[Kind].RegType) then
    raise Exception.CreateFmt('Can''t delete the file type ("\%s").',
                              [DelphiDocFiles[Kind].RegType]);

   //go to the file extension, if file extension associated with own file type
   if Reg.OpenKey('\' + DelphiDocFiles[Kind].Extension, False) and
      (Reg.ReadString('') = DelphiDocFiles[Kind].RegType) then
    begin
     S := Reg.ReadString(SavePreviousTypeKeyName); //get the previous file type
     if S <> '' then                               //was previously associated?
      begin
       Reg.WriteString('', S);                       //set the old file type
       //and delete the restore-value
       if not Reg.DeleteValue(SavePreviousTypeKeyName) then
        raise Exception.CreateFmt('Can''t delete the previous value ("\%s\%s").',
                                  [DelphiDocFiles[Kind].Extension,
                                   SavePreviousTypeKeyName]);
      end
     else
      //delete whole extension
      if not Reg.DeleteKey('\' + DelphiDocFiles[Kind].Extension) then
       raise Exception.CreateFmt('Can''t delete the file extension ("\%s").',
                                 [DelphiDocFiles[Kind].Extension]);
    end;

 finally
  Reg.Free;                                  //"close" the registry
 end;

 //notify the system, that file associations have been changed
 SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, nil, nil);
end;






{$ENDIF}
















{Shows DelphiDoc's homepage.
~param HelpContext help context to use in case of an error
~param SubURI      string to append to the base URI to go to a specific page
                   and/or topic }
procedure ShowDelphiDocProjectPage(HelpContext: THelpContext;
                                   const SubURI: String = '');
begin
{$IFNDEF LINUX}
 //launch browser with the URI
 if ShellExecute(Application.Handle, nil,
                 PChar('http://delphidoc.sourceforge.net/' + SubURI), nil, nil,
                 SW_SHOWNORMAL) <= 32 then
  raise Exception.CreateFmtHelp('Can''t launch browser: GetLastError: %d'#13'%s',
                                [GetLastError, SysErrorMessage(GetLastError)],
                                HelpContext);
{$ENDIF}
end;

{Shows DelphiDoc's documentation.
~param HelpContext help context to use in case of an error
~param DocFile     file in the documentation to show }
procedure ShowDocumentation(HelpContext: THelpContext; DocFile: String = '');
{$IFNDEF LINUX}
var       Path             :String;             //the path to the documentation
{$ENDIF}
begin
{$IFNDEF LINUX}
 if DocFile = '' then                           //no file specified?
  DocFile := DocumentationMainFile;               //use the default/index file
 //check if directory with documentation exists
 Path := ExtractFilePath(ParamStr(0)) + DocumentationSubDir;
 if not FileExists(Path + PathDelimiter + DocFile) then
  begin
   //if not ask, if the project page should be opened
   if MessageDlg('Documentation not found!' + LineDelimiter + 
                 'Do you want to to visit DelphiDoc''s project page and maybe take a look at the documentation there or download a new, complete version?',
                 mtError, [mbOK, mbCancel], HelpContext) = mrOK then
    //open the project page
    ShowDelphiDocProjectPage(HelpContext);
  end
 else
  if ShellExecute(Application.Handle, nil,       //start/show the file
                  PChar(Path + PathDelimiter + DocFile), nil, PChar(Path),
                  SW_SHOWNORMAL) <= 32 then
   raise Exception.CreateFmtHelp('Can''t launch documentation: GetLastError: %d'#13'%s',
                                 [GetLastError, SysErrorMessage(GetLastError)],
                                 HelpContext);
{$ENDIF}
end;











{$IFOPT C+}

{Checks the declaration of the parameters for this program for their sanity. }
procedure CheckLongParameters;
var       i, j    :TParameter;    //counter through parameter declarations
          k       :Integer;       //counter through characters
begin
 //make sure no option starts with the text of another option
 for i := Low(ParameterEntries) to High(ParameterEntries) do
  for j := Low(ParameterEntries) to High(ParameterEntries) do
   Assert(StartsTextWith(ParameterEntries[i].LongName,
                         ParameterEntries[j].LongName) = (i = j));

 //make sure no short option character is used for more than one option
 for i := Low(ParameterEntries) to High(ParameterEntries) do
  for j := Low(ParameterEntries) to High(ParameterEntries) do
   if i <> j then
    for k := 1 to Length(ParameterEntries[i].ShortChars) do
     Assert(Pos(ParameterEntries[i].ShortChars[k],
                ParameterEntries[j].ShortChars) = 0);
end;


initialization
 CheckLongParameters;      //check the declaration of the parameters

{$ENDIF}
end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -