(*
' *************************************************************************
' * Script name:
' * Import CSV Data
' * Version: 1.61
' *
' * Description:
' * Imports XMP data from a CSV (delimited) text file to selected images
' *
' * Version History:
' * IDimager;
' * 1.0 Initial version
' * 1.1 Fixed an issue with field names
' * 1.2 Added support to import to Custom Fields
' * 1.3 Fixed an issue with Access Violation that could occur
' * 1.31 Fixed an issue with renaming TCatalogItem.idLabel to TCatalogItem.ColorLabel
' * 1.32 Fixed dialog size on high-res monitors
' * 1.40 Added support for importing keywords (dc:subject)
' * 1.41 Importing keywords now respects the Preference setting for Sync-Read
' * 1.42 Fix for double entries in drop down when opening twice
' * 1.43 File name column can now contain the full file path or the file name only
' * 1.44 Fix for MS-Excel formatted CSV files
' * 1.52 Fix for reading CSV files with and without BOM
' * 1.60 Added support for non-quoted CSV files
' * 1.61 Changed to support PSU v2025
' *
' *************************************************************************/
*)
var
ACSVLines, ACSVFields: TTntStringList;
ADelimiter: WideChar;
AQuoted: Boolean;
AFirstLineHoldsFieldNames: Boolean;
AFieldsAreQuoted: Boolean;
// UI controls
AFieldComboList: TStringList;
AFileNameCombo: TvxMacPopupButton;
AFileEdit: TvxTextBox;
AContent: TvxMacScrollBox;
AImportButton: TvxButton;
function FindValue (AParam: TMacroParam; AVal: WideString): Variant;
var
i: Integer;
begin
result := AVal;
if Assigned(AParam) then
begin
if AParam.ValidValues.Count > 0 then
begin
for i := 0 to AParam.ValidValues.Count - 1 do
begin
if WideSameText(AParam.ValidValues.Items[i].ParamName, AVal) then
begin
result := AParam.ValidValues.Items[i].Content;
exit;
end;
end;
end;
if WideSameText(AParam.ParamCommand, 'xap:Label') or
WideSameText(AParam.ParamCommand, 'xmp:Label')
then
begin
if WideSameText(Translate('No Label'), result) or
WideSameText('No Label', result)
then
result := '';
end;
end;
end;
procedure _StartImport(Sender);
var
i, j: Integer;
AFound: Boolean;
ACatItem: TCatalogItem;
AMappings: TTntStringList;
AXmpField, AId: WideString;
AXmp: TXMP;
AVal: Variant;
AGroup, AParam: TMacroParam;
ASaveItem, AReconstruct: Boolean;
begin
if AFileNameCombo.ItemIndex = -1 then exit;
AMappings := TTntStringList.Create;
for i := 0 to AFieldComboList.Count - 1 do
begin
AXmpField := TvxMacPopupButton(AFieldComboList.Objects[i]).Text;
if WideSameText(AXmpField, '(don''t link)') then
AXmpField := '';
if WideTextPos(':', AXmpField) = 0 then // xmp fields all have the colon
AXmpField := '';
AMappings.Add(AXmpField);
end;
if Trim(AMappings.Text) = '' then exit; // nothing to do
Progress.Cancel := False;
Progress.Caption := 'Processing CSV file...';
Progress.Show;
Progress.Max := ACSVLines.Count;
Progress.Pos := 0;
for i := 0 to ACSVLines.Count - 1 do
begin
ALine := TTntStringList.Create;
if AFieldsAreQuoted then
begin
ALine.Delimiter := ADelimiter;
ALine.DelimitedText := ACSVLines.Strings[i];
end
else
Tokenize(ACSVLines.Strings[i], ADelimiter, ALine);
AFileName := ALine.Strings[AFileNameCombo.ItemIndex];
ACatItem := TCatalogItem.Create(nil);
ACatItem.FileName := AFileName;
ACatItem.UpdateFileInfoBase;
// try fnding with the full file name (path+filename)
AFound := PublicCatalog.FindItemCombined2(ACatItem, ACatItem, False, vptNone);
if not AFound then
begin
// try finding with file name only (no path name)
AFound := PublicCatalog.FindFileQuick(AFileName, ACatItem, True);
end;
if AFound then
begin
Progress.Pos := i + 1;
Progress.ProgressText := AFileName;
if Progress.Cancel then
break;
ASaveItem := False;
AXmp := TXMP.Create(False);
PublicCatalog.LoadXMPForItem(ACatItem, AXmp, PublicOptions.CachedXMP);
for j := 0 to AMappings.Count - 1 do
begin
AXmpField := AMappings.Strings[j];
if AXmpField = '' then
Continue;
AId := LeftStr(AXmpField, WideTextPos(':', AXmpField) - 1);
AGroup := XMPModel.FindId(AId, False);
if AGroup = nil then // something unsupported...skip
Continue;
AParam := XMPModel.FindCommand(AXmpField, True);
AVal := FindValue(AParam, ALine.Strings[j]);
AXmp.QuickSetProperty(AGroup.Content, AXmpField, AVal);
if WideSameText(AXmpField, 'lr:hierarchicalSubject') then
begin
// construct catalog labels for the new keywords
AReconstruct := True;
AXmp.RemoveParam('dc:subject');
end;
if WideSameText(AXmpField, 'dc:subject') then
begin
// construct catalog labels for the new keywords
AReconstruct := True;
AXmp.RemoveParam('lr:hierarchicalSubject');
end;
if WideSameText(AXmpField, 'xap:Rating') or
WideSameText(AXmpField, 'xmp:Rating')
then
begin
ACatItem.Rating := AVal;
ASaveItem := True;
end;
if WideSameText(AXmpField, 'xap:Label') or
WideSameText(AXmpField, 'xmp:Label')
then
begin
ACatItem.ColorLabel := AVal;
ASaveItem := True;
end;
end;
PublicCatalog.SaveXMPForItem(ACatItem, AXmp, PublicOptions.CachedXMP);
if ASaveItem then
PublicCatalog.StoreItemToDatabase(ACatItem, False);
if AReconstruct then
begin
// should keywords be read as catalog labels?
if PublicOptions.XMPSyncReadSettings.ReplaceLabels <> ksNone then
begin
// if keywords should be read, should they replace existing labels or
// merge? If Replace, then delete what's already there
if PublicOptions.XMPSyncReadSettings.ReplaceLabels = ksReplace then
PublicCatalog.RemoveAllPropsFromItem(ACatItem);
// now create catalog labels from keywords
PublicCatalog.ReConstructFromXMPObjectKeywords(ACatItem, AXmp, PublicOptions.XMPSyncReadSettings, False);
end;
end;
AXmp.Free;
end;
ACatItem.Free;
ALine.Free;
end;
AMappings.Free;
Progress.Hide;
if Progress.Cancel then
Say('Cancelled');
end;
procedure _ParamLinkClick(Sender: TObject);
begin
// nothing
end;
procedure _DontLinkClick(Sender: TObject);
begin
// nothing
end;
procedure _InitParamsPopup(Sender: TObject);
var
AMenu: TvxMacPopupMenu;
AItem: TvxMacMenuItem;
i: Integer;
AParam, AParentParam: TMacroParam;
ASubs: TMacroParams;
begin
AMenu := TvxMacPopupMenu(Sender);
AMenu.MenuItems.Clear;
if AMenu.ParentMenuItem = nil then // root level
begin
AItem := AMenu.MenuItems.Add;
AItem.Caption := '(don''t link)';
AItem.OnClick := '_DontLinkClick';
AMenu.MenuItems.AddSeparator;
for i := 0 to XMPModel.Params.Count - 1 do
begin
AParam := XMPModel.Params.Items[i];
if WideSameText(AParam.Id, 'ics') then
Continue;
AItem := AMenu.MenuItems.AddSubMenu(AParam.ParamCommand);
AItem.Tag := AParam;
end;
end
else
begin
AParentParam := TMacroParam(AMenu.ParentMenuItem.Tag);
if AParentParam.ParamType = ptStructure then
ASubs := AParentParam.CustomParams
else
ASubs := AParentParam.SubParams;
for i := 0 to ASubs.Count - 1 do
begin
AParam := ASubs.Items[i];
if AParam.ParamType = ptStructure then
begin
AItem := AMenu.MenuItems.AddSubMenu(AParam.ParamCommand);
AItem.Tag := AParam;
end
else
begin
AItem := AMenu.MenuItems.Add;
AItem.Caption := AParam.ParamCommand;
AItem.OnClick := '_ParamLinkClick';
end;
end;
end;
end;
function CreateBaseCombo(ACaption: WideString; ABold: Boolean): TvxMacPopupButton;
var
ALabel: TvxLabel;
begin
result := TvxMacPopupButton.Create(AContent);
result.Width := 180;
AContent.AddObject(result);
ALabel := TvxLabel.Create(result);
ALabel.TextAlign := vgTextAlignFar;
if ABold then
ALabel.Font.Style := vgFontBold;
ALabel.Text := ACaption;
ALabel.Width := 300;
ALabel.Position.Point := vgPoint(-310, 5);
result.AddObject(ALabel);
end;
function CreateParamsCombo(ACaption: WideString): TvxMacPopupButton;
var
i, j: Integer;
begin
result := CreateBaseCombo(ACaption, False);
result.Text := '(don''t link)';
result.DynamicContent := True;
result.OnInitPopup := '_InitParamsPopup';
end;
function CreateFieldsCombo(ACaption: WideString): TvxMacPopupButton;
var
i: Integer;
begin
result := CreateBaseCombo(ACaption, True);
for i := 0 to ACSVFields.Count - 1 do
result.Items.Add(ACSVFields.Strings[i]);
end;
function FindFileNameField: Integer;
var
i: Integer;
ALine: TTntStringList;
begin
result := -1;
for i := 0 to ACSVFields.Count - 1 do
begin
if WideSameText(ACSVFields.Strings[i], 'FileName') or
WideSameText(ACSVFields.Strings[i], Translate('FileName'))
then
begin
result := i;
exit;
end;
end;
if ACSVLines.Count > 0 then
begin
ALine := TTntStringList.Create;
ALine.Delimiter := ADelimiter;
ALine.DelimitedText := ACSVLines.Strings[0];
for i := 0 to ALine.Count - 1 do
begin
if WideFileExists(ALine.Strings[i]) then
begin
result := i;
break;
end;
end;
ALine.Free;
end;
end;
procedure RefreshContent;
var
ATop, i: Integer;
ACombo: TvxMacPopupButton;
AParam: TMacroParam;
begin
AContent.Content.DeleteChildren;
AFieldComboList.Clear;
AFileNameCombo := CreateFieldsCombo('Filename Link Column');
AFileNameCombo.Position.Point := vgPoint(250, 10);
AFileNameCombo.ItemIndex := FindFileNameField;
ATop := 40;
for i := 0 to ACSVFields.Count - 1 do
begin
ACombo := CreateParamsCombo('Link "' + ACSVFields.Strings[i] + '" to');
ACombo.Position.Point := vgPoint(300, ATop);
ATop := ATop + 25 + 10;
AParam := XMPModel.FindCommand(ACSVFields.Strings[i], True);
if Assigned(AParam) then
ACombo.Text := AParam.ParamCommand;
ACombo.TagString := ACSVFields.Strings[i];
ACombo.Tag := i;
AFieldComboList.AddObject('', ACombo);
end;
AImportButton := TvxButton.Create(AContent);
AImportButton.Text := 'Start Import';
AImportButton.Position.Point := vgPoint(10, ATop);
AImportButton.Font.Size := 14;
AImportButton.Width := 200;
AImportButton.Height := 30;
AImportButton.OnClick := '_StartImport';
AContent.AddObject(AImportButton);
AContent.Realign;
end;
procedure ReadFields;
var
ALine: TTntStringList;
ACount, i: Integer;
begin
ACSVFields.Clear;
if ACSVLines.Count = 0 then exit;
ALine := TTntStringList.Create;
if AFieldsAreQuoted then
begin
ALine.Delimiter := ADelimiter;
ALine.DelimitedText := ACSVLines.Strings[0];
end
else
Tokenize(ACSVLines.Strings[0], ADelimiter, ALine);
ACount := ALine.Count;
for i := 0 to ACount - 1 do
begin
if AFirstLineHoldsFieldNames then
ACSVFields.Add(ALine.Strings[i])
else
ACSVFields.Add('Field' + IntToStr(i+1));
end;
ALine.Free;
if AFirstLineHoldsFieldNames then
begin
// delete the first line
ACSVLines.Delete(0);
end;
end;
procedure ReadCSVData(AFileName: WideString);
var
AFs: TTntFileStream;
i: Integer;
ABuf: String;
begin
ACSVLines.Clear;
ACSVFields.Clear;
if not WideFileExists(AFileName) then exit;
AFs := TTntFileStream.Create(AFileName, fmOpenRead or fmShareDenyNone);
AFs.Position := 0;
ABuf := ' ';
AFs.Read(ABuf, 3);
AFs.Position := 0;
ABuf := StrToHex(ABuf);
if ABuf = 'EFBBBF' then // UTF8
ACSVLines.LoadFromStream_BOM(AFs, True, True, csUTF8)
else if LeftStr(ABuf, 4) = 'FFFE' then // UTF16-Little Endian
ACSVLines.LoadFromStream_BOM(AFs, True, True, csUnicode)
else if LeftStr(ABuf, 4) = 'FEFF' then // UTF16-Big Endian
ACSVLines.LoadFromStream_BOM(AFs, True, True, csUnicodeSwapped)
else if HexToInt(MidStr(ABuf, 3, 2)) < 32 then // a steering character at second position...seem like a unicode file without BOM
ACSVLines.LoadFromStream_BOM(AFs, False, True, csUnicode)
else
ACSVLines.LoadFromStream_BOM(AFs, False, True, csUTF8); // assume UTF8
AFs.Free;
// remove empty lines
for i := ACSVLines.Count - 1 downto 0 do
begin
if Trim(ACSVLines.Strings[i]) = '' then
ACSVLines.Delete(i);
//ACSVLines.Strings[i] := FormatToProperCSV(ACSVLines.Strings[i], ADelimiter, '"', #0);
end;
ReadFields;
end;
procedure _OpenButtonClick(Sender: TObject);
var
ADlg: TOpenDialog;
begin
ADlg := TOpenDialog.Create(nil);
ADlg.Filter := 'CSV files (*.csv)|*.csv|All files (*.*)|*.*';
if ADlg.Execute then
begin
AFileEdit.Text := ADlg.FileName;
ReadCSVData(AFileEdit.Text);
RefreshContent;
end;
ADlg.Free;
end;
procedure _DelimiterChange(Sender: TObject);
begin
if TvxRadioButton(Sender).IsChecked then
begin
ADelimiter := TvxRadioButton(Sender).TagString;
WriteToRegistry('Scripts\ImportCSV', 'Delimiter', ADelimiter);
if WideFileExists(AFileEdit.Text) then
begin
ReadCSVData(AFileEdit.Text);
RefreshContent;
end;
end;
end;
procedure _FirstLineFieldNamesChange(Sender: TObject);
begin
AFirstLineHoldsFieldNames := TvxCheckBox(Sender).IsChecked;
WriteToRegistry('Scripts\ImportCSV', 'FirstLineHoldsFieldNames', iif(AFirstLineHoldsFieldNames, 1, 0));
if WideFileExists(AFileEdit.Text) then
begin
ReadCSVData(AFileEdit.Text);
RefreshContent;
end;
end;
procedure _FieldsAreQuotedChange(Sender: TObject);
begin
AFieldsAreQuoted := TvxCheckBox(Sender).IsChecked;
WriteToRegistry('Scripts\ImportCSV', 'FieldsAreQuoted', iif(AFieldsAreQuoted, 1, 0));
if WideFileExists(AFileEdit.Text) then
begin
ReadCSVData(AFileEdit.Text);
RefreshContent;
end;
end;
function CreateForm: TvxSceneForm;
var
ALayout: TvxLayout;
AOpenButton: TvxButton;
ALabel: TvxLabel;
ADelimiterGroup: TvxGroupBox;
ARadio: TvxRadioButton;
ACheck: TvxCheckBox;
begin
result := TvxSceneForm.Create(nil);
result.Caption := 'Import CSV Data';
result.Position := poScreenCenter;
result.Width := 700 * result.DPIFactor;
result.Height := 400 * result.DPIFactor;
result.BorderStyle := bsSizeable;
ALayout := TvxLayout.Create(result.Root);
ALayout.Align := vaTop;
ALayout.Height := 100;
result.Root.AddObject(ALayout);
AContent := TvxMacScrollBox.Create(result.Root);
AContent.Align := vaClient;
result.Root.AddObject(AContent);
AFileEdit := TvxTextBox.Create(ALayout);
AFileEdit.Width := 300;
AFileEdit.Position.Point := vgPoint(150, 20);
AFileEdit.TextPadding.Right := AFileEdit.Height + 2; // don't use the space for the open button
ALayout.AddObject(AFileEdit);
ADelimiterGroup := TvxGroupBox.Create(ALayout);
ADelimiterGroup.Text := 'Delimiter';
ADelimiterGroup.Height := 85;
ADelimiterGroup.Position.Point := vgPoint(460, 12);
ALayout.AddObject(ADelimiterGroup);
ARadio := TvxRadioButton.Create(ADelimiterGroup);
ARadio.GroupName := 'delimiter';
ARadio.Text := 'Comma ,';
ARadio.TagString := ',';
ARadio.Position.Point := vgPoint(10, 20);
ARadio.IsChecked := (ARadio.TagString = ADelimiter);
ARadio.OnChange := '_DelimiterChange';
ADelimiterGroup.AddObject(ARadio);
ARadio := TvxRadioButton.Create(ADelimiterGroup);
ARadio.GroupName := 'delimiter';
ARadio.Text := 'Semicolon ;';
ARadio.TagString := ';';
ARadio.Position.Point := vgPoint(10, 40);
ARadio.IsChecked := (ARadio.TagString = ADelimiter);
ARadio.OnChange := '_DelimiterChange';
ADelimiterGroup.AddObject(ARadio);
ARadio := TvxRadioButton.Create(ADelimiterGroup);
ARadio.GroupName := 'delimiter';
ARadio.Text := 'TAB';
ARadio.TagString := #9;
ARadio.Position.Point := vgPoint(10, 60);
ARadio.IsChecked := (ARadio.TagString = ADelimiter);
ARadio.OnChange := '_DelimiterChange';
ADelimiterGroup.AddObject(ARadio);
ACheck := TvxCheckBox.Create(ALayout);
ACheck.Text := 'First line holds column names';
ACheck.Width := 300;
ACheck.Position.Point := vgPoint(148, 50);
ACheck.IsChecked := AFirstLineHoldsFieldNames;
ACheck.OnChange := '_FirstLineFieldNamesChange';
ALayout.AddObject(ACheck);
ACheck := TvxCheckBox.Create(ALayout);
ACheck.Text := 'Field values are quoted when applicable';
ACheck.Width := 300;
ACheck.Position.Point := vgPoint(148, 70);
ACheck.IsChecked := AFieldsAreQuoted;
ACheck.OnChange := '_FieldsAreQuotedChange';
ALayout.AddObject(ACheck);
ALabel := TvxLabel.Create(AFileEdit);
ALabel.Text := 'Selected CSV File';
ALabel.TextAlign := vgTextAlignNear;
ALabel.Position.Point := vgPoint(-120, 5);
AFileEdit.AddObject(ALabel);
AOpenButton := TvxButton.Create(AFileEdit);
AOpenButton.Align := vaRight;
AOpenButton.Text := '...';
AOpenButton.Width := AFileEdit.Height;
AOpenButton.OnClick := '_OpenButtonClick';
AFileEdit.AddObject(AOpenButton)
end;
var
AForm: TvxSceneForm;
begin
ADelimiter := ReadFromRegistry('Scripts\ImportCSV', 'Delimiter', ',');
AFirstLineHoldsFieldNames := ReadFromRegistry('Scripts\ImportCSV', 'FirstLineHoldsFieldNames', 1) = 1;
AFieldsAreQuoted := ReadFromRegistry('Scripts\ImportCSV', 'FieldsAreQuoted', 1) = 1;
AFieldComboList := TStringList.Create;
ACSVLines := TTntStringList.Create;
ACSVFields := TTntStringList.Create;
AForm := CreateForm;
AForm.ShowModal;
AForm.Free;
ACSVFields.Free;
ACSVLines.Free;
AFieldComboList.Free;
end;
|
