Devart Forums

Code: Select all

procedure TSSHServerFrame.ScSFTPServerReadSymbolicLink(Sender: TObject;
  SFTPSessionInfo: TScSFTPSessionInfo; const Path: string;
  out SymbolicName: string; var Error: TScSFTPError);
var
  FullPath: string;
{$IFDEF MSWINDOWS}
  IObj: IUnknown;
  ILink: IShellLink;
  IPFile: IPersistFile;
  fd: TWin32FindData;
  ws: WideString;
  pPath: PChar;
{$ENDIF}
begin
  SymbolicName := '';
  FullPath := ScSFTPServer.GetFullPath(SFTPSessionInfo, Path);
  if not FileExists(FullPath) and (ExtractFileExt(FullPath) = '') then
    FullPath := ChangeFileExt(FullPath, '.lnk');

{$IFDEF SC_USE_SYMLINK}
  if FileGetSymLinkTarget(FullPath, SymbolicName) then
    InitError(Error, erOk)
  else
{$ENDIF}
  {$IFDEF MSWINDOWS}
    if FileExists(FullPath) then begin
      InitError(Error, erFailure);
      try
        IObj := CreateComObject(CLSID_ShellLink);
        ILink := IObj as IShellLink;
        IPFile := IObj as IPersistFile;

        ws := WideString(FullPath);
        if IPFile.Load(POleStr(ws), 0) = S_OK then begin
          pPath := Marshal.AllocHGlobal(MAX_PATH * sizeof(char));
          try
            if ILink.GetPath(pPath, MAX_PATH, fd, 0) = S_OK then begin
              SymbolicName := string(pPath);
              SymbolicName := ExtractRelativePath(SFTPSessionInfo.HomePath, SymbolicName);
              InitError(Error, erOk);
              Exit;
            end;
          finally
            Marshal.FreeHGlobal(pPath);
          end;
        end;
      finally
        if Error.ErrorCode <> erOk then
          InitError(Error, erFailure, SysErrorMessage(GetLastError));
      end;
    end
    else
  {$ENDIF}
      InitError(Error, erNoSuchFile);
end;

Code: Select all

uses
{$IFDEF MSWINDOWS}
  ShlObj, ActiveX, ComObj,
{$ENDIF}
  ScSFTPUtils, ScSFTPConsts, ScCLRClasses,