uses FileUtil, LCLIntf; // probably a few more needed here ...
....
function OpenFileLink(LinkText : string) : boolean;
var
i : integer;
Msg : string;
{$ifdef WINDOWS} // in Windows, any file is potentially executable, we'll test by extension
function WindowsFileIsExecutable() : boolean; // True if file has extension mentioned in PATHEXT
var WinExeExt, Extension : string;
begin
WinExeExt := GetEnvironmentVariable('PATHEXT');
// WinExeExt := '.COM;.EXE;.BAT;.CMD;.VBS;.VBE;.JS;.JSE;.WSF;.WSH'; // just for testing purposes !!!!
if WinExeExt = '' then
exit(false); // var not set, we will not test or warn for executable
WinExeExt := WinExeExt + ';';
Extension := ExtractFileExt(LinkText);
if Extension = '' then
exit(False); // Again, not enough info, will not test or warn for executable
Extension := uppercase(Extension) + ';';
Result := (pos(Extension, WinExeExt) <> 0);
end;
{$endif}
begin
result := True;
if LinkText.StartsWith(FileLinkToken) then
LinkText := LinkText.Remove(0, FileLinkTokenLen)
else exit; // thats an error, should not happen.
if (LinkText = '') or (LinkText = '""') then begin
showmessage(' Empty Link ');
exit;
end; // OK, we know its not empty, but does it use " ?
if (LinkText[1] = '"') then begin // Ah, wrapped in ".."
LinkText := LinkText.Remove(0, 1); // Lazarus code will re-wrap the text later in process
i := LinkText.IndexOf('"', 0); // Must have a second "
if i = -1 then begin
showmessage('Badly formed link : '#10 + LinkText);
exit;
end;
LinkText := LinkText.Remove(i, 99); // remove second " and anything after it too
end;
if LinkText = '' then begin // Probably redundant .....
showmessage('Empty Link');
exit;
end;
{ its not an absolute path (and therefore needs $HOME) if it does not start with a slash or eg c:/
So, prepend $HOME if it does not start with either a slash or ?: ! }
// Is it an absolute path, if not, prepend $HOME
if not (LinkText[1] in ['\', '/']) then begin // Relative path if first char after token is not a slash
{$ifdef WINDOWS} // it might still be an absolute path, starts with eg c:\ ?
if (length(LinkText) < 4) // too short
or (LinkText[2] <> ':') then // not a drive specifier, not much of a test but its windows !
LinkText := Sett.HomeDir + LinkText;
{$else}
LinkText := Sett.HomeDir + LinkText;
{$endif}
end;
if not (FileExists(LinkText) or DirectoryExists(LinkText)) then begin
showmessage('File does not exist : '#10 + LinkText);
exit;
end;
{$ifdef WINDOWS}
// 'Executable' on Windows is a dogs breakfast. https://forum.lazarus.freepascal.org/index.php/topic,24615.0.html
if WindowsFileIsExecutable() then begin
{$else}
if FileIsExecutable(LinkText) then begin
{$endif}
Msg := 'Link is an executable file.';
if IDYES <> Application.MessageBox('Open an executable ?'
,pchar(Msg) , MB_ICONQUESTION + MB_YESNO) then
exit;
end;
if not OpenDocument(LinkText) then
showmessage('Sorry, cannot open '#10 + LinkText);
end;
Recent
