Vous ne trouvez pas de réponse à votre problème ? Alors posez la question dans le forum. Souvenez-vous qu'il n'y a jamais de question bête, mais rester dans l'ignorance parce que l'on n'ose pas poser une question, ça c'est une erreur !

COMPOSANT : TDBPLINKMAKER CREEZ DES .LNK


Information sur la source



Description

Cliquez pour voir la capture en taille normale
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

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

Fichier Zip

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

Commentaires et avis

signaler à un administrateur
Commentaire de DRJEROME le 03/09/2006 11:37:51

Salut beau Julio bronzé par ses vacances d'août

j'avais travaillé sur les raccourcis,si je ne me trompe pas :

dans le sethotkey je pense que :

SHIFT = $1
CONTROL = $2
ALT = $4
EXT = $8
SHIFT+CONTROL = $3
ALT+SHIFT = $5
CONTROL+ALT = $6
CONTROL+ALT+SHIFT = $7

par exemple : CTRL+ALT+R = pseudo( $06 (CONTROL+ALT) + 'R')
=pseudo($06+ord('R'))
=pseudo($06+$52)

concrétement :
=($06 x $100)+ $52
=$0652

j'ai pas retesté depuis longtemps, je le ferai quand j'aurai un moment, si entre temps tu essaies... tu me diras si ça marche

et si ça marche pas... désolé... c'est peut-être alors dans un autre cadre de programmation que je l'avais utilisé

signaler à un administrateur
Commentaire de DRJEROME le 03/09/2006 12:16:51

j'ai essayé 1618 (càd $0652) avec un code à moi (qui créé ou transforme les ".lnk" déjà créés), ça marche

je n'ai pas encore essayé sur ton code mais ça devrait être bon

essaie aussi de déclarer le Filename et tout ce qui touche au pwidechar ainsi :

Filename : pwidechar (sauf si ce n'est pas possible pour des raisons techniques de composants, d'Edit ou autre...) ça t'éviteras le "PWChar"... mais c'est un détail

A+

signaler à un administrateur
Commentaire de cirec le 05/09/2006 12:25:53 administrateur CS

Salut,
je confirme les propos de DrJérome ...

j'ajouterai juste ceci :

Déclarée dans l'unité CommCtrl
const
  {$EXTERNALSYM HOTKEYF_SHIFT}
  HOTKEYF_SHIFT           = $01;
  {$EXTERNALSYM HOTKEYF_CONTROL}
  HOTKEYF_CONTROL         = $02;
  {$EXTERNALSYM HOTKEYF_ALT}
  HOTKEYF_ALT             = $04;
  {$EXTERNALSYM HOTKEYF_EXT}
  HOTKEYF_EXT             = $08;

  SetHotkey(((HOTKEYF_ALT or HOTKEYF_SHIFT) Shl 8) or Word('A'));

ce qui donne : Maj + Alt + A

par contre je n'ai jamais réussi à créer un raccourci avec HOTKEYF_EXT

où alors

Déclarée dans l'unité Classes :
  { TShortCut special values }
  
  scShift = $2000;
  scCtrl = $4000;
  scAlt = $8000;
  scNone = 0;


  SetHotkey(((scAlt or scCtrl) Shr 5) or Word('Z'));

ce qui donne : Ctrl + Alt + Z

Voilà tu as le choix ...  :-)

@+
Cirec

Ajouter un commentaire

Discussions en rapport avec ce code source dans le forum

help !! comment excuté un raccourci *.lnk svp [ par tsainvet ] bonjours !!je suis nouveau dans le monde de la programation et apres avoir je l'avous récuperer quelque source sur le site pour apprendre !!je me dé .lnk et opendialog [ par emmanuelgo ] salut a tous,j'ai un morceau de code qui permet de r&#233;cup&#233;rer dans une listview&nbsp;les chemins et noms des fichiers que l'utilisateur chois Récupérer la cible d'un raccourci [ par fgsav ] Bonjour &#224; tous et merci de vous int&#233;resser &#224; mon probl&#232;me Je suis en quelque sorte en train de reproduire le comportement de l'out Raccourci .lnk du bureau Windows [ par phephelavi ] Bonjour à tous !Voilà, j'ai besoin pour le développemnt de mon logiciel de trouver du code qui me permet de savoir quel raccourci bureau à le focus ! Récupérer la cible d'un raccourci [ par esigvb ] Bonjour, Comme le sujet l'indique, je recherche à récupérer la cible d'un raccourci. J'ai trouvé des informations sur la création d'un raccourci, mai Connaitre la cible d'un raccourci [ par esigvb ] Bonjour, Je recherche à connaitre la cible d'un raccourci. Voici comment je fais mon raccourci : procedure CreerRacourci(Repertoire_du_raccourci, Cib Probleme lien html avec ShellExecute [ par locss ] Bonjour,j'ai un petit probléme avec un code delphi en faite je voudrais ouvrir une url avec la commande shellExecute(), et passer dans cette url une v on ma piraté [ par N_M_B ] bonjour  a tous    je suis supper vènère je me suis fai piké 2boites mail aujourduit j'en perd mes mots   c'est un marocain quii a tout pété sur MSN l Recherche lien ou tutoriel delphi==>SQL server [ par couf ] Bonjour à Tous, J'ai une application à faire et de l'autre coté le SGBD est sql serverproblème je veux savoir si il existe un tutoreil delphi sql serv Comment faire un lien à partir des items d'un Tcombobox? [ par sephorakaja ] Salut! Je suis contente de decouvrir ce site. Juste au hasard je l'ai decouvert sur le neten faisant du Google. Et curieuse d'apprendre d'avantage l


Nos sponsors

Sondage...

CalendriCode

Juillet 2009
LMMJVSD
  12345
6789101112
13141516171819
20212223242526
2728293031  

Consulter la suite du CalendriCode

Téléchargements

Logiciels à télécharger sur le même thème :

Comparez les prix Nouvelle version

Photothèque Nouveau !



Développement réalisé par Nicolas SOREL (Nix) avec l'aide de : Cyril DURAND et Emmanuel (EBArtSoft), Merci à Vincent pour ses précieux conseils
CodeS-SourceS.com© Toute reproduction même partielle est interdite sauf accord écrit du Webmaster
CodeS-SourceS.com© est une marque déposée tous droits réservés
Temps d'éxécution de la page : 1,108 sec

Google Coop CodeS-SourceS Google Coop CodeS-SourceS


Certaines images présentes sur le site (notament certains avatars) sont issues des collections IconShock, donc si vous souhaitez utiliser ces icons vous devez les acheter, ne les copiez pas et ne utilisez pas dans vos sites et applications sans les avoir commandé.