|
begin process at 2008 09 06 08:12:09
Derniers logiciels
|
Trouver une ressource (Nouvelle version du moteur, plus rapide & pertinent, essayez le !)
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
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 de la même categorie
Commentaires
Discussions en rapport avec ce code source
|
CalendriCode
| | | L | M | M | J | V | S | D |
| 1 | 2 | 3 | 4 | 5 | 6 | 7 |
| 8 | 9 | 10 | 11 | 12 | 13 | 14 |
| 15 | 16 | 17 | 18 | 19 | 20 | 21 |
| 22 | 23 | 24 | 25 | 26 | 27 | 28 |
| 29 | 30 | | | | | |
|
Téléchargements
Logiciels à télécharger sur le même thème :
|
|