Composant : tdbplinkmaker creez des .lnk

Soyez le premier à donner votre avis sur cette source.

Vue 7 375 fois - Téléchargée 590 fois

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

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

DRJEROME
Messages postés
436
Date d'inscription
jeudi 9 janvier 2003
Statut
Membre
Dernière intervention
5 février 2015
-
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é
DRJEROME
Messages postés
436
Date d'inscription
jeudi 9 janvier 2003
Statut
Membre
Dernière intervention
5 février 2015
-
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+
cirec
Messages postés
3809
Date d'inscription
vendredi 23 juillet 2004
Statut
Modérateur
Dernière intervention
1 septembre 2019
34 -
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

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.