Resource Basics

Resource Details

Author Information

Available Attachments

Script

{

  Author: IDimager
  Version: 1.3
  Initial Date: 01 feb 2018

  Changes;
  1.3; 28 jan 2019; added support for details, image, and prop details
  1.2; 01 oct 2018; added support for relationships
}

  // -------------------- EXPORT ROUTINES ------------------

  procedure AddStreamToStream(ASource, AStream: TStream);
  begin
    StreamWriteInt64(AStream, ASource.Size, boIntel);
    if ASource.Size > 0 then
    begin
      ASource.Position := 0;
      AStream.CopyFrom(ASource, ASource.Size);
    end;
  end;

  procedure WriteRelationsForProp(AProp: TCatalogItemProp; AStream: TStream);
  var
    ARels: TCatalogPropRelations;
    AMs: TMemoryStream;
  begin
    ARels := TCatalogPropRelations.Create(TCatalogPropRelation, '');
    try
      PublicCatalog.EnumRelationsForPropGUID(AProp.GUID, ARels);
      AMs := TMemoryStream.Create;
      try
        ARels.SaveToStream(AMs);
        AddStreamToStream(AMs, AStream);
      finally
        AMs.Free;
      end;
    finally
      ARels.Free;
    end;
  end;

  procedure ReadStructureForProp(AProp: TCatalogItemsProp);
  var
    i: Integer;
    AAttr: TMemoryStream;
  begin
    // add attributes
    AAttr := TMemoryStream.Create;
    try
      WriteRelationsForProp(AProp, AAttr);
      AddStreamToStream(AProp.Details, AAttr);
      AddStreamToStream(AProp.Image, AAttr);
      AddStreamToStream(AProp.PropsStream, AAttr);

      AProp.Name := Base64EncodeStream(AAttr);
    finally
      AAttr.Free;
    end;

    PublicCatalog.EnumPropsForParent(AProp.GUID, AProp.SubProps, False, False);
    for i := 0 to AProp.SubProps.Count - 1 do
      ReadStructureForProp(AProp.SubProps.Items[i]);
  end;

  procedure ReadStructureForCategory(ACat: TCatalogPropCategory);
  var
    i: Integer;
  begin
    PublicCatalog.EnumPropsForParent(ACat.GUID, ACat.Props, False, False);
    for i := 0 to ACat.Props.Count - 1 do
      ReadStructureForProp(ACat.Props.Items[i]);
  end;

  procedure ReadStructureForCategories(ACats: TCatalogPropCategories);
  var
    i: Integer;
    APro: TxomProgress;
  begin
    APro := TxomProgress.Create(nil);
    try
      APro.Caption := 'Export catalog structure';
      APro.CanCancel := False;
      APro.Max := ACats.Count - 1;
      APro.Show;

      for i := 0 to ACats.Count - 1 do
      begin
        APro.Pos := i + 1;
        APro.ProgressText := ACats.Items[i].CategoryName;
        if APro.Cancel then break;

        ReadStructureForCategory(ACats.Items[i]);
      end;
    finally
      APro.Free;
    end;
  end;

  procedure ExportCatalogStructure;
  var
    AGroup: TCatalogPropGroup;
  begin
    // store the structure in a Groups's include categories
    AGroup := TCatalogPropGroup.Create(nil);
    try
      PublicCatalog.EnumCategories(AGroup.IncludeCats, False);

      ReadStructureForCategories(AGroup.IncludeCats);

      SaveDialog.DefaultExt := '.export';
      SaveDialog.InitialDir := WindowsDesktopDir;
      SaveDialog.FileName := 'PhotoSupreme_structure.export'
      SaveDialog.Filter := 'Export files|*.export|All Files|*.*';
      SaveDialog.Title := 'Export Catalog Structure As';
      if SaveDialog.Execute then
      begin
        AGroup.SaveToFile(SaveDialog.FileName);
        Say('Saved as ' + SaveDialog.FileName);
      end;
    finally
      AGroup.Free;
    end;
  end;

  // -------------------- IMPORT ROUTINES ------------------

  function FindCatByName(ACats: TCatalogPropCategories; ACategoryName: WideString): TCatalogPropCategory;
  var
    i: Integer;
  begin
    result := nil;
    for i := 0 to ACats.Count - 1 do
    begin
      if WideSameText(ACats.Items[i].CategoryName, ACategoryName) then
      begin
        result := ACats.Items[i];
        exit;
      end;
    end;
  end;

  procedure CleanupCategoriesNotInCats(ACats: TCatalogPropCategories);
  var
    ACatsDB: TCatalogPropCategories;
    ACatDB: TCatalogPropCategory;
    ATemp: TCatalogPropCategory;
    i: Integer;
  begin
    ACatsDB := TCatalogPropCategories.Create(TCatalogPropCategory, '');
    try
      // check what's in DB
      PublicCatalog.EnumCategories(ACatsDB, False);

      for i := 0 to ACatsDB.Count - 1 do
      begin
        ACatDB := ACatsDB.Items[i];

        // if this cat is not in ACats then free it
        ATemp := ACats.FindItem(ACatDB.GUID);
        if ATemp = nil then
          ATemp := FindCatByName(ACats, ACatDB.CategoryName);

        if ATemp = nil then
        begin
          // a cat exists in DB and is not in the structure. delete it
          PublicCatalog.DeleteCategory(ACatDB);
        end;
      end;
    finally
      ACatsDB.Free;
    end;
  end;

  procedure CleanupPropsInParentNotInProps(AParentGUID: String; AProps: TCatalogItemProps);
  var
    APropsDB: TCatalogItemProps;
    APropDB: TCatalogItemProp;
    ATemp: TCatalogItemProp;
    i: Integer;
  begin
    APropsDB := TCatalogItemProps.Create(TCatalogItemProp, '');
    try
      // check what's in DB
      PublicCatalog.EnumPropsForParent(AParentGUID, APropsDB, False, False);

      for i := 0 to APropsDB.Count - 1 do
      begin
        APropDB := APropsDB.Items[i];

        // if this prop is not in AProps then free it
        ATemp := AProps.FindItem(APropDB.GUID);
        if ATemp = nil then
          ATemp := AProps.FindPropByName(APropDB.PropName, False);

        if ATemp = nil then
        begin
          // a prop exists in DB and is not in the structure. delete it
          PublicCatalog.DeleteProp(APropDB);
        end;
      end;
    finally
      APropsDB.Free;
    end;
  end;

  procedure WriteStructureForProp(AParentGUID: String; AProp: TCatalogItemProp);
  var
    APropDB: TCatalogItemProp;
    AGUID: String;
    AExists: Boolean;
    i: Integer;
    AMs: TMemoryStream;
    ASize: Int64;
  begin
    APropDB := TCatalogItemProp.Create(nil);
    try
      if PublicCatalog.EnumProp(AProp.GUID, APropDB, False) then
        AExists := True
      else if PublicCatalog.EnumPropName(AParentGUID, AProp.PropName, APropDB, False) then
        AExists := True
      else
        AExists := False;

      if AExists then
      begin
        // exists? then take over the details, but keep the GUID
        AGUID := APropDB.GUID;
        APropDB.BaseAssign(AProp, False);
        APropDB.GUID := AGUID;
        AProp.GUID := AGUID;  // make sure that we use the correct GUID
      end
      else
      begin
        // doesn't exist....create it now based on AProp
        APropDB.BaseAssign(AProp, False);
      end;

      AMs := TMemoryStream.Create;
      Base64DecodeString(AProp.Name, AMs, False);
      AMs.Position := 0;
      // first part is relations
      StreamReadInt64(AMs, ASize, boIntel);
      AMs.Position := AMs.Position + ASize;  // skip passed
      // second part is details
      StreamReadInt64(AMs, ASize, boIntel);
      if ASize > 0 then
        APropDB.Details.CopyFrom(AMs, ASize);
      // third part is Image
      StreamReadInt64(AMs, ASize, boIntel);
      if ASize > 0 then
        APropDB.Image.CopyFrom(AMs, ASize);
      // fourth part is PropsStream
      StreamReadInt64(AMs, ASize, boIntel);
      if ASize > 0 then
        APropDB.PropsStream.CopyFrom(AMs, ASize);
      AMs.Free;

      PublicCatalog.StorePropToDatabase(APropDB, AParentGUID, True);

      CleanupPropsInParentNotInProps(AProp.GUID, AProp.SubProps);
      for i := 0 to AProp.SubProps.Count - 1 do
      begin
        WriteStructureForProp(AProp.GUID, AProp.SubProps.Items[i]);
      end;
    finally
      APropDB.Free;
    end;
  end;

  procedure WriteStructureForCategory(ACat: TCatalogPropCategory);
  var
    ACatDB: TCatalogPropCategory;
    AGUID: String;
    AExists: Boolean;
  begin
    ACatDB := TCatalogPropCategory.Create(nil);
    try
      if PublicCatalog.EnumCategory(ACat.GUID, ACatDB, False) then
        AExists := True
      else if PublicCatalog.EnumCategoryNamed(ACat.CategoryName, ACatDB) then
        AExists := True
      else
        AExists := False;

      if AExists then
      begin
        // exists? then take over the details, but keep the GUID
        AGUID := ACatDB.GUID;
        ACatDB.BaseAssign(ACat, False);
        ACatDB.GUID := AGUID;
        ACat.GUID := AGUID;  // make sure that we use the correct GUID

        PublicCatalog.UpdateCategory(ACatDB);
      end
      else
      begin
        // doesn't exist....create it now based on ACat
        ACatDB.BaseAssign(ACat, False);
        PublicCatalog.UpdateCategory(ACatDB);
      end;

      CleanupPropsInParentNotInProps(ACat.GUID, ACat.Props);
      for i := 0 to ACat.Props.Count - 1 do
      begin
        WriteStructureForProp(ACat.GUID, ACat.Props.Items[i]);
      end;
    finally
      ACatDB.Free;
    end;
  end;

  procedure WriteRelationship(ARel: TCatalogPropRelation);
  begin
    if PublicCatalog.EnumProp(ARel.ParentGUID, ARel.ParentProp, False) and
       PublicCatalog.EnumProp(ARel.ChildGUID, ARel.ChildProp, False)
    then
    begin
      PublicCatalog.UpdateRelation(ARel);
    end;
  end;

  procedure WriteRelationshipsForProp(AParentGUID: String; AProp: TCatalogItemProp);
  var
    i: Integer;
    ARels, ARelsDB: TCatalogPropRelations;
    AMs, AStr: TMemoryStream;
    ASize: Int64;
  begin
    if AProp.Name <> '' then
    begin
      ARels := TCatalogPropRelations.Create(TCatalogPropRelation, '');
      try
        AMs := TMemoryStream.Create;
        AStr := TMemoryStream.Create;
        Base64DecodeString(AProp.Name, AMs, False);
        AMs.Position := 0;
        StreamReadInt64(AMs, ASize, boIntel);
        if ASize > 0 then
        begin
          AStr.CopyFrom(AMs, ASize);
          AStr.Position := 0;
          ARels.LoadFromStream(AStr);
        end;
        AStr.Free;
        AMs.Free;

        if ARels.Count > 0 then
        begin
          for i := 0 to ARels.Count - 1 do
            WriteRelationship(ARels.Items[i]);

          // delete non existing rels for this prop
          ARelsDB := TCatalogPropRelations.Create(TCatalogPropRelation, '');
          try
            PublicCatalog.EnumRelationsForPropGUID(AProp.GUID, ARelsDB);
            for i := 0 to ARelsDB.Count - 1 do
            begin
              if ARels.FindItem(ARelsDB.Items[i].GUID) = nil then
                PublicCatalog.DeleteRelation(ARelsDB.Items[i]);
            end;
          finally
            ARelsDB.Free;
          end;
        end;
      finally
        ARels.Free;
      end;
    end;

    for i := 0 to AProp.SubProps.Count - 1 do
    begin
      WriteRelationshipsForProp(AProp.GUID, AProp.SubProps.Items[i]);
    end;
  end;

  procedure WriteRelationshipsForCategory(ACat: TCatalogPropCategory);
  var
    i: Integer;
  begin
    for i := 0 to ACat.Props.Count - 1 do
    begin
      WriteRelationshipsForProp(ACat.GUID, ACat.Props.Items[i]);
    end;
  end;

  procedure WriteStructureForCategories(ACats: TCatalogPropCategories);
  var
    i: Integer;
  begin
    CleanupCategoriesNotInCats(ACats);
    APro := TxomProgress.Create(nil);
    try
      APro.Caption := 'Import catalog structure';
      APro.CanCancel := False;
      APro.Max := ACats.Count - 1;
      APro.Show;

      for i := 0 to ACats.Count - 1 do
      begin
        APro.Pos := i + 1;
        APro.ProgressText := ACats.Items[i].CategoryName;
        if APro.Cancel then break;

        WriteStructureForCategory(ACats.Items[i]);
      end;

      // now all props are sync'ed, check if relationships should be written
      for i := 0 to ACats.Count - 1 do
        WriteRelationshipsForCategory(ACats.Items[i]);
    finally
      APro.Free;
    end;
  end;

  procedure ImportCatalogStructure;
  var
    AGroup: TCatalogPropGroup;
  begin
    // load the structure in a Groups's include categories
    AGroup := TCatalogPropGroup.Create(nil);
    try
      OpenDialog.DefaultExt := '.export';
      OpenDialog.InitialDir := WindowsDesktopDir;
      OpenDialog.FileName := 'PhotoSupreme_structure.export'
      OpenDialog.Filter := 'Export files|*.export|All Files|*.*';
      OpenDialog.Title := 'Import Catalog Structure From';
      if OpenDialog.Execute then
      begin
        AGroup.LoadFromFile(OpenDialog.FileName);

        if AskYN('Are you sure your want to overwrite your existing Catalog Structure with that from the selected file?') then
          WriteStructureForCategories(AGroup.IncludeCats);
      end;
    finally
      AGroup.Free;
    end;
  end;

var
  ACustoms: TTntStringList;
  AIdx: Integer;
  ACheck: Boolean;
begin
  ACustoms := TTntStringList.Create;
  try
    ACustoms.Add ('Export Catalog Structure to File');
    ACustoms.Add ('Import and sync Catalog Structure from File');
    ACustoms.Add ('Cancel');

    ACheck := False;
    AIdx := AskCustom(
                       'What operation would you like to perform?',
                       'CAUTION: Importing a Catalog Structure will affect your existsing catalog structure',
                       '',
                       '',
                       ACheck,
                       ACustoms
                     );

    if AIdx = 0 then
      ExportCatalogStructure
    else if AIdx = 1 then
      ImportCatalogStructure;
  finally
    ACustoms.Free;
  end;
end;