Composant : tdbplinkmaker creez des .lnk

Télécharger le projet
Commenter

Description

Je l'avais dit ;)
Bon voila mon 18eme compo, un créateur de *.lnk 99% complet, le dernier % est réussir à ajouter des shortcut/hotkey aux liens créés autres que des simples lettres car CTRL+ALT+R devrait etre possible mais jue ne'y suis pas parvenu encore.
La démo reprends le style de création de raccouric de windows. un .exe de la démo est dispo sur mon site perso pour les flemmards de la compilation avec unité supplémentaire ^^
L'unité StrMan.pas peut etre trouvée ici : http://diabloporc.Free.fr/delphi/

Source / Exemple : 


{
################################################################################
# DBPLINKMAKER                                                                 #
################################################################################
#                                                                              #
# VERSION       : 1.0                                                          #
# FICHIERS      : dbpLinkMaker.pas,.dcu,.dcr,.bmp,ReadMe.htm                   #
# AUTEUR        : Julio P. (Diabloporc)                                        #
# CREATION      : 02 sep 2006                                                  #
# MODIFIEE      : 02 sep 2006                                                  #
# SITE WEB      : http://diabloporc.free.fr                                    #
# MAIL          : juliobox@free.fr                                             #
# LEGAL         : Free sous Licence GNU/GPL                                    #
# INFOS         : Retrouvez moi sur www.delphifr.com : "JulioDelphi"           #
#                 Lisez le ReadMe.htm !                                        #
#                                                                              #
################################################################################
}
unit dbpLinkMaker;

interface

uses
  Menus, Windows, SysUtils, Classes, Registry, ComObj, ActiveX, ShlObj;

type
  TShellDir = (sdMenuDemarrer, sdMenuDemarrage, sdMenuProgrammes, sdMesDocuments, sdBureau, sdOnlySubDir);

  TCreation = class(TPersistent)
  private
    FCreateDir: Boolean;
    FShellDir: TShellDir;
    FSubdir: String;
    procedure SetSubDir(Value: String);
  public
  published
    property CreateDir: Boolean read FCreateDir write FCreateDir;
    property ShellDir: TShellDir read FShellDir write FShellDir;
    property SubDir: String read FSubDir write SetSubdir;
  end;

  TTypeFenetre = (tfNormale, tfAgrandie, tfReduite);

  TdbpLinkMaker = class(TComponent)
  private
    FAbout:          String;
    FCreation:       TCreation;
    FLinkFileName:   String;
    FLinkFileTarget: String;
    FIcoFileName:    String;
    FIcoFileNb:      Integer;
    FParams:         String;
    FLaunchDir:      String;
    FCommentaires:   String;
//    FSHortCut:       String;
    FTypeFenetre:    TTypeFenetre;
    procedure FSetAbout(const s: string);
//    procedure FSetShortCut(s: string);
//    function  FGetShortCut: string;
  protected
    { Déclarations protégées }
  public
    constructor Create(aOwner: TComponent); override;
    destructor  Destroy; override;

    procedure Execute;
  published
    property About:              String read       FAbout write          FSetAbout;
    property ACreerDans:         TCreation read    FCreation write       FCreation;
    property Commentaires:       String read       FCommentaires write   FCommentaires;
    property DossierDeLancement: String read       FLaunchDir write      FLaunchDir;
    property FichierACreer:      String read       FLinkFileName write   FLinkFileName;
    property FichierALinker:     String read       FLinkFileTarget write FLinkFileTarget;
    property FichierIcone:       String read       FIcoFileName write    FIcoFileName;
    property FichierIconeNb:     Integer read      FIcoFileNb write      FIcoFileNb;
    property Parametres:         String read       FParams write         FParams;
//    property ShortCut:           String read       FGetShortCut write    FSetShortCut;
    property TypeFenetre:        TTypeFenetre read FTypeFenetre write    FTypeFenetre;
  end;

procedure Register;

implementation

{$R dbpLinkMaker.dcr}

procedure TCreation.SetSubDir(Value: String);
begin
  if (FSubDir <> Value) and (Value <> '') then
   begin
    IncludeTrailingPathDelimiter(Value);
    FSubDir := Value;
   end;
end;

constructor TdbpLinkMaker.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
  FCreation           := TCreation.Create;
  FCreation.CreateDir := True;
  FLinkFileName       := 'Nouveau Lien';
  fAbout              := 'v1.0 par Julio P. (Diabloporc)';
end;

destructor TdbpLinkMaker.Destroy;
begin
  FCreation.Free;
  inherited Destroy;
end;

procedure TdbpLinkMaker.FSetAbout(const s: string);
begin
//
end;
{
function TdbpLinkMaker.FGetShortCut : string;
begin
 result := FShortCut;
end;

procedure TdbpLinkMaker.FSetShortCut(s : string);
begin
 FShortCut := s;
end;
}
procedure TdbpLinkMaker.Execute;
var
  ShellObj: IUnknown;
  ShellLnk: IShellLink;
  PersistFile: IPersistFile;
  FileName: WideString;

  Reg: TRegistry;
  RegStr: String;
  i: Integer;
begin
  Reg := TRegistry.Create;
  with Reg do
   try
     RootKey := HKEY_CURRENT_USER;
     OpenKey('\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders', True);
     case FCreation.FShellDir of
       sdMenuDemarrer:    RegStr := 'Start Menu';
       sdMenuDemarrage:   RegStr := 'Startup';
       sdMenuProgrammes:  RegStr := 'Programs';
       sdMesDocuments:    RegStr := 'Personal';
       sdBureau:          RegStr := 'Desktop';
       else               RegStr := '';
      end;
     if RegStr<>'' then
      RegStr  := IncludeTrailingPathDelimiter(ReadString(RegStr)) + IncludeTrailingPathDelimiter(FCreation.FSubDir)
     else
      RegStr  := IncludeTrailingPathDelimiter(FCreation.FSubDir);
   except
   end;
  Reg.Free;

  if FCreation.FCreateDir then ForceDirectories(RegStr);

  ShellObj    := CreateComObject(CLSID_ShellLink);
  ShellLnk    := ShellObj as IShellLink;
  PersistFile := ShellObj as IPersistFile;

  with ShellLnk do
   begin
    case FTypeFenetre of
      tfAgrandie: i := sw_ShowMaximized;
      tfReduite:  i := sw_ShowMinNoActive;
      else        i := sw_ShowNormal;
    end;
    SetArguments(PChar(FParams));
    SetDescription(PChar(FCommentaires));
    SetPath(PChar(FLinkFileTarget));
    SetWorkingDirectory(PChar(FLaunchDir));
    SetShowCmd(i);
//SetHotkey(TextToShortCut(FShortCut));
    if fIcoFileName <> '' then
     SetIconLocation(PChar(fIcoFileName),fIcoFileNb);
   end;

  FileName := RegStr + FLinkFileName + '.lnk';
  PersistFile.Save(PWChar(FileName), False);
end;

procedure Register;
begin
  RegisterComponents('Diabloporc', [TdbpLinkMaker]);
end;

end.

Conclusion :


Comme d'hab, si vous parvenez a l'améliorer, optimiser, vous trouvez des bugs, dites le moi ici ou juliobox@free.fr
merci a vous
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (JulioDelphi)