标签：end XdgMimeContent Add lazarus XdgDesktopFile linux XdgDesktopContent 快捷方式 aDire
为lazarus生成的linux程序提供相关的快捷访问方式，参考fpcupdeluxe源码，编写了一个通用的CreateDesktopShortCut，只要调用CreateDesktopShortCut就可以生成相应的快捷方式及文件关联。
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, Buttons,
IniFiles, BaseUnix, FileUtil, process
;
type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Edit5: TEdit;
Edit7: TEdit;
Edit6: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
OpenDialog1: TOpenDialog;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
procedure Button1Click(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
private
public
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
function ForceDirectoriesSafe(Const Dir: RawByteString): Boolean;
var
aDir:RawByteString;
begin
result:=true;
if (Length(Dir)=0) then exit;
aDir:=ExcludeTrailingPathDelimiter(Dir);
if (Length(aDir)=0) then exit;
if (NOT DirectoryExists(aDir)) then
result:=ForceDirectories(aDir);
end;
procedure CreateDesktopShortCut(Target,Execs,icons,filetypes,FileExt, ShortcutName: string);
var
OperationSucceeded: boolean;
ResultCode: boolean;
XdgDesktopContent: TStringList;
XdgMimeContent: TStringList;
Output,XdgDesktopFile,XdgMimeFile: string;
aDirectory:string;
i,j:integer;
AddContext:boolean;
ft:TStrings;
begin
ft:=TStringList.Create;
ft.Delimiter:=';';
ft.DelimitedText:=FileExt;
j:=ft.Count;
if (j>0) and (filetypes<>'') then AddContext:=true
ELSE addcontext:=false;
// Fail by default:
OperationSucceeded:=false;
XdgDesktopFile:=IncludeTrailingPathDelimiter(GetTempDir(false))+shortcutname+'.desktop';
XdgDesktopContent:=TStringList.Create;
try
XdgDesktopContent.Add('[Desktop Entry]');
XdgDesktopContent.Add('Version=1.0');
XdgDesktopContent.Add('Encoding=UTF-8');
XdgDesktopContent.Add('Type=Application');
XdgDesktopContent.Add('Icon='+icons);
XdgDesktopContent.Add('Exec='+execs+' %u');
XdgDesktopContent.Add('Name='+ShortcutName);
XdgDesktopContent.Add('Category=Application;');
XdgDesktopContent.Add('Categories=Application;Programming;');
if AddContext then
begin
XdgDesktopContent.Add('MimeType=application/x-'+filetypes+';');
end;
try
XdgDesktopContent.SaveToFile(XdgDesktopFile);
FpChmod(XdgDesktopFile, &711); //rwx--x--x
OperationSucceeded:=RunCommand('xdg-desktop-icon' ,['install','--novendor',XdgDesktopFile],Output,[poUsePipes, poStderrToOutPut]{$IF DEFINED(FPC_FULLVERSION) AND (FPC_FULLVERSION >= 30200)},swoHide{$ENDIF});
OperationSucceeded:=RunCommand('xdg-desktop-menu' ,['install','--novendor',XdgDesktopFile],Output,[poUsePipes, poStderrToOutPut]{$IF DEFINED(FPC_FULLVERSION) AND (FPC_FULLVERSION >= 30200)},swoHide{$ENDIF});
except
OperationSucceeded:=false;
end;
if (true) then
begin
aDirectory:=ConcatPaths(['usr','share','applications']);
if ( (FpGeteuid=0) AND DirectoryExists(aDirectory) ) then
begin
FileUtil.CopyFile(XdgDesktopFile,aDirectory+DirectorySeparator+ExtractFileName(XdgDesktopFile),[]);
end
else
begin
// Create shortcut directly on User-Desktop
aDirectory:=ConcatPaths([GetUserDir,'Desktop']);
if DirectoryExists(aDirectory) then
FileUtil.CopyFile(XdgDesktopFile,aDirectory+DirectorySeparator+ExtractFileName(XdgDesktopFile),[]);
// Create user menu item
if (NOT OperationSucceeded) then
begin
aDirectory:=ConcatPaths([GetUserDir,'.local','share','applications']);
if DirectoryExists(aDirectory) then
FileUtil.CopyFile(XdgDesktopFile,aDirectory+DirectorySeparator+ExtractFileName(XdgDesktopFile),[]);
end;
end;
end;
// Temp file is no longer needed....
try
SysUtils.DeleteFile(XdgDesktopFile);
finally
// Swallow, let filesystem maintenance clear it up
end;
finally
XdgDesktopContent.Free;
OperationSucceeded:=true;
end;
if (OperationSucceeded) then
begin
aDirectory:=ConcatPaths([GetUserDir,'.local','share','applications']);
OperationSucceeded:=RunCommand('update-desktop-database' ,[aDirectory],Output,[poUsePipes, poStderrToOutPut]{$IF DEFINED(FPC_FULLVERSION) AND (FPC_FULLVERSION >= 30200)},swoHide{$ENDIF});
end;
if AddContext then
begin
{$ifdef LCL}
Application.ProcessMessages;
{$endif}
aDirectory:=ConcatPaths([GetUserDir,'.local','share','mime']);
ForceDirectoriesSafe(aDirectory);
//Create mime file associations
XdgMimeFile:=IncludeTrailingPathDelimiter(GetTempDir(false))+shortcutname+'.xml';
XdgMimeContent:=TStringList.Create;
try
XdgMimeContent.Add('<?xml version="1.0" encoding="UTF-8"?>');
XdgMimeContent.Add('<mime-info xmlns="http://www.freedesktop.org/standards/shared-mime-info">');
XdgMimeContent.Add(' <mime-type type="application/x-'+filetypes+'">');
XdgMimeContent.Add(' <comment>TEXT file</comment>');
XdgMimeContent.Add(' <icon name="application-x-'+filetypes+'"/>');
XdgMimeContent.Add(' <glob-deleteall/>');
for i:=0 to j-1 do
begin
XdgMimeContent.Add(' <glob pattern="'+ft[i]+'"/>');
end;
XdgMimeContent.Add(' </mime-type>');
XdgMimeContent.Add('</mime-info>');
aDirectory:=ConcatPaths([GetUserDir,'.local','share','mime','packages']);
ForceDirectoriesSafe(aDirectory);
XdgMimeContent.SaveToFile(XdgMimeFile);
OperationSucceeded:=RunCommand('xdg-mime' ,['install','--novendor',XdgMimeFile],Output,[poUsePipes, poStderrToOutPut]{$IF DEFINED(FPC_FULLVERSION) AND (FPC_FULLVERSION >= 30200)},swoHide{$ENDIF});
SysUtils.DeleteFile(XdgMimeFile);
finally
XdgMimeContent.Free;
end;
//Process icon
aDirectory:=ConcatPaths([GetUserDir,'.local','share','icons']);
ForceDirectoriesSafe(aDirectory);
OperationSucceeded:=RunCommand('xdg-icon-resource' ,['install','--novendor',
'--context','mimetypes','--size','64',icons,'application-x-'+filetypes+''],Output,
[poUsePipes, poStderrToOutPut]{$IF DEFINED(FPC_FULLVERSION) AND (FPC_FULLVERSION >= 30200)},swoHide{$ENDIF});
//Update mime database
aDirectory:=ConcatPaths([GetUserDir,'.local','share','mime']);
OperationSucceeded:=RunCommand('update-mime-database' ,[aDirectory],Output,
[poUsePipes, poStderrToOutPut]{$IF DEFINED(FPC_FULLVERSION) AND (FPC_FULLVERSION >= 30200)},swoHide{$ENDIF});
end;
ft.free;
end;
procedure TForm1.Button1Click(Sender: TObject);
var aDirectory,vFileName,Output,deskname:String;
begin
deskname:=edit1.Text;
aDirectory := ConcatPaths([GetUserDir, '桌面']);
if not DirectoryExists(aDirectory) then
aDirectory := ConcatPaths([GetUserDir, 'Desktop']);
CreateDesktopShortCut(aDirectory,edit2.text,edit5.text,Edit6.text,Edit7.text,deskname);
end;
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
if opendialog1.Execute then
Begin
edit2.Text:= opendialog1.FileName;
edit1.Text:=ExtractFileName(edit2.Text);
end;
end;
procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
if opendialog1.Execute then
Begin
edit5.Text:= opendialog1.FileName;
end;
end;
end.
标签：end,XdgMimeContent,Add,lazarus,XdgDesktopFile,linux,XdgDesktopContent,快捷方式,aDire 来源： https://www.cnblogs.com/qiufeng2014/p/16418182.html
本站声明： 1. iCode9 技术分享网（下文简称本站）提供的所有内容，仅供技术学习、探讨和分享； 2. 关于本站的所有留言、评论、转载及引用，纯属内容发起人的个人观点，与本站观点和立场无关； 3. 关于本站的所有言论和文字，纯属内容发起人的个人观点，与本站观点和立场无关； 4. 本站文章均是网友提供，不完全保证技术分享内容的完整性、准确性、时效性、风险性和版权归属；如您发现该文章侵犯了您的权益，可联系我们第一时间进行删除； 5. 本站为非盈利性的个人网站，所有内容不会用来进行牟利，也不会利用任何形式的广告来间接获益，纯粹是为了广大技术爱好者提供技术内容和技术思想的分享性交流网站。