jvsearchfiles.pas

East make Tray Icon in delphi

    just changes the options, and doesn't ensure that the properties hold
    for all data. For example unsetting flag soStripDirs while searching,
    results in a file list with values stripped, and other values not stripped.

    An other option could be to raise an exception when the user tries to
    change Options while the component is searching. But because no serious
    harm is caused - by changing Options, while searching - the component
    doen't do that.
  }
  { (p3) you could also do:
    if Searching then Exit;
  }
  // (rom) even better the search should use a local copy which stays unchanged

  if FOptions <> Value then
  begin
    ChangedOptions := FOptions + Value - (FOptions * Value);

    FOptions := Value;

    if soSorted in ChangedOptions then
    begin
      FDirectories.Sorted := soSorted in FOptions;
      FFiles.Sorted := soSorted in FOptions;
    end;

    if soAllowDuplicates in ChangedOptions then
    begin
      if soAllowDuplicates in FOptions then
      begin
        FDirectories.Duplicates := dupAccept;
        FFiles.Duplicates := dupAccept;
      end
      else
      begin
        FDirectories.Duplicates := dupIgnore;
        FFiles.Duplicates := dupIgnore;
      end;
    end;
    // soStripDirs; soIncludeSubDirs; soOwnerData
  end;
end;

//=== { TJvSearchAttributes } ================================================

procedure TJvSearchAttributes.Assign(Source: TPersistent);
begin
  if Source is TJvSearchAttributes then
  begin
    IncludeAttr := TJvSearchAttributes(Source).IncludeAttr;
    ExcludeAttr := TJvSearchAttributes(Source).ExcludeAttr;
  end
  else
    inherited Assign(Source);
end;

procedure TJvSearchAttributes.DefineProperties(Filer: TFiler);
var
  Ancestor: TJvSearchAttributes;
  Attr: DWORD;
begin
  Attr := 0;
  Ancestor := TJvSearchAttributes(Filer.Ancestor);
  if Assigned(Ancestor) then
    Attr := Ancestor.FIncludeAttr;
  Filer.DefineProperty('IncludeAttr', ReadIncludeAttr, WriteIncludeAttr,
    Attr <> FIncludeAttr);
  if Assigned(Ancestor) then
    Attr := Ancestor.FExcludeAttr;
  Filer.DefineProperty('ExcludeAttr', ReadExcludeAttr, WriteExcludeAttr,
    Attr <> FExcludeAttr);
end;

function TJvSearchAttributes.GetAttr(const Index: Integer): TJvAttrFlagKind;
begin
  if FIncludeAttr and Index > 0 then
    Result := tsMustBeSet
  else
  if FExcludeAttr and Index > 0 then
    Result := tsMustBeUnSet
  else
    Result := tsDontCare;
end;

procedure TJvSearchAttributes.ReadExcludeAttr(Reader: TReader);
begin
  FExcludeAttr := Reader.ReadInteger;
end;

procedure TJvSearchAttributes.ReadIncludeAttr(Reader: TReader);
begin
  FIncludeAttr := Reader.ReadInteger;
end;

procedure TJvSearchAttributes.SetAttr(const Index: Integer;
  Value: TJvAttrFlagKind);
begin
  case Value of
    tsMustBeSet:
      begin
        FIncludeAttr := FIncludeAttr or DWORD(Index);
        FExcludeAttr := FExcludeAttr and not Index;
      end;
    tsMustBeUnSet:
      begin
        FIncludeAttr := FIncludeAttr and not Index;
        FExcludeAttr := FExcludeAttr or DWORD(Index);
      end;
    tsDontCare:
      begin
        FIncludeAttr := FIncludeAttr and not Index;
        FExcludeAttr := FExcludeAttr and not Index;
      end;
  end;
end;

procedure TJvSearchAttributes.WriteExcludeAttr(Writer: TWriter);
begin
  Writer.WriteInteger(FExcludeAttr);
end;

