spskinshellctrls.pas

P2P即时通讯源码(DELPHI编写)

procedure TspSkinFileListView.CompareFiles(Sender: TObject; Item1,
	Item2: TListItem; Data: Integer; var Compare: Integer);
var
  s1,s2,Caption1, Caption2: String;
  size1, size2: Double;
  result: integer;
begin
  Result := 0;
  if (UpperCase(FDirectory) = 'DRIVES') then Exit;
  if (Item1.SubItems[0] = ' ') and (Item2.SubItems[0] <> ' ')
  then
    Result := -1
  else
  if (Item1.SubItems[0] <> ' ') and (Item2.SubItems[0] = ' ')
  then
    Result := 1
  else
  case FSortColumn of
    0:
      begin
        Caption1 := AnsiUpperCase(Item1.Caption);
        Caption2 := AnsiUpperCase(Item2.Caption);
        if Caption1 > Caption2
        then
          Result := 1
        else
        if Caption1 < Caption2
        then
          Result := -1
      end;
    1:
      begin
        s1 := Item1.SubItems[0];
        s2 := Item2.SubItems[0];
        if (s1 = '') or (s1 = ' ') then s1 := '0';
        if (s2 = '') or (s2 = ' ') then s2 := '0';
        size1 := StrToFloat(s1);
        size2 := StrToFloat(s2);
        if size1 > size2
        then Result := 1
        else Result := -1;
      end;
    3:
      begin
        s1 := Item1.SubItems[2];
        s2 := Item2.SubItems[2];
        size1 := StrToDateTime(s1);
        size2 := StrToDateTime(s2);
        if size1 > size2
        then Result := 1
        else Result := -1;
      end;

  end;
  if FSortForward then
    Compare:= - result
  else
    Compare := result;
end;


procedure TspSkinFileListView.Keydown(var Key: Word; Shift: TShiftState);
begin
 if ((Shift=[ssCtrl]) and (key=vk_up)) or (key=vk_back) then
   OneLevelUp
 else
   if (key=vk_return) and assigned(selected) then
     DblClick;
 inherited;
end;

procedure TspSkinFileListView.UpdateFileList;
var
  oldCur: TCursor;
  MaskPtr: PChar;
  AttrIndex: TFileAttr;
  Ptr: PChar;
  DirAttr, FileAttr: DWORD;
  FName: String;
const
  dwFileAttr: array[TFileAttr] of DWord = (FILE_ATTRIBUTE_READONLY,
		FILE_ATTRIBUTE_HIDDEN, FILE_ATTRIBUTE_SYSTEM,
		FILE_ATTRIBUTE_ARCHIVE, FILE_ATTRIBUTE_NORMAL);
begin
  Items.beginUpdate;
  Items.Clear;
  OldCur:=Screen.Cursor;
  Screen.Cursor:=crHourGlass;
  FDirectorySize:=0;
  try
    if UpperCase(FDirectory)='DRIVES' then begin
      Column[1].Caption:=SP_FLV_TYPE;
      Column[1].Width:=100;
      Column[1].Alignment:=taLeftJustify;
      Column[2].Caption:=SP_FLV_DISKSIZE;
      Column[2].Width:=100;
      Column[2].Alignment:=taRightJustify;
      Column[3].Caption:=SP_FLV_FREESPACE;
      Column[3].Width:=100;
      Column[3].Alignment:=taRightJustify;
      AddDrives;
    end else begin
      Column[1].Caption:=SP_FLV_SIZE;
      Column[1].Width:=70;
      Column[1].Alignment:=taRightJustify;
      Column[2].Caption:=SP_FLV_TYPE;
      Column[2].Width:=150;
      Column[2].Alignment:=taLeftJustify;
      Column[3].Caption:=SP_FLV_ATTRIBUTES;
      Column[3].Width:=110;
      Column[3].Alignment:=taLeftJustify;
      FileAttr:=0;
      for AttrIndex:=ftReadOnly to ftNormal do
    	if AttrIndex in FileType then
	  FileAttr:=FileAttr or dwFileAttr[AttrIndex];
      DirAttr := FileAttr or FILE_ATTRIBUTE_DIRECTORY;
      CurPath := IncludeTrailingBackslash(FDirectory);
      FName:=CurPath+ '*.*';
      AddFile(FName, DirAttr);
      MaskPtr:=PChar(FMask);
      while MaskPtr<>nil do begin
    	Ptr:=StrScan(MaskPtr,';');
	if Ptr<>nil then
	  Ptr^:=#0;
	  AddFile((CurPath+StrPas(MaskPtr)),FileAttr);
	  if Ptr<>nil then begin
    	    Ptr^:=';';
	    inc(Ptr);
	  end;
	  MaskPtr:=Ptr;
       end;
     end;
  finally
    FSortForward:=True;
    if not (UpperCase(FDirectory)='DRIVES') then 
      ColumnClick(Self,Columns[0]);
  end;
  Items.EndUpdate;
  Screen.Cursor:=oldCur;
  Application.ProcessMessages;
