COMPOSANT : TDBPLINKMAKER CREEZ DES .LNK

---

Commentaire sur cette source (3)
Ajouter un commentaire et/ou une note

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/

{
################################################################################
# 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.

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

Pour les "Membres Club", vous pouvez télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !

Télécharger le zip

• MOZILLA FIREFOX EN DELPHI
• COMPOSANT : TDBPCOLORPIKKER
• COMPOSANT : TDBPDEFAULTBUTTON
• COMPOSANT : TDBPVERNAM (CRYPTEUR DE TEXTE/FICHIER)
• TOP MEMBRES CODES-SOURCES

• MASQUER UN REPERTOIRE
• API DISKUTILS / DISKMONITOR V1.1.6 - MULTI-MONITEUR D'UNITÉS DE STOCKAGE
• SYNCHRONISATION-FICHIERS (MODIFICATION DE TIGRIS1)
• DFM READER
• SYNCHRONISATION DE FICHIERS

• RACCOURCI RAPIDE (PROGRAMME DE RACCOURCIS PARAMÈTRABLES)
• COMPO TCYFIELDLINK - BRANCHER N' IMPORTE QUEL CONTROL À UN CHAMP DE TABLE
• GESTION RACCOURCIS CLAVIER SANS MESSAGE
• CRÉER DES SHORTCUTS (RACCOURCIS)
• CRÉATION DE FICHIERS RACCOURCIS .LNK