procedure TJvSearchAttributes.WriteIncludeAttr(Writer: TWriter);
begin
  Writer.WriteInteger(FIncludeAttr);
end;

//=== { TJvSearchParams } ====================================================

constructor TJvSearchParams.Create;
begin
  // (rom) added inherited Create
  inherited Create;
  FAttributes := TJvSearchAttributes.Create;
  FFileMasks := TStringList.Create;
  FFileMasks.OnChange := FileMasksChange;
  FCaseFileMasks := TStringList.Create;

  { defaults }
  FFileMaskSeperator := ';';
  { Set to 1-1-1980 }
  FLastChangeBefore := CDate1_1_1980;
  FLastChangeAfter := CDate1_1_1980;
end;

destructor TJvSearchParams.Destroy;
begin
  FAttributes.Free;
  FFileMasks.Free;
  FCaseFileMasks.Free;
  inherited Destroy;
end;

procedure TJvSearchParams.Assign(Source: TPersistent);
var
  Src: TJvSearchParams;
begin
  if Source is TJvSearchParams then
  begin
    Src := TJvSearchParams(Source);
    MaxSize := Src.MaxSize;
    MinSize := Src.MinSize;
    LastChangeBefore := Src.LastChangeBefore;
    LastChangeAfter := Src.LastChangeAfter;
    SearchTypes := Src.SearchTypes;
    FileMasks.Assign(Src.FileMasks);
    FileMaskSeperator := Src.FileMaskSeperator;
    Attributes.Assign(Src.Attributes);
  end
  else
    inherited Assign(Source);
end;

function TJvSearchParams.Check(const AFindData: TWin32FindData): Boolean;
var
  I: Integer;
  FileName: string;