end;

procedure TspSkinFileListView.AddDrives;
var
  shInfo: TSHFileInfo;
  NewItem: TListItem;
  i: Integer;
  Drv: String;
  DI: TDiskInfo;
begin
  Integer(Drives):=GetLogicalDrives;
  for i:=0 to 25 do
    if (i in Drives) then begin
      Drv:=Char(i+Ord('A'))+':';
      NewItem:=Items.Add;
      try
        SHGetFileInfo(PChar(Drv+'\'),0,shInfo,SizeOf(shInfo),SHGFI_SYSICONINDEX or SHGFI_DISPLAYNAME or SHGFI_TYPENAME);
    	if SmallImages<>nil then
     	  NewItem.ImageIndex:=shInfo.Iicon;
        NewItem.Caption:=StrPas(shInfo.szDisplayName);
        DI:=GetDiskInfo(TDiskSign(Drv));
        NewItem.SubItems.Add(GetMediaTypeStr(DI.MediaType));
        if (Drv <> 'A:') and (Drv <> 'B:')
        then
          begin
            NewItem.SubItems.Add(FormatFloat('###,###,##0', DI.Capacity));
            NewItem.SubItems.Add(FormatFloat('###,###,##0', DI.FreeSpace));
          end
        else
          begin
            NewItem.SubItems.Add('');
            NewItem.SubItems.Add('');
          end;  
        NewItem.SubItems.Add('');
        NewItem.SubItems.Add(Drv+'\');
        NewItem.SubItems.Add('drv');
      except
        Items.Delete(NewItem.Index);
      end;
   end;
end;

function TspSkinFileListView.AddFile(FileMask: String; Attr: DWord): Boolean;
var
  ShInfo: TSHFileInfo;
  S, attributes: String;
  FDate, FName, FileName: String;
  FSize: Integer;
  FI: TSearchRec;

  function AttrStr(Attr: integer): String;
  begin
    Result:='';
    if (FILE_ATTRIBUTE_DIRECTORY and Attr)>0 then
      Result:=Result+'';
    if (FILE_ATTRIBUTE_ARCHIVE and Attr)>0 then
      Result:=Result+'A';
    if (FILE_ATTRIBUTE_READONLY and Attr)>0 then
      Result:=Result+'R';
    if (FILE_ATTRIBUTE_HIDDEN and Attr)>0 then
      Result:=Result+'H';
    if (FILE_ATTRIBUTE_SYSTEM and Attr)>0 then
      Result:=Result+'S';
  end;

begin
  Result := False;
  if not SetCurrentDir(FDirectory) then
    exit;
  if FindFirst(FileMask,faAnyFile,FI)=0 then
    try
      repeat
          if ((Attr and FILE_ATTRIBUTE_DIRECTORY)=(FI.Attr and FILE_ATTRIBUTE_DIRECTORY))then begin
       	    CurPath:=IncludeTrailingBackslash(FDirectory);
	    FName:=FI.Name;
            S := ExtractFileExt(FileMask);
            if (Pos ('*', S) = 0) and (Pos ('?', S) = 0) and
               not ((FI.Attr and FILE_ATTRIBUTE_DIRECTORY)=FILE_ATTRIBUTE_DIRECTORY) and
               (UpperCase(ExtractFileExt(FI.Name)) <> UpperCase(ExtractFileExt(FileMask)))
            then
              Continue;
	    FileName:=IncludeTrailingBackslash(FDirectory)+FName;
	    if (FName='.') or (FName='..') then
              continue;
            SHGetFileInfo(PChar(FileName),0,ShInfo,SizeOf(ShInfo),SHGFI_TYPENAME or SHGFI_SYSICONINDEX or SHGFI_DISPLAYNAME);
            FSize:=FI.Size;
            FDate:=DateTimeToStr(FileDateToDateTime(FI.Time));
	    Attributes:=AttrStr(FI.Attr);
	    with Items.Add do begin
              Caption:=FName;
	      if SmallImages<>nil then
		ImageIndex:=ShInfo.iIcon;
              if (FI.Attr and FILE_ATTRIBUTE_DIRECTORY)=FILE_ATTRIBUTE_DIRECTORY then
        	SubItems.Add(' ')
              else
                SubItems.Add(Trim(IntToStr(FSize)));
              SubItems.Add((ShInfo.szTypeName));
	      SubItems.Add(FDate);
	      SubItems.Add(attributes);
	      SubItems.Add(FileName);
	      if (FI.Attr and FILE_ATTRIBUTE_DIRECTORY)=FILE_ATTRIBUTE_DIRECTORY then
                SubItems.Add('dir')
	      else
                SubItems.Add('file');
	    end;
            FDirectorySize:=FDirectorySize+FSize;
            Result:=True;
          end;
     until FindNext(FI)<>0;
  finally
    FindClose(FI);
  end;
end;


procedure TspSkinFileListView.OneLevelUp;
var
  NewDir: String;
begin
  if UpperCase(Directory)='DRIVES' then
    exit;
  FDirectory:=IncludeTrailingBackslash(FDirectory);
  if (FDirectory[Length(FDirectory)-1]=':') then
    SetDirectory('Drives')
  else begin
    FDirectory:=Copy(FDirectory,1,Length(FDirectory)-1);
    NewDir:=ExtractFilePath(FDirectory);
    SetDirectory(NewDir);
  end;
end;

procedure TspSkinFileListView.Click;
begin
  if (Selected <> nil) and (Selected.SubItems[5] = 'file')
  then
    SetFileName(Selected.SubItems[4])
  else
    SetFileName('');
  inherited;
end;

procedure TspSkinFileListView.DblClick;
var
  sDir: String;
begin
  inherited;
  if Selected=nil then
    exit;
  if (Selected.SubItems[5]='dir') or (Selected.SubItems[5]='drv') then begin
    sDir:=Selected.SubItems[4];
    sDir:=IncludeTrailingBackslash(sDir);
    SetDirectory(sDir);
  end;{ else
    if Selected.SubItems[5]='file' then
      if fcontextaction then
        PerformDefaultAction(filename, handle);}
end;

procedure TspSkinFileListView.WMRButtonDown(var Message: TWMRButtonDown);
begin
  DoMouseDown(Message, mbRight, []);
end;

procedure TspSkinFileListView.DoMouseDown(var Message: TWMMouse;
  Button: TMouseButton; Shift: TShiftState);
begin
  if not (csNoStdEvents in ControlStyle) then
    with Message do
      MouseDown(Button, KeysToShiftState(Keys) + Shift, XPos, YPos);
end;

function TspSkinFileListView.GetFiles: TStringList;
begin
  GetSelectedFilenames;
  Result := FSelectedFiles;
end;

function TspSkinFileListView.GetSelectedFilenames: String;
var
 i: integer;
begin
  Result := '';
  Fselectedfiles.clear;
  if SelCount=0 then
    exit;
  for i:=0 to Items.Count-1 do
    if Items[i].selected then begin
      fselectedfiles.add(Items[i].SubItems[4]);
      result:=result+Items[i].SubItems[4]+';';
    end;
  Result:=copy(result,1,length(result)-1);
end;

function TspSkinFileListView.GetObjectTypes: TObjectTypes;
var
 i: integer;
begin
  Result:=[];
  fselectedfiles.clear;
  if SelCount=0 then
    exit;
  for i:=0 to Items.Count-1 do
    if Items[i].selected then begin
      if Items[i].SubItems[5]='file' then
        result:=result+[otfile]
      else
        if Items[i].SubItems[5]='dir' then
          result:=result+[otdirectory]
        else
          if Items[i].SubItems[5]='drv' then
            result:=result+[otdisk];
    end;
end;

function TspSkinFileListView.GetDiskCap: Int64;
begin
  Result:=GetDiskInfo(Copy(FDirectory,1,1)+':').Capacity;
end;

function TspSkinFileListView.GetDiskFree: Int64;
begin
  Result:=GetDiskInfo(Copy(FDirectory,1,1)+':').FreeSpace;
end;

function TspSkinFileListView.GetDiskInfo(Value: TDiskSign): TDiskInfo;
var
  BPS,TC,FC,SPC :integer;
  T,F :TLargeInteger;
  TF :PLargeInteger;
  bufRoot, bufVolumeLabel, bufFileSystem :pchar;
  MCL,Size,Flags :DWORD;
  s :String;
begin
  with Result do begin
    Sign:=Value;
    Size:=255;
    bufRoot:=AllocMem(Size);
    strpcopy(bufRoot,Value+'\');
    case GetDriveType(bufRoot) of
      DRIVE_UNKNOWN     :MediaType:=dtUnknown;
      DRIVE_NO_ROOT_DIR :MediaType:=dtNotExists;
      DRIVE_REMOVABLE   :MediaType:=dtRemovable;
      DRIVE_FIXED       :MediaType:=dtFixed;
      DRIVE_REMOTE      :MediaType:=dtRemote;
      DRIVE_CDROM       :MediaType:=dtCDROM;
      DRIVE_RAMDISK     :MediaType:=dtRAMDisk;
    end;
    FileFlags:=[];
    if GetMediaPresent(Value) then begin
      GetDiskFreeSpace(bufRoot,SectorsPerCluster,BytesPerSector,FreeClusters,TotalClusters);
      try
        new(TF);
        SysUtils.GetDiskFreeSpaceEx(bufRoot,F,T,TF);
        Capacity:=T;
        FreeSpace:=F;
        dispose(TF);
      except
        BPS:=BytesPerSector;
        TC:=TotalClusters;
        FC:=FreeClusters;
        SPC:=SectorsPerCluster;
        Capacity:=TC*SPC*BPS;
        FreeSpace:=FC*SPC*BPS;
      end;
      bufVolumeLabel:=AllocMem(Size);
      bufFileSystem:=AllocMem(Size);
      if GetVolumeInformation(bufRoot,bufVolumeLabel,Size,@Serial,MCL,Flags,bufFileSystem,Size) then begin;
        VolumeLabel:=bufVolumeLabel;
        FileSystem:=bufFileSystem;
        s:=IntToHex(Serial,8);
        SerialNumber:=copy(s,1,4)+'-'+copy(s,5,4);
        FreeMem(bufVolumeLabel);
        FreeMem(bufFileSystem);
        FreeMem(bufRoot);
        if Flags and FS_CASE_SENSITIVE=FS_CASE_SENSITIVE then
          FileFlags:=FileFlags+[fsCaseSensitive];
        if Flags and FS_CASE_IS_PRESERVED=FS_CASE_IS_PRESERVED then
          FileFlags:=FileFlags+[fsCaseIsPreserved];
        if Flags and FS_UNICODE_STORED_ON_DISK=FS_UNICODE_STORED_ON_DISK then
          FileFlags:=FileFlags+[fsUnicodeStoredOnDisk];
        if Flags and FS_PERSISTENT_ACLS=FS_PERSISTENT_ACLS then
          FileFlags:=FileFlags+[fsPersistentAcls];
        if Flags and FS_VOL_IS_COMPRESSED=FS_VOL_IS_COMPRESSED then
          FileFlags:=FileFlags+[fsVolumeIsCompressed];
        if Flags and FS_FILE_COMPRESSION=FS_FILE_COMPRESSION then
          FileFlags:=FileFlags+[fsFileCompression];
        if MCL=255 then
          FileFlags:=FileFlags+[fsLongFileNames];
        if Flags and FILE_SUPPORTS_ENCRYPTION=FILE_SUPPORTS_ENCRYPTION then
          FileFlags:=FileFlags+[fsEncryptedFileSystemSupport];
        if Flags and FILE_SUPPORTS_OBJECT_IDS=FILE_SUPPORTS_OBJECT_IDS then
          FileFlags:=FileFlags+[fsObjectIDsSupport];
        if Flags and FILE_SUPPORTS_REPARSE_POINTS=FILE_SUPPORTS_REPARSE_POINTS then
          FileFlags:=FileFlags+[fsReparsePointsSupport];
        if Flags and FILE_SUPPORTS_SPARSE_FILES=FILE_SUPPORTS_SPARSE_FILES then
          FileFlags:=FileFlags+[fsSparseFilesSupport];
        if Flags and FILE_VOLUME_QUOTAS=FILE_VOLUME_QUOTAS then
          FileFlags:=FileFlags+[fsDiskQuotasSupport];
      end;
    end else begin
      SectorsPerCluster:=0;
      BytesPerSector:=0;
      FreeClusters:=0;
      TotalClusters:=0;
      Capacity:=0;
      FreeSpace:=0;
      VolumeLabel:='';
      SerialNumber:='';
      FileSystem:='';
      Serial:=0;
    end;
  end;
end;