paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-12-10 17:17:26 +01:00
Code Issues Packages Projects Releases Wiki Activity

TShellTreeView: setpath: adjust for the fact that some Windows versions report faHidden on drive roots (e.g. C:\). Second attempt to fix #0027591.

Browse Source 
git-svn-id: trunk@48125 -
This commit is contained in:
bart 2015-03-04 10:32:37 +00:00
parent 0a0c458e99
commit 880871e653
1 changed files with 19 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
lcl/shellctrls.pas
View File

@ -994,6 +994,19 @@ var
//writeln('TCustomShellTreeView.SetPath.Exists: Result = ',Result);
end;
function PathIsDriveRoot({%H-}Path: String): Boolean; {$if not (defined(windows) and not defined(wince))}inline;{$endif}
//At least Win7 reports faHidden on all physical drive-roots (e.g. C:\)
begin
{$if defined(windows) and not defined(wince)}
Result := (Length(Path) = 3) and
(Upcase(Path[1]) in ['A'..'Z']) and
(Path[2] = DriveSeparator) and
(Path[3] in AllowDirectorySeparators);
{$else}
Result := False;
{$endif windows}
end;
function ContainsHiddenDir(Fn: String): Boolean;
var
i: Integer;
@ -1001,13 +1014,13 @@ var
Dirs: TStringList;
RelPath: String;
begin
//if fn=root then alwayy return false
//if fn=root then always return false
if (CompareFileNames(Fn, FQRootPath) = 0) then
Result := False
else
begin
Attr := FileGetAttrUtf8(Fn);
Result := ((Attr and faHidden) = faHidden);
Result := ((Attr and faHidden) = faHidden) and not PathIsDriveRoot(Fn);
if not Result then
begin
//it also is not allowed that any folder above is hidden
@ -1037,10 +1050,10 @@ var
if (Length(Fn) = 2) and (Fn[2] = ':') then Continue;
{$endif}
Attr := FileGetAttrUtf8(Fn);
if (Attr <> -1) and ((Attr and faHidden) > 0) then
if (Attr <> -1) and ((Attr and faHidden) > 0) and not PathIsDriveRoot(Fn) then
begin
Result := True;
//writeln('TCustomShellTreeView.SetPath.Exists: a subdir is hiddden: Result := False');
//writeln('TCustomShellTreeView.SetPath.Exists: a subdir is hidden: Result := False');
Break;
end;
end;
@ -1104,6 +1117,7 @@ begin
//writeln('TCustomShellTreeView.SetPath: ');
//writeln(' IsRelPath = ',IsRelPath);
//writeln(' RelPath = "',RelPath,'"');
//writeln(' FQRootPath = "',FQRootPath,'"');
if (not IsRelpath) or ((RelPath <> '') and ((Length(RelPath) > 1) and (RelPath[1] = '.') and (RelPath[2] = '.'))) then
@ -1129,7 +1143,7 @@ begin
end;
if not (otHidden in FObjectTypes) and ContainsHiddenDir(AValue) then
Raise EInvalidPath.CreateFmt(sShellCtrlsInvalidPathRelative,[AValue, FQRootPath]);
Raise EInvalidPath.CreateFmt(sShellCtrlsInvalidPath,[AValue, FQRootPath]);
sl := TStringList.Create;
sl.Delimiter := PathDelim;