⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 jvqsearchfiles.pas

📁 East make Tray Icon in delphi
💻 PAS
📖 第 1 页 / 共 3 页
字号:
    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}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvQSearchFiles.pas,v $';
    Revision: '$Revision: 1.14 $';
    Date: '$Date: 2004/11/06 22:08:20 $';
    LogPath: 'JVCL\run'
  );

initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -