📄 ucommandparameters.pas
字号:
{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 + -