unit uFile; {$mode objfpc}{$H+} interface uses Classes, SysUtils, uFileProperty, DCBasicTypes; type { TFile } TFile = class private // Cached values for extension and name. // Automatically set when name changes. FExtension: String; //= 0) and (AIndex <= High(FVariantProperties)) then begin Result := FVariantProperties[AIndex]; FVariantProperties[AIndex] := nil; end; end else begin Result := FProperties[PropType]; FProperties[PropType] := nil; end; Exclude(FSupportedProperties, PropType); end; function TFile.GetExtension: String; begin Result := FExtension; end; function TFile.GetNameNoExt: String; begin Result := FNameNoExt; end; function TFile.GetName: String; begin Result := TFileNameProperty(FProperties[fpName]).Value; end; procedure TFile.SetName(NewName: String); begin TFileNameProperty(FProperties[fpName]).Value := NewName; UpdateNameAndExtension(NewName); end; function TFile.GetProperty(PropType: TFilePropertyType): TFileProperty; var AIndex: Integer; begin if PropType < fpInvalid then Result := FProperties[PropType] else begin AIndex := Ord(PropType) - Ord(fpVariant); if (AIndex >= 0) and (AIndex <= High(FVariantProperties)) then Result := FVariantProperties[AIndex] else begin Result := nil; end; end; end; procedure TFile.SetProperty(PropType: TFilePropertyType; NewValue: TFileProperty); var AIndex: Integer; begin if PropType < fpInvalid then FProperties[PropType] := NewValue else begin AIndex := Ord(PropType) - Ord(fpVariant); if AIndex > High(FVariantProperties) then SetLength(FVariantProperties, AIndex + 4); FVariantProperties[AIndex]:= NewValue; end; if Assigned(NewValue) then Include(FSupportedProperties, PropType) else Exclude(FSupportedProperties, PropType); end; function TFile.GetFullPath: String; begin Result := Path + TFileNameProperty(FProperties[fpName]).Value; end; procedure TFile.SetFullPath(const NewFullPath: String); var aExtractedName: String; begin if NewFullPath <> '' then begin if NewFullPath[Length(NewFullPath)] = PathDelim then begin // Only path passed. SetPath(NewFullPath); SetName(''); end else begin aExtractedName := ExtractFileName(NewFullPath); SetPath(Copy(NewFullPath, 1, Length(NewFullPath) - Length(aExtractedName))); SetName(aExtractedName); end; end; end; procedure TFile.SetPath(const NewPath: String); begin if NewPath = '' then FPath := '' else FPath := IncludeTrailingPathDelimiter(NewPath); end; function TFile.GetAttributes: TFileAttrs; begin Result := TFileAttributesProperty(FProperties[fpAttributes]).Value; end; procedure TFile.SetAttributes(NewAttributes: TFileAttrs); begin TFileAttributesProperty(FProperties[fpAttributes]).Value := NewAttributes; UpdateNameAndExtension(Name); end; function TFile.GetSize: Int64; begin Result := TFileSizeProperty(FProperties[fpSize]).Value; end; procedure TFile.SetSize(NewSize: Int64); begin TFileSizeProperty(FProperties[fpSize]).Value := NewSize; end; function TFile.GetCompressedSize: Int64; begin Result := TFileCompressedSizeProperty(FProperties[fpCompressedSize]).Value; end; procedure TFile.SetCompressedSize(NewCompressedSize: Int64); begin TFileCompressedSizeProperty(FProperties[fpCompressedSize]).Value := NewCompressedSize; end; function TFile.GetModificationTime: TDateTime; begin Result := TFileModificationDateTimeProperty(FProperties[fpModificationTime]).Value; end; procedure TFile.SetModificationTime(NewTime: TDateTime); begin TFileModificationDateTimeProperty(FProperties[fpModificationTime]).Value := NewTime; end; function TFile.GetCreationTime: TDateTime; begin Result := TFileCreationDateTimeProperty(FProperties[fpCreationTime]).Value; end; procedure TFile.SetCreationTime(NewTime: TDateTime); begin TFileCreationDateTimeProperty(FProperties[fpCreationTime]).Value := NewTime; end; function TFile.GetLastAccessTime: TDateTime; begin Result := TFileLastAccessDateTimeProperty(FProperties[fpLastAccessTime]).Value; end; procedure TFile.SetLastAccessTime(NewTime: TDateTime); begin TFileLastAccessDateTimeProperty(FProperties[fpLastAccessTime]).Value := NewTime; end; function TFile.GetIsLinkToDirectory: Boolean; begin if fpLink in SupportedProperties then Result := TFileLinkProperty(FProperties[fpLink]).IsLinkToDirectory else Result := False; end; procedure TFile.SetIsLinkToDirectory(NewValue: Boolean); begin TFileLinkProperty(FProperties[fpLink]).IsLinkToDirectory := NewValue; end; function TFile.GetType: String; begin Result := TFileTypeProperty(FProperties[fpType]).Value; end; procedure TFile.SetType(NewValue: String); begin TFileTypeProperty(FProperties[fpType]).Value := NewValue; end; function TFile.GetNameProperty: TFileNameProperty; begin Result := TFileNameProperty(FProperties[fpName]); end; procedure TFile.SetNameProperty(NewValue: TFileNameProperty); begin FProperties[fpName] := NewValue; if Assigned(NewValue) then Include(FSupportedProperties, fpName) else Exclude(FSupportedProperties, fpName); end; function TFile.GetAttributesProperty: TFileAttributesProperty; begin Result := TFileAttributesProperty(FProperties[fpAttributes]); end; procedure TFile.SetAttributesProperty(NewValue: TFileAttributesProperty); begin FProperties[fpAttributes] := NewValue; if Assigned(NewValue) then begin Include(FSupportedProperties, fpAttributes); UpdateNameAndExtension(Name); end else Exclude(FSupportedProperties, fpAttributes); end; function TFile.GetSizeProperty: TFileSizeProperty; begin Result := TFileSizeProperty(FProperties[fpSize]); end; procedure TFile.SetSizeProperty(NewValue: TFileSizeProperty); begin FProperties[fpSize] := NewValue; if Assigned(NewValue) then Include(FSupportedProperties, fpSize) else Exclude(FSupportedProperties, fpSize); end; function TFile.GetCompressedSizeProperty: TFileCompressedSizeProperty; begin Result := TFileCompressedSizeProperty(FProperties[fpCompressedSize]); end; procedure TFile.SetCompressedSizeProperty(NewValue: TFileCompressedSizeProperty); begin FProperties[fpCompressedSize] := NewValue; if Assigned(NewValue) then Include(FSupportedProperties, fpCompressedSize) else Exclude(FSupportedProperties, fpCompressedSize); end; function TFile.GetModificationTimeProperty: TFileModificationDateTimeProperty; begin Result := TFileModificationDateTimeProperty(FProperties[fpModificationTime]); end; procedure TFile.SetModificationTimeProperty(NewValue: TFileModificationDateTimeProperty); begin FProperties[fpModificationTime] := NewValue; if Assigned(NewValue) then Include(FSupportedProperties, fpModificationTime) else Exclude(FSupportedProperties, fpModificationTime); end; function TFile.GetCreationTimeProperty: TFileCreationDateTimeProperty; begin Result := TFileCreationDateTimeProperty(FProperties[fpCreationTime]); end; procedure TFile.SetCreationTimeProperty(NewValue: TFileCreationDateTimeProperty); begin FProperties[fpCreationTime] := NewValue; if Assigned(NewValue) then Include(FSupportedProperties, fpCreationTime) else Exclude(FSupportedProperties, fpCreationTime); end; function TFile.GetLastAccessTimeProperty: TFileLastAccessDateTimeProperty; begin Result := TFileLastAccessDateTimeProperty(FProperties[fpLastAccessTime]); end; procedure TFile.SetLastAccessTimeProperty(NewValue: TFileLastAccessDateTimeProperty); begin FProperties[fpLastAccessTime] := NewValue; if Assigned(NewValue) then Include(FSupportedProperties, fpLastAccessTime) else Exclude(FSupportedProperties, fpLastAccessTime); end; function TFile.GetChangeTime: TDateTime; begin Result := TFileChangeDateTimeProperty(FProperties[fpChangeTime]).Value; end; procedure TFile.SetChangeTime(AValue: TDateTime); begin TFileChangeDateTimeProperty(FProperties[fpChangeTime]).Value := AValue; end; function TFile.GetChangeTimeProperty: TFileChangeDateTimeProperty; begin Result := TFileChangeDateTimeProperty(FProperties[fpChangeTime]); end; procedure TFile.SetChangeTimeProperty(AValue: TFileChangeDateTimeProperty); begin FProperties[fpChangeTime] := AValue; if Assigned(AValue) then Include(FSupportedProperties, fpChangeTime) else Exclude(FSupportedProperties, fpChangeTime); end; function TFile.GetLinkProperty: TFileLinkProperty; begin Result := TFileLinkProperty(FProperties[fpLink]); end; procedure TFile.SetLinkProperty(NewValue: TFileLinkProperty); begin FProperties[fpLink] := NewValue; if Assigned(NewValue) then Include(FSupportedProperties, fpLink) else Exclude(FSupportedProperties, fpLink); end; function TFile.GetOwnerProperty: TFileOwnerProperty; begin Result := TFileOwnerProperty(FProperties[fpOwner]); end; procedure TFile.SetOwnerProperty(NewValue: TFileOwnerProperty); begin FProperties[fpOwner] := NewValue; if Assigned(NewValue) then Include(FSupportedProperties, fpOwner) else Exclude(FSupportedProperties, fpOwner); end; function TFile.GetTypeProperty: TFileTypeProperty; begin Result := TFileTypeProperty(FProperties[fpType]); end; procedure TFile.SetTypeProperty(NewValue: TFileTypeProperty); begin FProperties[fpType] := NewValue; if Assigned(NewValue) then Include(FSupportedProperties, fpType) else Exclude(FSupportedProperties, fpType); end; function TFile.GetCommentProperty: TFileCommentProperty; begin Result := TFileCommentProperty(FProperties[fpComment]); end; procedure TFile.SetCommentProperty(NewValue: TFileCommentProperty); begin FProperties[fpComment] := NewValue; if Assigned(NewValue) then Include(FSupportedProperties, fpComment) else Exclude(FSupportedProperties, fpComment); end; function TFile.IsNameValid: Boolean; begin if Name <> '..' then Result := True else Result := False; end; function TFile.IsDirectory: Boolean; begin if fpAttributes in SupportedProperties then Result := TFileAttributesProperty(FProperties[fpAttributes]).IsDirectory else Result := False; end; function TFile.IsLink: Boolean; begin if fpAttributes in SupportedProperties then Result := TFileAttributesProperty(FProperties[fpAttributes]).IsLink else Result := False; end; function TFile.IsExecutable: Boolean; var FileAttributes: TFileAttributesProperty; begin if fpAttributes in SupportedProperties then begin FileAttributes := TFileAttributesProperty(FProperties[fpAttributes]); {$IF DEFINED(MSWINDOWS)} Result := not FileAttributes.IsDirectory; {$ELSEIF DEFINED(UNIX)} Result := (not FileAttributes.IsDirectory) and (FileAttributes.Value AND (S_IXUSR OR S_IXGRP OR S_IXOTH)>0); {$ELSE} Result := False; {$ENDIF} end else Result := False; end; function TFile.IsSysFile: Boolean; begin {$IFDEF MSWINDOWS} if fpAttributes in SupportedProperties then Result := TFileAttributesProperty(Properties[fpAttributes]).IsSysFile else Result := False; {$ELSE} // Files beginning with '.' are treated as system/hidden files on Unix. Result := (Length(Name) > 1) and (Name[1] = '.') and (Name <> '..'); {$ENDIF} end; function TFile.IsHidden: Boolean; begin if not (fpAttributes in SupportedProperties) then Result := False else begin if Properties[fpAttributes] is TNtfsFileAttributesProperty then Result := TNtfsFileAttributesProperty(Properties[fpAttributes]).IsHidden else begin // Files beginning with '.' are treated as system/hidden files on Unix. Result := (Length(Name) > 1) and (Name[1] = '.') and (Name <> '..'); end; end; end; procedure TFile.SplitIntoNameAndExtension(const FileName: string; var aFileNameOnly: string; var aExtension: string); var i : longint; begin I := Length(FileName); while (I > 0) and (FileName[I] <> ExtensionSeparator) do Dec(I); if I > 1 then begin aFileNameOnly := Copy(FileName, 1, I - 1); aExtension := Copy(FileName, I + 1, MaxInt); end else begin // For files that does not have '.' or that have only // one '.' and beginning with '.' there is no extension. aFileNameOnly := FileName; aExtension := ''; end; end; procedure TFile.UpdateNameAndExtension(const FileName: string); begin // Cache Extension and NameNoExt. if (FileName = '') or IsDirectory or IsLinkToDirectory then begin // For directories there is no extension. FExtension := ''; FNameNoExt := FileName; end else begin SplitIntoNameAndExtension(FileName, FNameNoExt, FExtension); end; end; // ---------------------------------------------------------------------------- constructor TFiles.Create(const APath: String); begin inherited Create; FList := TFPList.Create; FOwnsObjects := True; Path := APath; end; destructor TFiles.Destroy; begin Clear; FreeAndNil(FList); inherited; end; function TFiles.Clone: TFiles; begin Result := TFiles.Create(Path); CloneTo(Result); end; procedure TFiles.CloneTo(Files: TFiles); var i: Integer; begin for i := 0 to FList.Count - 1 do begin Files.Add(Get(i).Clone); end; end; function TFiles.GetCount: Integer; begin Result := FList.Count; end; procedure TFiles.SetCount(Count: Integer); begin FList.Count := Count; end; function TFiles.Add(AFile: TFile): Integer; begin Result := FList.Add(AFile); end; procedure TFiles.Insert(AFile: TFile; AtIndex: Integer); begin FList.Insert(AtIndex, AFile); end; procedure TFiles.Delete(AtIndex: Integer); var p: Pointer; begin p := FList.Items[AtIndex]; TFile(p).Free; FList.Delete(AtIndex); end; procedure TFiles.Clear; var i: Integer; p: Pointer; begin if OwnsObjects then begin for i := 0 to FList.Count - 1 do begin p := FList.Items[i]; TFile(p).Free; end; end; FList.Clear; end; function TFiles.Get(Index: Integer): TFile; begin Result := TFile(FList.Items[Index]); end; procedure TFiles.Put(Index: Integer; AFile: TFile); begin FList.Items[Index] := AFile; end; procedure TFiles.SetPath(const NewPath: String); begin if NewPath = '' then FPath := '' else FPath := IncludeTrailingPathDelimiter(NewPath); end; // ---------------------------------------------------------------------------- constructor TFileTreeNode.Create; begin Create(nil); end; constructor TFileTreeNode.Create(aFile: TFile); begin FSubNodes := nil; FFile := aFile; FData := nil; inherited Create; end; constructor TFileTreeNode.Create(aFile: TFile; DataClass: TClass); begin Create(aFile); FData := DataClass.Create; end; destructor TFileTreeNode.Destroy; var i: Integer; begin inherited Destroy; FreeAndNil(FFile); if Assigned(FSubNodes) then begin for i := 0 to FSubNodes.Count - 1 do TFileTreeNode(FSubNodes.Items[i]).Free; FreeAndNil(FSubNodes); end; FreeAndNil(FData); end; function TFileTreeNode.AddSubNode(aFile: TFile): Integer; var aNode: TFileTreeNode; begin if not Assigned(FSubNodes) then FSubNodes := TFPList.Create; aNode := TFileTreeNode.Create(aFile); Result := FSubNodes.Add(aNode); end; procedure TFileTreeNode.RemoveSubNode(Index: Integer); begin if (Index >= 0) and (Index < FSubNodes.Count) then begin TFileTreeNode(FSubNodes.Items[Index]).Free; FSubNodes.Delete(Index); end; end; function TFileTreeNode.Get(Index: Integer): TFileTreeNode; begin Result := TFileTreeNode(FSubNodes.Items[Index]); end; function TFileTreeNode.GetCount: Integer; begin if Assigned(FSubNodes) then Result := FSubNodes.Count else Result := 0; end; procedure TFileTreeNode.SetCount(Count: Integer); begin if not Assigned(FSubNodes) then FSubNodes := TFPList.Create; FSubNodes.Count := Count; end; procedure TFileTreeNode.SetData(NewData: TObject); var TmpData: TObject; begin if Assigned(FData) then begin TmpData := FData; FData := NewData; TmpData.Free; end else FData := NewData; end; end.