View Issue Details

IDProjectCategoryView StatusLast Update
0000990Double CommanderFile operationspublic2021-09-05 15:11
Reporterholger Assigned ToAlexx2000  
PrioritynormalSeverityfeatureReproducibilityalways
Status closedResolutionfixed 
ProjectionnoneETAnone 
Product Version0.6.0 (trunk) 
Target Version0.9.0Fixed in Version0.9.0 
Summary0000990: Creation of shortcuts *.lnk in addition to symbolic links
DescriptionOn Windows it is common to use shortcuts *.lnk in addition to symbolic links.
I extended the dialog for symbolic links to get the ability to create both.

A patch file is attached.


Remark: The symbolic links DC creates work fine for directories but for a file they only work with administrator privileges.
TagsNo tags attached.
Attached Files
fsymlink.patch (4,184 bytes)   
Index: fsymlink.lfm
===================================================================
--- fsymlink.lfm	(revision 5790)
+++ fsymlink.lfm	(working copy)
@@ -120,4 +120,15 @@
     ModalResult = 2
     TabOrder = 3
   end
+  object CheckBoxLnk: TCheckBox
+    Left = 272
+    Height = 24
+    Top = 136
+    Width = 93
+    Anchors = [akTop, akRight]
+    Caption = 'Create .lnk'
+    Checked = True
+    State = cbChecked
+    TabOrder = 4
+  end
 end
Index: fsymlink.pas
===================================================================
--- fsymlink.pas	(revision 5790)
+++ fsymlink.pas	(working copy)
@@ -10,6 +10,7 @@
   { TfrmSymLink }
 
   TfrmSymLink = class(TForm)
+    CheckBoxLnk: TCheckBox;
     lblExistingFile: TLabel;
     lblLinkToCreate: TLabel;
     edtExistingFile: TEdit;
@@ -43,6 +44,9 @@
     try
       edtLinkToCreate.Text := sLinkToCreate;
       edtExistingFile.Text := sExistingFile;
+      {$IFNDEF MSWINDOWS}
+      CheckBoxLnk.Visible := false;
+      {$ENDIF}
       Result:= (ShowModal = mrOK);
     finally
       Free;
@@ -67,9 +71,10 @@
   if CompareFilenames(sSrc, sDst) = 0 then Exit;
 
   sSrc := GetAbsoluteFileName(FCurrentPath, sSrc);
-  sDst := GetAbsoluteFileName(FCurrentPath, sDst);
+  if not CheckBoxLnk.Checked then
+    sDst := GetAbsoluteFileName(FCurrentPath, sDst);
 
-  if CreateSymLink(sSrc, sDst) then
+  if CreateSymLink(sSrc, sDst, CheckBoxLnk.Checked ) then
     begin
       // write log
       if (log_cp_mv_ln in gLogOptions) and (log_success in gLogOptions) then
@@ -91,4 +96,4 @@
   edtLinkToCreate.SelectAll;
 end;
 
-end.
+end.
Index: platform/uOSUtils.pas
===================================================================
--- platform/uOSUtils.pas	(revision 5790)
+++ platform/uOSUtils.pas	(working copy)
@@ -97,7 +97,7 @@
    @param(LinkName Name of symbolic link)
    @returns(The function returns @true if successful, @false otherwise)
 }
-function CreateSymLink(const Path, LinkName: string) : Boolean;
+function CreateSymLink(const Path, LinkName: string; bCreateLnk : boolean = false ) : Boolean;
 {en
    Read destination of symbolic link
    @param(LinkName Name of symbolic link)
@@ -198,7 +198,7 @@
   uFileProcs, FileUtil, uDCUtils, DCOSUtils, DCStrUtils, uGlobs, uLng
   {$IF DEFINED(MSWINDOWS)}
   , JwaWinCon, Windows, uNTFSLinks, uMyWindows, JwaWinNetWk, uShlObjAdditional
-  , shlobj
+  , shlobj, ActiveX, ComObj
   {$ENDIF}
   {$IF DEFINED(UNIX)}
   , BaseUnix, Unix, uMyUnix, dl
@@ -517,16 +517,51 @@
 end;
 {$ENDIF}
 
-function CreateSymLink(const Path, LinkName: string) : Boolean;
+function CreateSymLink(const Path, LinkName: string; bCreateLnk : boolean ) : Boolean;
 {$IFDEF MSWINDOWS}
+    procedure CreateShortCut(Target, ShortcutName: string);
+    var
+      IObject: IUnknown;
+      ISLink: IShellLink;
+      IPFile: IPersistFile;
+      PIDL: PItemIDList;
+      InFolder: array[0..MAX_PATH] of Char;
+      TargetName: String;
+      LinkName: WideString;
+      TargetArguments:string;
+    begin
+      TargetArguments:='';
+
+      { Creates an instance of IShellLink }
+      IObject := CreateComObject(CLSID_ShellLink);
+      ISLink := IObject as IShellLink;
+      IPFile := IObject as IPersistFile;
+
+      ISLink.SetPath(pChar(UTF8ToSys(Target)));
+      ISLink.SetArguments(pChar(TargetArguments));
+      ISLink.SetWorkingDirectory(pChar(ExtractFilePath(Target)));
+
+      { Get the desktop location }
+      LinkName := UTF8Decode(ShortcutName);
+      if LowerCase(extractFileExt( LinkName )) <> '.lnk' then
+        LinkName := LinkName+'.lnk';
+
+      { Create the link }
+      IPFile.Save(PWChar(LinkName), false);
+    end;
 var
   wsPath, wsLinkName: WideString;
 begin
   Result := True;
   try
-    wsPath:= UTF8Decode(Path);
-    wsLinkName:= UTF8Decode(LinkName);
-    Result:= uNTFSLinks.CreateSymlink(wsPath, wsLinkName);
+    if bCreateLnk then
+      CreateShortCut( Path, LinkName )
+    else
+      begin
+        wsPath:= UTF8Decode(Path);
+        wsLinkName:= UTF8Decode(LinkName);
+        Result:= uNTFSLinks.CreateSymlink(wsPath, wsLinkName);
+      end;
   except
     Result := False;
   end;
fsymlink.patch (4,184 bytes)   
Fixed in Revision8525
Operating system
Widgetset
Architecture

Issue History

Date Modified Username Field Change
2015-01-16 18:49 holger New Issue
2015-01-16 18:49 holger File Added: fsymlink.patch
2018-12-15 03:16 mvitamin Note Added: 0002975
2018-12-16 16:00 Alexx2000 Assigned To => Alexx2000
2018-12-16 16:00 Alexx2000 Status new => assigned
2018-12-16 16:02 Alexx2000 Fixed in Revision => 8525
2018-12-16 16:02 Alexx2000 Status assigned => resolved
2018-12-16 16:02 Alexx2000 Resolution open => fixed
2018-12-16 16:02 Alexx2000 Fixed in Version => 0.9.0
2018-12-16 16:02 Alexx2000 Target Version => 0.9.0
2021-09-05 15:11 Alexx2000 Status resolved => closed