begin
  Result := False;
  with AFindData do
  begin
    if stAttribute in FSearchTypes then
    begin
      { Note that if you set a flag in both ExcludeAttr and IncludeAttr
        the search always returns False }
      if dwFileAttributes and Attributes.ExcludeAttr > 0 then
        Exit;
      if dwFileAttributes and Attributes.IncludeAttr <> Attributes.IncludeAttr then
        Exit;
    end;

    if stMinSize in FSearchTypes then
      if (nFileSizeHigh < FMinSizeHigh) or
        ((nFileSizeHigh = FMinSizeHigh) and (nFileSizeLow < FMinSizeLow)) then
        Exit;
    if stMaxSize in FSearchTypes then
      if (nFileSizeHigh > FMaxSizeHigh) or
        ((nFileSizeHigh = FMaxSizeHigh) and (nFileSizeLow > FMaxSizeLow)) then
        Exit;
    if stLastChangeAfter in FSearchTypes then
      if CompareFileTime(ftLastWriteTime, FLastChangeAfterFT) < 0 then
        Exit;
    if stLastChangeBefore in FSearchTypes then
      if CompareFileTime(ftLastWriteTime, FLastChangeBeforeFT) > 0 then
        Exit;
    if (stFileMask in FSearchTypes) and (FFileMasks.Count > 0) then
    begin
      { StrMatches in JclStrings.pas is case-sensitive, thus for non case-
        sensitive search we have to do a little trick. The filename is
        upper-cased and compared with masks that are also upper-cased.
        This is a bit clumsy; a better solution would be to do this in
        StrMatches.

        I guess a lot of masks have the format 'mask*' or '*.ext'; so
        if you could specifiy to do a left or right scan in StrMatches
        would be better too. Note that if no char follows a '*', the
        result is always true; this isn't implemented so in StrMatches }

      if stFileMaskCaseSensitive in SearchTypes then
        FileName := cFileName
      else
        FileName := AnsiUpperCase(cFileName);

      I := 0;
      while (I < FFileMasks.Count) and
        not JclStrings.StrMatches(FCaseFileMasks[I], FileName) do
        Inc(I);
      if I >= FFileMasks.Count then
        Exit;
    end;
  end;
  Result := True;
end;

procedure TJvSearchParams.FileMasksChange(Sender: TObject);
begin
  UpdateCaseMasks;
end;

function TJvSearchParams.GetFileMask: string;
begin
  Result := JclStrings.StringsToStr(FileMasks, FileMaskSeperator);
end;

function TJvSearchParams.GetMaxSize: Int64;
begin
  Int64Rec(Result).Lo := FMaxSizeLow;
  Int64Rec(Result).Hi := FMaxSizeHigh;
end;

function TJvSearchParams.GetMinSize: Int64;
begin
  Int64Rec(Result).Lo := FMinSizeLow;
  Int64Rec(Result).Hi := FMinSizeHigh;
end;

function TJvSearchParams.GetFileMasks: TStrings;
begin
  Result := FFileMasks;
end;

function TJvSearchParams.IsLastChangeAfterStored: Boolean;
begin
  Result := FLastChangeBefore <> CDate1_1_1980;
end;

function TJvSearchParams.IsLastChangeBeforeStored: Boolean;
begin
  Result := FLastChangeBefore <> CDate1_1_1980;
end;

procedure TJvSearchParams.SetAttributes(const Value: TJvSearchAttributes);
begin
  FAttributes.Assign(Value);
end;

procedure TJvSearchParams.SetFileMask(const Value: string);
begin
  JclStrings.StrToStrings(Value, FileMaskSeperator, FileMasks);
end;

procedure TJvSearchParams.SetFileMasks(const Value: TStrings);
begin
  FFileMasks.Assign(Value);
end;

procedure TJvSearchParams.SetLastChangeAfter(const Value: TDateTime);
var
  DosFileTime: Longint;
  LocalFileTime: TFileTime;
begin
  { Value must be >= 1-1-1980 }
  DosFileTime := DateTimeToDosDateTime(Value);
  if not Windows.DosDateTimeToFileTime(LongRec(DosFileTime).Hi,
    LongRec(DosFileTime).Lo, LocalFileTime) or
    not Windows.LocalFileTimeToFileTime(LocalFileTime, FLastChangeAfterFT) then
    RaiseLastOSError;

  FLastChangeAfter := Value;
end;

procedure TJvSearchParams.SetLastChangeBefore(const Value: TDateTime);
var
  DosFileTime: Longint;
  LocalFileTime: TFileTime;
begin
  { Value must be >= 1-1-1980 }
  DosFileTime := DateTimeToDosDateTime(Value);
  if not Windows.DosDateTimeToFileTime(LongRec(DosFileTime).Hi,
    LongRec(DosFileTime).Lo, LocalFileTime) or
    not Windows.LocalFileTimeToFileTime(LocalFileTime, FLastChangeBeforeFT) then
    RaiseLastOSError;

  FLastChangeBefore := Value;
end;

procedure TJvSearchParams.SetMaxSize(const Value: Int64);
begin
  FMaxSizeHigh := Int64Rec(Value).Hi;
  FMaxSizeLow := Int64Rec(Value).Lo;
end;

procedure TJvSearchParams.SetMinSize(const Value: Int64);
begin
  FMinSizeHigh := Int64Rec(Value).Hi;
  FMinSizeLow := Int64Rec(Value).Lo;
end;

procedure TJvSearchParams.SetSearchTypes(const Value: TJvSearchTypes);
var
  ChangedValues: TJvSearchTypes;
begin
  if FSearchTypes = Value then
    Exit;

  ChangedValues := FSearchTypes + Value - (FSearchTypes * Value);
  FSearchTypes := Value;

  if stFileMaskCaseSensitive in ChangedValues then
    UpdateCaseMasks;
end;

procedure TJvSearchParams.UpdateCaseMasks;
var
  I: Integer;
begin
  FCaseFileMasks.Assign(FileMasks);

  if not (stFileMaskCaseSensitive in SearchTypes) then
    for I := 0 to FCaseFileMasks.Count - 1 do
      FCaseFileMasks[I] := AnsiUpperCase(FCaseFileMasks[I]);
end;

{$IFDEF UNITVERSIONING}
initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.