jvappstorage.pas

East make Tray Icon in delphi

  // (rom) should this be PathDelim + '*' as implemented before i changed it
  // (rom) or \* as comments say?
  cSubStorePath = PathDelim + '*' ;

{$IFDEF COMPILER5}

function Supports(Instance: TObject; const Intf: TGUID): Boolean;
begin
  Result := Instance.GetInterfaceEntry(Intf) <> nil;
end;

function Supports(AClass: TClass; const Intf: TGUID): Boolean;
begin
  Result := AClass.GetInterfaceEntry(Intf) <> nil;
end;

function FileIsReadOnly(const FileName: string): Boolean;
var
  Attr: Cardinal;
begin
  Attr := GetFileAttributes(PChar(FileName));
  Result := (Attr <> $FFFFFFFF) and (Attr and FILE_ATTRIBUTE_READONLY <> 0);
end;

{$ENDIF COMPILER5}

procedure UpdateGlobalPath(GlobalPaths, NewPaths: TStrings);
var
  I: Integer;
  J: Integer;
begin
  for I := 0 to NewPaths.Count - 1 do
  begin
    if StrCharCount(NewPaths[I],'.') = Length(NewPaths[I]) then
    begin
      J := Length(NewPaths[I]) - 1;
      if J > GlobalPaths.Count then
        J := GlobalPaths.Count;
      while J > 0 do
      begin
        GlobalPaths.Delete(GlobalPaths.Count - 1);
        Dec(J);
      end;
    end
    else
      GlobalPaths.Add(NewPaths[I]);
  end;
end;

function OptimizePaths(Paths: array of string): string;
var
  GlobalPaths: TStrings;
  CurPaths: TStrings;
  Index: Integer;
begin
  if Length(Paths) <> 0 then
  begin
    GlobalPaths := nil;
    CurPaths := nil;
    try
      GlobalPaths := TStringList.Create;
      CurPaths := TStringList.Create;
      Index := High(Paths);
      while (Index > 0) and (StrLeft(Paths[Index], 1) <> PathDelim) do
        Dec(Index);
      repeat
        StrToStrings(Paths[Index], PathDelim, CurPaths, False);
        UpdateGlobalPath(GlobalPaths, CurPaths);
        Inc(Index);
      until Index > High(Paths);
      Result := StringsToStr(GlobalPaths, PathDelim, False);
      // (hofi) it would be better to trim both ends of path ?!?!?
      // currently only path contains space(s) filtered out
      if Length(Trim(Result)) = 0 then
        Result := '';
    finally
      CurPaths.Free;
      GlobalPaths.Free;
    end;
  end
  else
    Result := '';
end;

procedure CopyEnumValue(const Source; var Target; const Kind: TOrdType);
begin
  case Kind of
    otSByte, otUByte:
      Byte(Target) := Byte(Source);
    otSWord, otUWord:
      Word(Target) := Word(Source);
    otSLong, otULong:
      Longword(Target) := Longword(Source);
  end;
end;

function OrdOfEnum(const Value; OrdType: TOrdType): Integer;
begin
  case OrdType of
    otSByte:
      Result := Shortint(Value);
    otUByte:
      Result := Byte(Value);
    otSWord:
      Result := Smallint(Value);
    otUWord:
      Result := Word(Value);
    otSLong, otULong:
      Result := Longint(Value);
    else
      Result := -1;
  end;
end;


//=== { TJvCustomAppStorageOptions } =========================================

constructor TJvCustomAppStorageOptions.Create;
begin
  inherited Create;
  BooleanStringTrueValues := 'TRUE, YES, Y';
  BooleanStringFalseValues := 'FALSE, NO, N';
  BooleanAsString := True;
  EnumerationAsString := True;
  TypedIntegerAsString := True;
  SetAsString := False;
  DateTimeAsString := True;
  DefaultIfReadConvertError := False;
  DefaultIfValueNotExists := True;
end;

function TJvCustomAppStorageOptions.IsValueListString(const AValue, AList: string): Boolean;
begin
  with TStringList.Create do
    try
      CommaText := UpperCase(AList);
      Result := IndexOf(UpperCase(AValue)) >= 0;
    finally
      Free;
    end;
end;

function TJvCustomAppStorageOptions.DefaultTrueString: string;
var
  I: Integer;
