用lazarus创建linux的菜单、桌面快捷方式及文件关联

为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