systemlistview.pas

动态提示控件

      ;
  finally
    // always protect this stuff to make sure it gets reset.
    Items.EndUpdate;
    Cursor := OldCursor;
  end;
end;

function TdfsSystemListView.AddNode(const ShellFolder: IShellFolder; FQ_IDList,
   IDList: PItemIDList): TListItem;

  function IsADrive(const Path: string): boolean;
  begin
    Result := FALSE;
    if (Path <> '') and (Length(Path) < 4) then
      Result := (Copy(Path, 2, 2) = ':\');
  end;

  function IsFolderObject(Attrs: UINT): boolean;
  begin
    Result := ((Attrs and (SFGAO_FOLDER or SFGAO_HASSUBFOLDER)) <> 0);
  end;

  function IsFileObject(Attrs: UINT): boolean;
  begin
    Result := ((Attrs and SFGAO_FILESYSTEM) <> 0) and not IsFolderObject(Attrs);
  end;

var
  NiceName, FullName: string;
  Attrs: UINT;
{$IFNDEF DFS_SLV_FASTMODE}
  FullPath: array[0..MAX_PATH] of char;
  Normal,
  Selected: integer;
  FI: TSHFileInfo;
  FD: TWin32FindData;
  DI: TSHDescriptionID;
  SysTime: TSystemTime;
  SubStr,
  DateStr,
  TimeStr: string;
  FFFH: THandle;
  GotPath: boolean;
  GotData: boolean;
  Res: HRESULT;
{$ENDIF}
  NoPIDL: PItemIDList;
begin
  Result := NIL;
  NoPIDL := NIL;
  Attrs := SFGAO_VALIDATE;
  // Invalidate cached information.
  ShellFolder.GetAttributesOf(0, NoPIDL, Attrs);
  NiceName := GetDisplayName(ShellFolder, IDList, dntNormal);
  begin
    // SFGAO_CONTENTSMASK is incorrect in the SDK header (not Borland's fault).
    Attrs := SFGAO_CAPABILITYMASK or SFGAO_DISPLAYATTRMASK and
       (not SFGAO_READONLY) or SFGAO_REMOVABLE or $F0000000;{SFGAO_CONTENTSMASK}

    ShellFolder.GetAttributesOf(1, IDList, Attrs);

    // Don't show drives and other stuff not filtered out by SHCONTF_FOLDERS.
    if (not FShowFolders) and ((Attrs and SFGAO_HASSUBFOLDER) <> 0) then
      exit;

    // mask!
    if (FFileMask <> '') and ((Attrs and SFGAO_FOLDER) = 0) then
    begin
      SetLength(FullName, MAX_PATH);
      if SHGetPathFromIDList(FQ_IDList, PChar(FullName)) then
      begin
        SetLength(FullName, StrLen(PChar(FullName)));
        if not MaskSearch.FileMatches(FullName, FFileMaskList) then
        begin
          Result := NIL;
          FreePIDL(IDList);
          FreePIDL(FQ_IDList);
          exit;
        end;
      end;
    end;

    Result := Items.Add;

    Result.Data := AddItemData(ShellFolder, IDList, FQ_IDList, Attrs);

{$IFDEF DFS_SLV_FASTMODE}

    Result.Caption := '';
    Result.SubItems.Add('');
    Result.SubItems.Add('');
    Result.SubItems.Add('');
    Result.SubItems.Add('');

    // Added by Peter Ruskin 28/09/97
    if (Attrs and SFGAO_SHARE) <> 0 then
      Result.OverlayIndex := 0         { 0 is the OverlayIndex for share }
    else if (Attrs and SFGAO_LINK) <> 0 then
    begin
      Result.OverlayIndex := 1;        { 1 is the OverlayIndex for links }
      NiceName := ExtractFileName(GetFullPath(Result));
    end;

    if assigned(FOnAddListItem) then
      FOnAddListItem(Self, Result)
{$ELSE}
    GetNormalAndSelectedIcons(FQ_IDList, Normal, Selected);
    Result.ImageIndex := Normal;

    // Added by Peter Ruskin 28/09/97
    if (Attrs and SFGAO_SHARE) <> 0 then
      Result.OverlayIndex := 0        { 0 is the OverlayIndex for share }
    // Get link file extensions if this is not the desktop
    else if ((Attrs and SFGAO_LINK) <> 0) {and (ParentNode.Parent <> NIL)} then
    begin
      Result.OverlayIndex := 1;        { 1 is the OverlayIndex for links }
      NiceName := ExtractFileName(GetFullPath(Result));
    end;
    Result.Caption := NiceName;

    if assigned(FOnAddListItem) then
      FOnAddListItem(Self, Result)
    else begin
      GotPath := SHGetPathFromIDList(FQ_IDList, FullPath);
      // If you get a compiler error here, check step five in ShellFix.txt.
      // It is new.
      GotData := SUCCEEDED(SHGetDataFromIDList(ShellFolder, IDList,
         SHGDFIL_FINDDATA, @FD, SizeOf(FD)));

      Res := SHGetDataFromIDList(ShellFolder, IDList, SHGDFIL_DESCRIPTIONID,
         @DI, SizeOf(DI));

      if Res = E_INVALIDARG then
        // Not implemented until v4.71 of Shell32.dll.  Just treat everything
        // as a file system object.
        DI.dwDescriptionID := SHDID_FS_FILE;

      if (not GotData) and GotPath and ((Attrs and SFGAO_REMOVABLE) <>
        SFGAO_REMOVABLE) then
      begin
        FFFH := Windows.FindFirstFile(FullPath, FD);
        if FFFH <> INVALID_HANDLE_VALUE then
        begin
          GotData := TRUE;
          Windows.FindClose(FFFH);
        end;
      end;

      // size in KBs
      // Don't bother for removable drives since they might be empty
      // drives, and won't have a size at any rate.  Also ignore folders
      // since they don't have sizes.
      if ((GotPath and IsADrive(FullPath)) and
         ((Attrs and SFGAO_REMOVABLE) <> 0)) or IsFolderObject(Attrs) or
         not IsFileObject(Attrs) then
        SubStr := ''
      else begin
        if GotData then
        begin
          TFolderItemData(Result.Data).FileSizeLow := FD.nFileSizeLow;
          TFolderItemData(Result.Data).FileSizeHigh := FD.nFileSizeHigh;
        end else begin
          TFolderItemData(Result.Data).FileSizeLow := 0;
          TFolderItemData(Result.Data).FileSizeHigh := 0;
        end;
{$IFDEF DFS_COMPILER_4_UP}
        SubStr := Commaize(IntToStr((TFolderItemData(Result.Data).FileSize +
           1023) div 1024)) + strKilobytes;
{$ELSE}
{$IFDEF DELPHI}
        SubStr := Commaize(Format('%.0f',
           [(TFolderItemData(Result.Data).FileSize + 1023) / 1024])) +
           strKilobytes;
{$ELSE}
        SubStr := Commaize(IntToStr((TFolderItemData(Result.Data).FileSizeLow +
           1023) div 1024)) + strKilobytes;
{$ENDIF}
{$ENDIF}
      end;
      Result.SubItems.Add(SubStr);

      // File type description
      if DI.dwDescriptionId = SHDID_ROOT_REGITEM then
        // System folder
        SubStr := strSystemFolder
      else if {GotData and }(SHGetFileInfo(PChar(FQ_IDLIST), 0, FI, SizeOf(FI),
         SHGFI_PIDL or SHGFI_TYPENAME) <> 0) then
        SubStr := FI.szTypeName
      else
        SubStr := '';
      Result.SubItems.Add(SubStr);

      // date/time modified
      if GotData and (FD.ftLastWriteTime.dwLowDateTime <> 0) and
         (FD.ftLastWriteTime.dwHighDateTime <> 0) then
      begin
        FileTimeToLocalFileTime(FD.ftLastWriteTime, FD.ftLastWriteTime);
        FileTimeToSystemTime(FD.ftLastWriteTime, SysTime);
        SetLength(DateStr, 256);
        SetLength(DateStr, GetDateFormat(LOCALE_USER_DEFAULT, 0, @SysTime,
           NIL, PChar(DateStr), 255) - 1);
        SetLength(TimeStr, 256);
        SetLength(TimeStr, GetTimeFormat(LOCALE_USER_DEFAULT, 0, @SysTime,
           NIL, PChar(TimeStr), 255)  - 1);
        SubStr := DateStr + ' ' + TimeStr;
      end else
        SubStr := '';
      Result.SubItems.Add(SubStr);

      SubStr := '';
      if GotData then
      begin
        if (FD.dwFileAttributes and faReadOnly) <> 0 then
          SubStr := SubStr + strReadOnlyChar;
        if (FD.dwFileAttributes and faHidden) <> 0 then
          SubStr := SubStr + strHiddenChar;
        if (FD.dwFileAttributes and faSysFile) <> 0 then
          SubStr := SubStr + strSystemChar;
        if (FD.dwFileAttributes and faArchive) <> 0 then
          SubStr := SubStr + strArchiveChar;
      end;
      Result.SubItems.Add(SubStr);
    end;
{$ENDIF}
  end;
(*
var
  NiceName: string;
  Normal,
  Selected: integer;
  FullPath: array[0..MAX_PATH] of char;
  FI: TSHFileInfo;
  SysTime: TSystemTime;
  DateStr,
  TimeStr: string;
  Attrs: UINT;
  FD: TWin32FindData;
  DI: TSHDescriptionID;
  Res: HResult;
begin
  Result := NIL;
  if GetNiceName(ShellFolder, IDList, SHGDN_NORMAL, NiceName) then begin
    Result := Items.Add;
    Attrs := SFGAO_CAPABILITYMASK or SFGAO_DISPLAYATTRMASK or SFGAO_CONTENTSMASK;
    ShellFolder.GetAttributesOf(1, IDList, Attrs);
    Result.Data := AddItemData(ShellFolder, IDList, FQ_IDList, Attrs);
    GetNormalAndSelectedIcons(FQ_IDList, Normal, Selected);
    Result.ImageIndex := Normal;
//    Result.SelectedIndex := Selected;
    Result.Caption := NiceName;
// This needs to be different for types other than files...


    // If you get a compiler error here, check step five in ShellFix.txt.  It is new.
    Res := SHGetDataFromIDList(ShellFolder, IDList, SHGDFIL_DESCRIPTIONID, DI, SizeOf(DI));

    if Res = E_INVALIDARG then
      DI.dwDescriptionID := SHDID_FS_FILE // I think this call is only working on NT 4.0.
    else
      if not DESCR_FLAG then
        ShowMessage('Something unexpected, but very interesting, has happened.'#13 +
                    'Please email me ([e-mail]) with information on what'#13 +
                    'operating system you are using, including service packs, etc.'#13 +
                    'Also, please send the file date and time of your Shell32.dll file.')
      else
        DESCR_FLAG := TRUE;

    case DI.dwDescriptionID of
      SHDID_FS_FILE,
      SHDID_FS_DIRECTORY,
      SHDID_FS_OTHER:
        begin
          if SHGetPathFromIDList(FQ_IDList, FullPath) then begin
            if SUCCEEDED(SHGetDataFromIDList(ShellFolder, IDList, SHGDFIL_FINDDATA, FD, SizeOf(FD))) then begin

              // size in KBs
              Result.SubItems.Add(IntTOStr((FD.nFileSizeLow+1023) div 1024) + 'KB');

              // type
              if SHGetFileInfo(FullPath, 0, FI, SizeOf(FI), SHGFI_TYPENAME) <> 0 then
                Result.SubItems.Add(FI.szTypeName)
              else
                Result.SubItems.Add(''); // couldn't get type.

              // date / time
              FileTimeToLocalFileTime(FD.ftLastWriteTime, SysTime);
              FileTimeToSystemTime(FD.ftLastWriteTime, SysTime);
              SetLength(DateStr, 256);
              SetLength(DateStr, GetDateFormat(LOCALE_USER_DEFAULT, 0, @SysTime, NIL,
                                               PChar(DateStr), 255) - 1);
              SetLength(TimeStr, 256);
              SetLength(TimeStr, GetTimeFormat(LOCALE_USER_DEFAULT, 0, @SysTime, NIL,
                                               PChar(TimeStr), 255)  - 1);

              Result.SubItems.Add(DateStr + ' ' + TimeStr);
            end;
          end;
        end;

      SHDID_COMPUTER_DRIVE35,
      SHDID_COMPUTER_DRIVE525,
      SHDID_COMPUTER_REMOVABLE,
      SHDID_COMPUTER_FIXED,
      SHDID_COMPUTER_NETDRIVE,
      SHDID_COMPUTER_CDROM,
      SHDID_COMPUTER_RAMDISK,
      SHDID_COMPUTER_OTHER:
        begin
          Result.SubItems.Add('Computer');
        end;

      SHDID_NET_DOMAIN,
      SHDID_NET_SERVER,
      SHDID_NET_SHARE,
      SHDID_NET_RESTOFNET,
      SHDID_NET_OTHER:
        begin
          Result.SubItems.Add('Net');
        end;

    else { don't know what to do with it... }
    end;
  end; {if}
*)
end; {AddNode}


procedure TdfsSystemListView.SetFileMask(const Val: string);
begin
  if Val <> FFileMask then
  begin
    FFileMask := Val;
    MaskSearch.BuildMask(FFileMask, FFileMaskList);
    FNeedsReset := TRUE; // Added by Tamas Demjen
  end;
  Reset;
end;


function TdfsSystemListView.AddItemData(ItemFolder: IShellFolder;
   aIDList, aFQ_IDList: PItemIDList; Attrs: UINT): TFolderItemData;
begin
  Result := TFolderItemData.Create;
  with Result do
  begin
    Initialized := FALSE;
    SFParent := ItemFolder;
    {$IFNDEF DFS_NO_COM_CLEANUP} SFParent.AddRef; {$ENDIF}
    IDList := aIDList;
    FQ_IDList := aFQ_IDList;
    Attributes := Attrs;
  end;
  inc(NewCount);
end; {AddItemDta}


procedure TdfsSystemListView.FreeItemData(Item: TListItem);
begin
  if Item.Data <> NIL then
  begin
    with TFolderItemData(Item.Data) do
    begin
      {$IFNDEF DFS_NO_COM_CLEANUP}
      if SFParent <> NIL then
        SFParent.Release;
      {$ENDIF}
      FreePIDL(FIDList);
      FreePIDL(FFQ_IDList);
    end;
    TFolderItemData(Item.Data).Free;
    Item.Data := NIL;
    dec(NewCount);
  end;
end; {FreeItemData}


procedure TdfsSystemListView.FreeAllItemData;
var
  x: integer;
begin
  for x := 0 to Items.Count-1 do
    FreeItemData(Items[x]);
end; {FreeAllItemData}


(*******************************************************************************
  CNNotify:  Trap notification messages sent to the window.
    This is damn silly, but it's the only way we can know when an item is being
    deleted.  I think it's an oversight in the VCL, so until Borland fixes it,
    just live with it.
*******************************************************************************)
procedure TdfsSystemListView.CNNotify(var Message: TWMNotify);
{$IFDEF DFS_SLV_FASTMODE}
var
  Item:TListItem;
  NiceName: string;
  FI: TSHFileInfo;
  DI: TSHDescriptionID;
  FD: TWin32FindData;
  Res: HRESULT;
  fTime: TFileTime;
  SysTime: TSystemTime;
  DateStr,
  TimeStr: string;
  N, S: integer;
{$ENDIF}
begin