Accueil > > > COMPOSANT : TDBPLINKMAKER CREEZ DES .LNK
COMPOSANT : TDBPLINKMAKER CREEZ DES .LNK
Information sur la source
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
- {
- ################################################################################
- # 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
Sources du même auteur
Sources de la même categorie
Commentaires et avis
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écupérer dans une listview les chemins et noms des fichiers que l'utilisateur chois
Récupérer la cible d'un raccourci [ par fgsav ]
Bonjour à tous et merci de vous intéresser à mon problè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 !
racourci d'un lien [ par eclems ]
Bonsoir voila j'ai fait une fonction pour que aulieu de metre le nom de mon site dans une Tedit comme ca :='http://www.eclems68.hbg.fr/dossier'; je
création raccourci [ par senv ]
Bonjour, J'ai créé une listview et lorsque je l'édite, je fais appel à l'évènement onEdited. Tout cela fonctionne bien comme je veux. Le problème, c
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
|
Derniers Blogs
UNE JOLIE-HORLOGE ET PAS QU'UN PEU !UNE JOLIE-HORLOGE ET PAS QU'UN PEU ! par neodante
Pour les possesseurs d'iPhone, ça y est Bijin Tokei - qui se traduit littéralement en Français par " Jolie Horloge " - est arrivé et GRATUITEMENT s'il vous plaît ! Après la version Tokyo, Hokkaido, night club, racing, Gal, "pour les mademoiselles'", . voi...
Cliquez pour lire la suite de l'article par neodante TECHDAYS PARIS 2010 : CONNECTEZ VOS DONNéES à SHAREPOINT 2010 AVEC LES BUSINESS CONNECTIVITY SERVICESTECHDAYS PARIS 2010 : CONNECTEZ VOS DONNéES à SHAREPOINT 2010 AVEC LES BUSINESS CONNECTIVITY SERVICES par ROMELARD Fabrice
Animé par: Gaetan Bouveret et Julien Chomarat Business Connectivity Services (BCS) est dans SharePoint 2010 la version 2 de Business Data Catalog (BDC dans SharePoint 2007). Il s'agit de la solution permettant de visualiser des données provenan...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice [DIVERS] SUIVRE VOS SéRIES PRéFéRéS SUR LA TOILE[DIVERS] SUIVRE VOS SéRIES PRéFéRéS SUR LA TOILE par orion
Comme de nombreux geek, je suis un grand amateur de série TV et je rate régulièrement des épisodes de mes séries préférés. Une solution s'offre à vous avec ce merveilleux site : Tv Gorge - www.tvgorge.com Moteur de recherche à l'appui, vous pouvez ...
Cliquez pour lire la suite de l'article par orion TECHDAYS PARIS 2010 : LA BI DANS SHAREPOINT 2010TECHDAYS PARIS 2010 : LA BI DANS SHAREPOINT 2010 par ROMELARD Fabrice
Animé par: Vincent Bellet et Baptiste Giraudier La BI dans SharePoint 2010, Les nouveaux services d'application dans SP2010 et SQL Server Reporting services 2008 R2. La BI dans SharePoint est généralisée pour tous afin de permettre à tous les coll...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice
Logiciels
DB-MAIN (9.1.0)DB-MAIN (9.1.0)DB-MAIN is a data-modeling and data-architecture tool. It is designed to help developers and anal... Cliquez pour télécharger DB-MAIN Xilisoft DPG Convertisseur (5.1.37.0120)XILISOFT DPG CONVERTISSEUR (5.1.37.0120)Xilisoft DPG Convertisseur offre aux fans de Nintendo DS une bonne solution leur permettant de dé... Cliquez pour télécharger Xilisoft DPG Convertisseur GraphicsGale (2.01.01)GRAPHICSGALE (2.01.01)GraphicsGale est un logiciel de PixelArt avec de nombreuse fonctionnalités permettant de réalisé ... Cliquez pour télécharger GraphicsGale Architecte 3D (Platinum 2010)ARCHITECTE 3D (PLATINUM 2010)Architecte 3D Platinium vous permet de concevoir facilement les plans votre future maison, de l'é... Cliquez pour télécharger Architecte 3D TeamViewer 5 (TeamViewer 5)TEAMVIEWER 5 (TEAMVIEWER 5)Dépanner un ami,expliquer une manipulation devient un jeu d'enfant.
Prise en main d'un autre ord... Cliquez pour télécharger TeamViewer 5
|