begin
  I := Pos(',', FBooleanStringTrueValues);
  if I = 0 then
    I := Length(FBooleanStringTrueValues) + 1;
  Result := Trim(Copy(FBooleanStringTrueValues, 1, I - 1));
end;

function TJvCustomAppStorageOptions.DefaultFalseString: string;
var
  I: Integer;
begin
  I := Pos(',', FBooleanStringFalseValues);
  if I = 0 then
    I := Length(FBooleanStringFalseValues) + 1;
  Result := Trim(Copy(FBooleanStringFalseValues, 1, I - 1));
end;

function TJvCustomAppStorageOptions.IsValueTrueString(Value: string): Boolean;
begin
  Result := IsValueListString(Value, FBooleanStringTrueValues);
end;

function TJvCustomAppStorageOptions.IsValueFalseString(Value: string): Boolean;
begin
  Result := IsValueListString(Value, FBooleanStringFalseValues);
end;

procedure TJvCustomAppStorageOptions.SetBooleanAsString(Value: Boolean);
begin
  FBooleanAsString := Value and (DefaultTrueString <> '') and (DefaultFalseString <> '');
end;

procedure TJvCustomAppStorageOptions.SetBooleanStringTrueValues(Value: string);
begin
  FBooleanStringTrueValues := Value;
  FBooleanAsString := FBooleanAsString and (DefaultTrueString <> '')
end;

procedure TJvCustomAppStorageOptions.SetBooleanStringFalseValues(Value: string);
begin
  FBooleanStringFalseValues := Value;
  FBooleanAsString := FBooleanAsString and (DefaultFalseString <> '')
end;

procedure TJvCustomAppStorageOptions.SetEnumAsStr(Value: Boolean);
begin
  FEnumAsStr := Value;
end;

procedure TJvCustomAppStorageOptions.SetIntAsStr(Value: Boolean);
begin
  FIntAsStr := Value;
end;

procedure TJvCustomAppStorageOptions.SetSetAsStr(Value: Boolean);
begin
  FSetAsStr := Value;
end;

procedure TJvCustomAppStorageOptions.SetDateTimeAsStr(Value: Boolean);
begin
  FDateTimeAsString := Value;
end;

procedure TJvCustomAppStorageOptions.SetFloatAsStr(Value: Boolean);
begin
  FFloatAsString := Value;
end;

procedure TJvCustomAppStorageOptions.SetDefaultIfReadConvertError(Value: Boolean);
begin
  FDefaultIfReadConvertError := Value;
end;

procedure TJvCustomAppStorageOptions.SetDefaultIfValueNotExists(Value: Boolean);
begin
  FDefaultIfValueNotExists := Value;
end;

//=== { TJvCustomAppStorage } ================================================

constructor TJvCustomAppStorage.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FAutoFlush := False;
  FAutoReload := False;
  FStorageOptions := GetStorageOptionsClass.Create;
  FSubStorages := TJvAppSubStorages.Create(Self);
  FCryptEnabledStatus := 0;
  FReadOnly := False;
end;

destructor TJvCustomAppStorage.Destroy;
begin
  Flush;
  FreeAndNil(FSubStorages);
  FreeAndNil(FStorageOptions);
  inherited Destroy;
end;

procedure TJvCustomAppStorage.Flush;
begin
  // do nothing
end;

procedure TJvCustomAppStorage.Reload;
begin
  // do nothing
end;

procedure TJvCustomAppStorage.ReloadIfNeeded;
begin
  if ReloadNeeded then
    Reload;
end;

function TJvCustomAppStorage.ReloadNeeded : Boolean;
begin
  Result := AutoReload and not IsUpdating;
end;

procedure TJvCustomAppStorage.FlushIfNeeded;
begin
  if FlushNeeded then
    Flush;
end;

function TJvCustomAppStorage.FlushNeeded : Boolean;
begin
  Result := AutoFlush and not IsUpdating;
end;

procedure TJvCustomAppStorage.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (AComponent is TJvCustomAppStorage) and (Operation = opRemove) and
    Assigned(SubStorages) then
    SubStorages.Delete(AComponent as TJvCustomAppStorage);
end;

function TJvCustomAppStorage.GetPropCount(Instance: TPersistent): Integer;