unit Batch; { [Batch] [1.3] Delphi 2005 May 2008 LICENSE The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at "http://www.mozilla.org/MPL/" Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the specific language governing rights and limitations under the License. The Original Code is "[batch.pas / batch.dfm]". The Initial Developer of the Original Code is Martin Holmes (Victoria, BC, Canada, "http://www.mholmes.com/"). Copyright (C) 2005-2008 Martin Holmes and the University of Victoria Computing and Media Centre. The code was co-developed for university and personal projects, and rights are shared by Martin Holmes and the University of Victoria. All Rights Reserved. } { Written by Martin Holmes, beginning in November 2005. This unit is the interface to the batch processing features of Transformer. Users can drag-drop files onto the listview component or add them manually. They can choose to save changed files to a new location, with a different filename configuration, and create backups automatically. They can also set the exact format of output Unicode files. A TBatchList object derived from TTntStringList loads and saves the file list to disk. It has machinery in place for tracking a source text file and a replace pair list file as well, but these are not currently used. Dependencies: FormState (to save and reload form state, and also to use its AppDirPath property). FileOverwriteConfirm (to provide detailed feedback/control to the user over what files are overwritten during the process). FileFunctions (file i/o functionality). TntUnicode libraries (Troy Wolbrink). XDOM_4_1 (Dieter Köhler) } interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, TntForms, FormState, TntClasses, StdCtrls, Buttons, TntButtons, TntStdCtrls, ShellAPI, main, ActnList, TntActnList, TntDialogs, TntSysUtils, ComCtrls, TntComCtrls, ToolWin, TntSystem, FileFunctions, AppEvnts, TntExtCtrls, FileOverwriteConfirm, IconsIncluder, mdhTranslate, XDOM_4_1, Menus, TntMenus, RecentFiles, jclUnicode, TypInfo, FileCtrl, GenFunctions, progress2; type TBackupSetting = (bsNoBackups, bsBackupToOrigLoc, bsBackupToNewLoc); TSaveLocSetting = (slOriginalFolder, slDifferentLoc); TOutputFilename = (ofOriginalName, ofNewName); type TBatchList = class(TTntStringList) private fFilePath: WideString; fSaveReplacePairsLocation: Boolean; fSaveSourceFileLocation: Boolean; fModified: Boolean; fSourceFileLocation: WideString; fReplacePairsLocation: WideString; fBackupSetting: TBackupSetting; fBackupLocation: WideString; fFileSaveFormat: WideString; fSaveLocSetting: TSaveLocSetting; fOutputFolder: WideString; fOutputFilename: TOutputFilename; fOutFilePrefix: WideString; fOutFileSuffix: WideString; fOutFileUseOrigExtension: Boolean; function GetShortFileName(Index: integer): WideString; procedure SetBackupSetting(const Value: TBackupSetting); procedure SetBackupLocation(const Value: WideString); procedure SetFileSaveFormat(const Value: WideString); procedure SetSaveLocSetting(const Value: TSaveLocSetting); procedure SetOutputFolder(const Value: WideString); procedure SetOutputFilename(const Value: TOutputFilename); procedure SetOutFilePrefix(const Value: WideString); procedure SetOutFileSuffix(const Value: WideString); procedure SetOutFileUseOrigExtension(const Value: Boolean); public function WriteToXMLFile(FName: WideString): Boolean; function ReadFromXMLFile(FName: WideString; EmptyFirst: Boolean): Boolean; function AddFile(NewFile: WideString): integer; function DeleteFile(Index: integer): Boolean; property ShortFileName[Index: integer]: WideString read GetShortFileName; procedure Empty; published property FilePath: WideString read fFilePath write fFilePath; property SaveReplacePairsLocation: Boolean read fSaveReplacePairsLocation write fSaveReplacePairsLocation default False; property SaveSourceFileLocation: Boolean read fSaveSourceFileLocation write fSaveSourceFileLocation default False; property Modified: Boolean read fModified write fModified default False; property SourceFileLocation: WideString read fSourceFileLocation write fSourceFileLocation; property ReplacePairsLocation: WideString read fReplacePairsLocation write fReplacePairsLocation; property BackupSetting: TBackupSetting read fBackupSetting write SetBackupSetting; property BackupLocation: WideString read fBackupLocation write SetBackupLocation; property FileSaveFormat: WideString read fFileSaveFormat write SetFileSaveFormat; property SaveLocSetting: TSaveLocSetting read fSaveLocSetting write SetSaveLocSetting; property OutputFolder: WideString read fOutputFolder write SetOutputFolder; property OutputFileName: TOutputFilename read fOutputFilename write SetOutputFilename; property OutFilePrefix: WideString read fOutFilePrefix write SetOutFilePrefix; property OutFileSuffix: WideString read fOutFileSuffix write SetOutFileSuffix; property OutFileUseOrigExtension: Boolean read fOutFileUseOrigExtension write setOutFileUseOrigExtension; end; type TufrmBatch = class(TTntForm, ITranslationOperations) ulbFiles: TTntListBox; ubnOK: TTntBitBtn; alBatch: TTntActionList; udlgAddFiles: TTntOpenDialog; utbrBatch: TTntToolBar; utbAddFiles: TTntToolButton; utbRemoveFiles: TTntToolButton; ustProcessingComplete: TTntStaticText; aRemoveFiles: TTntAction; aAddFiles: TTntAction; aDoTransformationBatch: TTntAction; aSelectAll: TTntAction; aAddUTF8BOM: TTntAction; upcOptions: TTntPageControl; utsSavingFiles: TTntTabSheet; utsSaveLocation: TTntTabSheet; utsOutputFilename: TTntTabSheet; utsBackups: TTntTabSheet; ucbFileFormat: TTntComboBox; ustSaveFilesAs: TTntStaticText; aeBatch: TApplicationEvents; urgSaveLocation: TTntRadioGroup; uedNewLocation: TTntEdit; ustNewLocation: TTntStaticText; uspbNewLocation: TTntSpeedButton; urgOutputFilename: TTntRadioGroup; ustFilenameMask: TTntStaticText; uedNewFilenamePrefix: TTntEdit; uedNewFilenameSuffix: TTntEdit; urgBackups: TTntRadioGroup; ustBackupLocation: TTntStaticText; uedBackupLocation: TTntEdit; uspbBackupLocation: TTntSpeedButton; ustSelectBackupFolder: TTntStaticText; ustSelectOutputFolder: TTntStaticText; aStripUTF8BOM: TTntAction; aCloseWindow: TTntAction; utbSep1: TTntToolButton; utbCloseWindow: TTntToolButton; ustSaveInOriginalFolder: TTntStaticText; ustSaveInDifferentLocation: TTntStaticText; ustUseOriginalFilename: TTntStaticText; ustCreateNewFilename: TTntStaticText; ustDontMakeBackups: TTntStaticText; ustBackupToOriginalFolder: TTntStaticText; ustBackupToNewLocation: TTntStaticText; udlgOpenBatchList: TTntOpenDialog; udlgSaveBatchList: TTntSaveDialog; aNewBatchList: TTntAction; ustSaveBatchListChanges: TTntStaticText; ummBatch: TTntMainMenu; umnFile: TTntMenuItem; umnNewBatchList: TTntMenuItem; aOpenBatchList: TTntAction; aSaveBatchList: TTntAction; aSaveBatchListAs: TTntAction; usbrBatch: TTntStatusBar; umnOpenBatchList: TTntMenuItem; umnSaveBatchList: TTntMenuItem; umnSaveBatchListAs: TTntMenuItem; N1: TTntMenuItem; umnRecentBatchListFiles: TTntMenuItem; utbNewBatchList: TTntToolButton; utbOpenBatchList: TTntToolButton; utbSaveBatchList: TTntToolButton; utbSaveBatchListAs: TTntToolButton; N2: TTntMenuItem; umnCloseWindow: TTntMenuItem; umnActions: TTntMenuItem; umnAddFiles: TTntMenuItem; umnRemoveFiles: TTntMenuItem; N3: TTntMenuItem; umnAddUTFBOM: TTntMenuItem; umnStripUTF8BOM: TTntMenuItem; N4: TTntMenuItem; umnDoReplacementBatch: TTntMenuItem; ustFilesChanged: TTntStaticText; ustListOfFiles: TTntStaticText; ucbUseOrigExtension: TTntCheckBox; ulbOriginalFileName: TTntLabel; ustSomeErrorsWereLogged: TTntStaticText; upopBatch: TTntPopupMenu; aTransformSelectedFiles: TTntAction; upmTransformSelectedFiles: TTntMenuItem; procedure aTransformSelectedFilesExecute(Sender: TObject); procedure TntFormCloseQuery(Sender: TObject; var CanClose: Boolean); procedure TntFormResize(Sender: TObject); procedure aOpenBatchListExecute(Sender: TObject); procedure TntFormClose(Sender: TObject; var Action: TCloseAction); procedure aSaveBatchListAsExecute(Sender: TObject); procedure aSaveBatchListExecute(Sender: TObject); procedure aNewBatchListExecute(Sender: TObject); procedure aCloseWindowExecute(Sender: TObject); procedure aStripUTF8BOMExecute(Sender: TObject); procedure utsOutputFilenameResize(Sender: TObject); procedure uspbNewLocationClick(Sender: TObject); procedure uspbBackupLocationClick(Sender: TObject); procedure aeBatchIdle(Sender: TObject; var Done: Boolean); procedure ulbFilesMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure aAddUTF8BOMExecute(Sender: TObject); procedure aSelectAllExecute(Sender: TObject); procedure aDoTransformationBatchExecute(Sender: TObject); procedure aRemoveFilesExecute(Sender: TObject); procedure aAddFilesExecute(Sender: TObject); procedure TntFormDestroy(Sender: TObject); procedure TntFormCreate(Sender: TObject); procedure TntFormHide(Sender: TObject); procedure TntFormShow(Sender: TObject); private FFormStateSaver: TFormStateSaver; FileList: TBatchList; FRecentFiles: TRecentFiles; FBatchCancelled: Boolean; //batch operation was cancelled. procedure WMDROPFILES( var Message: TWMDROPFILES ); message WM_DROPFILES; procedure AddFile(FileName: WideString); //Allow listing files by drag-drop function CreateOutputFileName(OrigFileName: WideString): WideString; function CreateBackupFileName(OrigFileName: WideString): WideString; function CreateOutputFileList(OutFiles: TTntStringList; SelectedOnly: Boolean): integer; function Save: Boolean; function SaveAs: Boolean; function OpenFile: Boolean; procedure WriteSettingsToGUI; procedure StashSettingsFromGUI; procedure UpdateStatus; function SaveChanges: Boolean; procedure OpenRecent(Sender: TObject; const FileName: WideString); procedure WriteFileListToListBox; function LoadFile(FileName: WideString): Boolean; procedure DoTransformationBatch(SelectedOnly: Boolean); { Private declarations } public procedure AfterLoadingTranslation; {Callback function for reporting progress.} procedure ReportBatchProgress(CurrStage, TotalStages: integer); { Public declarations } published property BatchCancelled: Boolean read FBatchCancelled write FBatchCancelled; end; var ufrmBatch: TufrmBatch; implementation uses Preferences; {$R *.dfm} procedure TufrmBatch.TntFormShow(Sender: TObject); begin FFormStateSaver := TFormStateSaver.Create(Self, True, True, True, True, True, True, True, True, True); StashSettingsFromGUI; FileList.Modified := False; FRecentFiles := TRecentFiles.Create(Self, umnRecentBatchListFiles, OpenRecent); //If user has configured the preference to reload the last file, try to do so if ufrmPreferences.ucbReloadLastFileOnStartup.Checked then begin if FileExists(FRecentFiles.LastFile) then LoadFile(FRecentFiles.LastFile); end; end; procedure TufrmBatch.TntFormHide(Sender: TObject); begin FreeAndNil(FFormStateSaver); end; procedure TufrmBatch.WMDROPFILES(var Message: TWMDROPFILES); var TotalFilesDropped: integer; Buffer: Array[0..255] of Char; i: integer; begin TotalFilesDropped := DragQueryFile(Message.Drop, $FFFFFFFF, nil, 0); if TotalFilesDropped > 0 then for i := 0 to TotalFilesDropped-1 do begin DragQueryFile(Message.Drop, i, @Buffer, sizeof(Buffer)); AddFile(WideString(Buffer)); end; end; procedure TufrmBatch.AddFile(FileName: WideString); begin if WideFileExists(FileName) then if FileList.IndexOf(FileName) < 0 then begin FileList.AddFile(FileName); ulbFiles.Items.Add(FileList.ShortFileName[FileList.Count-1]); end; end; procedure TufrmBatch.TntFormCreate(Sender: TObject); begin FileList := TBatchList.Create; DragAcceptFiles(Self.Handle, True); upcOptions.ActivePageIndex := 0; end; procedure TufrmBatch.TntFormDestroy(Sender: TObject); begin FreeAndNil(FileList); end; procedure TufrmBatch.aAddFilesExecute(Sender: TObject); var i: integer; begin if udlgAddFiles.Execute then if udlgAddFiles.Files.Count > 0 then for i := 0 to udlgAddFiles.Files.Count-1 do AddFile(udlgAddFiles.Files[i]); end; procedure TufrmBatch.aRemoveFilesExecute(Sender: TObject); var i: integer; begin if ulbFiles.SelCount > 0 then for i := ulbFiles.Items.Count-1 downto 0 do if ulbFiles.Selected[i] then begin FileList.DeleteFile(i); ulbFiles.Items.Delete(i); end; end; procedure TufrmBatch.DoTransformationBatch(SelectedOnly: Boolean); var i: integer; FilesChanged: integer; Replacements: integer; ScriptRuns: integer; TotalReplacements: integer; TotalScriptRuns: integer; ErrorMessages: WideString; AllErrorMessages: WideString; Messidge: WideString; Start, Finish: TDateTime; TimeTaken: string; wsEncoding: WideString; FilesToCreate: TTntStringList; OutputFileName: WideString; BackupFileName: WideString; TempFileName: string; begin if FileList.Count < 1 then Exit; FilesToCreate := TTntStringList.Create; try if CreateOutputFileList(FilesToCreate, SelectedOnly) > 0 then begin if ufrmFileOverwriteConfirm.CheckForOverwrites(FilesToCreate) then if ufrmFileOverwriteConfirm.ShowModal = mrCancel then Exit; end else Exit; Start := GetTime; TotalReplacements := 0; FilesChanged := 0; TotalScriptRuns := 0; AllErrorMessages := ''; case ucbFileFormat.ItemIndex of 0: wsEncoding := WideString('UTF-8'); 1: wsEncoding := WideString('UTF-8_NO_BOM'); 2: wsEncoding := WideString('UTF-16LE'); 3: wsEncoding := WideString('ASCII_WITH_ENTITIES'); end; Screen.Cursor := crAppStart; try BatchCancelled := False; ufrmProgress.Caption := Caption; ufrmProgress.ulbProgMessage.Caption := ''; ufrmProgress.Show; Application.ProcessMessages; for i := 0 to FileList.Count-1 do if (WideFileExists(FileList[i])) and ((SelectedOnly = False) or (ulbFiles.Selected[i])) then begin if BatchCancelled then Break; ufrmProgress.ulbProgMessage.Caption := WideExtractFileName(FileList[i]); Application.ProcessMessages; OutputFileName := CreateOutputFileName(FileList[i]); if ufrmFileOverwriteConfirm.CanOverwrite(OutputFileName) then begin //Backup first if necessary if urgBackups.ItemIndex > 0 then BackupFileName := CreateBackupFileName(FileList[i]) else BackupFileName := ''; if SelectedOnly then begin ulbFiles.ItemIndex := i; end else begin ulbFiles.ClearSelection; ulbFiles.Selected[i] := True; end; Application.ProcessMessages; Replacements := ufrmMain.ProcessExternalFile(FileList[i], OutputFileName, BackupFileName, wsEncoding, ErrorMessages, ScriptRuns, ReportBatchProgress); if (Replacements > -1) or (ScriptRuns > 0) then begin TotalReplacements := TotalReplacements + Replacements; TotalScriptRuns := TotalScriptRuns + ScriptRuns; inc(FilesChanged); end; if (Length(ErrorMessages) > 0) then begin AllErrorMessages := AllErrorMessages + IntToStr(i+1) + ': ' + WideExtractFileName(FileList[i]) + #13#10 + ErrorMessages + #13#10; end; Application.ProcessMessages; end; end; finally ufrmProgress.Hide; Screen.Cursor := crDefault; end; finally FreeAndNil(FilesToCreate); end; Finish := GetTime; TimeTaken := FloatToStrF((Finish-Start)*SecsPerDay, ffGeneral, 7, 4); Messidge := WideFormat(ustProcessingComplete.Caption, [TotalReplacements, TotalScriptRuns, FilesChanged, TimeTaken]); if Length(AllErrorMessages) > 0 then begin Messidge := Messidge + #13#10#13#10 + ustSomeErrorsWereLogged.Caption; if WideMessageDlg(Messidge, mtConfirmation, [mbYes, mbNo], 0) = mrYes then begin TempFileName := FFormStateSaver.AppDirPath + '\' + 'errors.txt'; if WSaveStringToFile(TempFileName, AllErrorMessages) then LaunchFile(TempFileName); end; end else WideMessageDlg(Messidge, mtInformation, [mbOK], 0); end; procedure TufrmBatch.aDoTransformationBatchExecute(Sender: TObject); begin DoTransformationBatch(False); end; procedure TufrmBatch.aSelectAllExecute(Sender: TObject); begin ulbFiles.SelectAll; end; procedure TufrmBatch.aAddUTF8BOMExecute(Sender: TObject); var i: integer; InString: string; UTF8_BOM: string; UTF16LE_BOM: string; UTF16BE_BOM: string; UTF32LE_BOM: string; UTF32BE_BOM: string; FilesChanged: integer; begin if FileList.Count < 1 then Exit; if WideMessageDlg(aAddUTF8BOM.Hint, mtWarning, [mbYes, mbNo], 0) <> mrYes then Exit; FilesChanged := 0; UTF8_BOM := #$EF#$BB#$BF; UTF16LE_BOM := #$FF#$FE; UTF16BE_BOM := #$FE#$FF; UTF32LE_BOM := #$FF#$FE#0#0; UTF32BE_BOM := #0#0#$FE#$FF; for i := 0 to FileList.Count-1 do begin LoadFileToString(FileList[i], InString); if Copy(InString, 1, 3) <> UTF8_BOM then if Copy(InString, 1, 2) <> UTF16LE_BOM then if Copy(InString, 1, 2) <> UTF16BE_BOM then if Copy(InString, 1, 4) <> UTF32LE_BOM then if Copy(InString, 1, 4) <> UTF32BE_BOM then begin InString := UTF8_BOM + InString; SaveStringToFile(FileList[i], InString); Inc(FilesChanged); end; end; WideShowMessage(ustFilesChanged.Caption + IntToStr(FilesChanged)); end; procedure TufrmBatch.aStripUTF8BOMExecute(Sender: TObject); var i: integer; InString: string; OutString: string; UTF8_BOM: string; FilesChanged: integer; begin if FileList.Count < 1 then Exit; if WideMessageDlg(aStripUTF8BOM.Hint, mtWarning, [mbYes, mbNo], 0) <> mrYes then Exit; FilesChanged := 0; UTF8_BOM := #$EF#$BB#$BF; for i := 0 to FileList.Count-1 do begin LoadFileToString(FileList[i], InString); if Copy(InString, 1, 3) = UTF8_BOM then begin OutString := Copy(InString, 4, Length(InString) - 3); SaveStringToFile(FileList[i], OutString); Inc(FilesChanged); end; end; WideShowMessage(ustFilesChanged.Caption + IntToStr(FilesChanged)); end; procedure TufrmBatch.ulbFilesMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); var Index: integer; begin Index := ulbFiles.ItemAtPos(Point(X,Y), True); if (Index > -1) and (Index < FileList.Count) then begin ulbFiles.Hint := FileList[Index]; Application.ActivateHint(ulbFiles.ClientToScreen(Point(X,Y))); end else begin ulbFiles.Hint := ustListOfFiles.Caption; // Application.ActivateHint(ulbFiles.ClientToScreen(Point(X,Y))); end; end; procedure TufrmBatch.aeBatchIdle(Sender: TObject; var Done: Boolean); var ThereAreFiles: Boolean; begin //This event enforces a kind of logic on the options by disabling those //which are irrelevant due to other choices, and unsetting options which //make no sense due to other settings. case urgSaveLocation.ItemIndex of 0: begin ustNewLocation.Enabled := False; uedNewLocation.Enabled := False; uspbNewLocation.Enabled := False; end; 1: begin ustNewLocation.Enabled := True; uedNewLocation.Enabled := True; uspbNewLocation.Enabled := True; end; end; case urgOutputFilename.ItemIndex of 0: begin ustFilenameMask.Enabled := False; uedNewFilenamePrefix.Enabled := False; ulbOriginalFileName.Enabled := False; uedNewFilenameSuffix.Enabled := False; ucbUseOrigExtension.Enabled := False; end; 1: begin ustFilenameMask.Enabled := True; uedNewFilenamePrefix.Enabled := True; ulbOriginalFileName.Enabled := True; uedNewFilenameSuffix.Enabled := True; ucbUseOrigExtension.Enabled := True; end; end; ustBackupLocation.Enabled := (urgBackups.ItemIndex = 2); uedBackupLocation.Enabled := (urgBackups.ItemIndex = 2); uspbBackupLocation.Enabled := (urgBackups.ItemIndex = 2); //Eliminate paths which don't exist if Length(uedBackupLocation.Text) > 0 then if not WideDirectoryExists(uedBackupLocation.Text) then uedBackupLocation.Text := ''; if Length(uedNewLocation.Text) > 0 then if not WideDirectoryExists(uedNewLocation.Text) then uedNewLocation.Text := ''; //Enable the Go button and the BOM-handling buttons only if there are files ThereAreFiles := (FileList.Count > 0); ubnOK.Enabled := ThereAreFiles; aAddUTF8BOM.Enabled := ThereAreFiles; aStripUTF8BOM.Enabled := ThereAreFiles; //Can't delete files if none are selected aRemoveFiles.Enabled := (ulbFiles.SelCount > 0); //Stash the i/o and backup file settings StashSettingsFromGUI; //Enable save when the list has been modified aSaveBatchList.Enabled := FileList.Modified; //Enabled selected file transformation only if files are selected aTransformSelectedFiles.Enabled := (ulbFiles.SelCount > 0); end; procedure TufrmBatch.uspbBackupLocationClick(Sender: TObject); var FolderPath: string; DialogTitle: WideString; begin if WideDirectoryExists(uedBackupLocation.Text) then FolderPath := uedBackupLocation.Text else FolderPath := ''; DialogTitle := ustSelectBackupFolder.Caption; if GetFolder3(FolderPath, DialogTitle, ClientToScreen(Point(0,0))) then uedBackupLocation.Text := WideString(FolderPath); end; procedure TufrmBatch.uspbNewLocationClick(Sender: TObject); var FolderPath: string; DialogTitle: WideString; begin if WideDirectoryExists(uedNewLocation.Text) then FolderPath := uedNewLocation.Text else FolderPath := ''; DialogTitle := ustSelectOutputFolder.Caption; if GetFolder3(FolderPath, DialogTitle, ClientToScreen(Point(0,0))) then uedNewLocation.Text := WideString(FolderPath); end; function TufrmBatch.CreateOutputFileName(OrigFileName: WideString): WideString; var Path, FName: WideString; begin Result := OrigFileName; //default Path := WideExtractFilePath(OrigFileName); FName := WideExtractFileName(OrigFileName); if urgSaveLocation.ItemIndex = 1 then if WideDirectoryExists(uedNewLocation.Text) then Path := uedNewLocation.Text; if urgOutputFilename.ItemIndex = 1 then begin FName := uedNewFilenamePrefix.Text + WideChangeFileExt(FName, '') + uedNewFilenameSuffix.Text; if ucbUseOrigExtension.Checked then FName := FName + WideExtractFileExt(OrigFileName); end; Result := Path + FName; end; function TufrmBatch.CreateBackupFileName(OrigFileName: WideString): WideString; function IntToStrPadded(StrLen, Int: integer): WideString; begin Result := IntToStr(Int); while Length(Result) < StrLen do Result := '0' + Result; end; var Path, FName: WideString; i: integer; begin Result := ''; //default i := 0; if (urgBackups.ItemIndex = 2) and (WideDirectoryExists(uedBackupLocation.Text)) then Path := uedBackupLocation.Text else Path := WideExtractFilePath(OrigFileName); FName := WideExtractFileName(OrigFileName); Result := Path + WideChangeFileExt(FName, '') + '_' + IntToStrPadded(4, i) + WideExtractFileExt(FName) + '.bak'; while WideFileExists(Result) do begin inc(i); Result := Path + WideChangeFileExt(FName, '') + '_' + IntToStrPadded(4, i) + WideExtractFileExt(FName) + '.bak'; end; end; function TufrmBatch.CreateOutputFileList(OutFiles: TTntStringList; SelectedOnly: Boolean): integer; var i: integer; wsTemp: WideString; begin Result := 0; //default if FileList.Count > 0 then begin OutFiles.Clear; for i := 0 to FileList.Count-1 do begin if (SelectedOnly = False) or (ulbFiles.Selected[i]) then wsTemp := CreateOutputFileName(FileList[i]); if OutFiles.IndexOf(wsTemp) < 0 then OutFiles.Add(wsTemp); end; end; Result := OutFiles.Count; end; procedure TufrmBatch.utsOutputFilenameResize(Sender: TObject); var CW, W: integer; begin //Set the size and position of the text boxes and labels in the //output file pattern. CW := utsOutputFileName.ClientWidth; W := CW div 5; uedNewFilenamePrefix.Width := W; ulbOriginalFileName.Width := W; uedNewFilenameSuffix.Width := W; ucbUseOrigExtension.Width := W; ulbOriginalFileName.Left := CW div 4; uedNewFilenameSuffix.Left := CW div 2; ucbUseOrigExtension.Left := 3 * (CW div 4); end; procedure TufrmBatch.aCloseWindowExecute(Sender: TObject); begin Close; end; procedure TufrmBatch.AfterLoadingTranslation; begin urgSaveLocation.Items[0] := ustSaveInOriginalFolder.Caption; urgSaveLocation.Items[1] := ustSaveInDifferentLocation.Caption; urgOutputFilename.Items[0] := ustUseOriginalFilename.Caption; urgOutputFilename.Items[1] := ustCreateNewFilename.Caption; urgBackups.Items[0] := ustDontMakeBackups.Caption; urgBackups.Items[1] := ustBackupToOriginalFolder.Caption; urgBackups.Items[2] := ustBackupToNewLocation.Caption; end; { BatchList } function TBatchList.AddFile(NewFile: WideString): integer; begin Add(NewFile); Result := Count-1; Modified := True; end; function TBatchList.DeleteFile(Index: integer): Boolean; begin Result := False; if (Index < Count) and (Index > -1) then begin Delete(Index); Result := True; Modified := True; end; end; procedure TBatchList.Empty; begin SourceFileLocation := ''; ReplacePairsLocation := ''; FilePath := ''; Clear; Modified := False; end; function TBatchList.GetShortFileName(Index: integer): WideString; begin Result := ''; if (Index < Count) and (Index > -1) then Result := WideExtractFileName(Self[Index]); end; function TBatchList.ReadFromXMLFile(FName: WideString; EmptyFirst: Boolean): Boolean; var i: integer; DomImpl: TDomImplementation; DomDoc: TDomDocument; XMLToDomParser: TXMLToDomParser; RootNode: TDomNode; FilesNode: TDomNode; El: TDomElement; NewItemNum: integer; PropEl: TDomElement; wsProp: WideString; begin Result := False; if EmptyFirst then Empty; //Create XDOM objects for reading the file DomImpl := TDomImplementation.Create(nil); try DomDoc := TDomDocument.Create(DomImpl); XMLToDomParser := TXMLToDomParser.Create(DomImpl); try XMLToDomParser.DOMImpl := DomImpl; XMLToDomParser.KeepEntityRefs := False; DomDoc := XMLToDomParser.ParseFile(TFileName(FName), False); finally XMLToDomParser.Free; end; if DomDoc.GetElementsByTagName('batch-list').Length > 0 then begin if DomDoc.DocumentElement.GetElementsByTagName('file').Length > 0 then for i := 0 to DomDoc.DocumentElement.GetElementsByTagName('file').Length-1 do begin El := TDomElement(DomDoc.DocumentElement.GetElementsByTagName('file').Item(i)); Add(El.TextContent); end; end; //Linked file locations if appropriate if SaveSourceFileLocation then if DomDoc.GetElementsByTagName('source-file-location').Length > 0 then SourceFileLocation := TDomElement(DomDoc.DocumentElement.GetElementsByTagName('source-file-location').Item(i)).TextContent; if SaveReplacePairsLocation then if DomDoc.GetElementsByTagName('replace-pairs-location').Length > 0 then ReplacePairsLocation := TDomElement(DomDoc.DocumentElement.GetElementsByTagName('replace-pairs-location').Item(i)).TextContent; //Now i/o and backup settings if DomDoc.GetElementsByTagName('file-save-format').Length > 0 then begin PropEl := TDomElement(DomDoc.GetElementsByTagName('file-save-format').Item(0)); FileSaveFormat := PropEl.TextContent; end; if DomDoc.GetElementsByTagName('save-loc-setting').Length > 0 then begin PropEl := TDomElement(DomDoc.GetElementsByTagName('save-loc-setting').Item(0)); wsProp := PropEl.TextContent; SaveLocSetting := TSaveLocSetting(GetEnumValue(TypeInfo(TSaveLocSetting), wsProp)); end; if DomDoc.GetElementsByTagName('output-folder').Length > 0 then begin PropEl := TDomElement(DomDoc.GetElementsByTagName('output-folder').Item(0)); OutputFolder := PropEl.TextContent; end; if DomDoc.GetElementsByTagName('output-file-name').Length > 0 then begin PropEl := TDomElement(DomDoc.GetElementsByTagName('output-file-name').Item(0)); wsProp := PropEl.TextContent; OutputFileName := TOutputFileName(GetEnumValue(TypeInfo(TOutputFileName), wsProp)); end; if DomDoc.GetElementsByTagName('out-file-prefix').Length > 0 then begin PropEl := TDomElement(DomDoc.GetElementsByTagName('out-file-prefix').Item(0)); OutFilePrefix := PropEl.TextContent; end; if DomDoc.GetElementsByTagName('out-file-suffix').Length > 0 then begin PropEl := TDomElement(DomDoc.GetElementsByTagName('out-file-suffix').Item(0)); OutFileSuffix := PropEl.TextContent; end; if DomDoc.GetElementsByTagName('use-orig-ext').Length > 0 then begin PropEl := TDomElement(DomDoc.GetElementsByTagName('use-orig-ext').Item(0)); if PropEl.TextContent = '0' then OutFileUseOrigExtension := False else OutFileUseOrigExtension := True; end; if DomDoc.GetElementsByTagName('backup-setting').Length > 0 then begin PropEl := TDomElement(DomDoc.GetElementsByTagName('backup-setting').Item(0)); wsProp := PropEl.TextContent; BackupSetting := TBackupSetting(GetEnumValue(TypeInfo(TBackupSetting), wsProp)); end; if DomDoc.GetElementsByTagName('backup-location').Length > 0 then begin PropEl := TDomElement(DomDoc.GetElementsByTagName('backup-location').Item(0)); BackupLocation := PropEl.TextContent; end; Result := True; FilePath := FName; Modified := False; finally FreeAndNil(DomImpl); //Frees all associated objects. end; end; procedure TBatchList.SetBackupLocation(const Value: WideString); var TrimVal: WideString; begin TrimVal := WideTrim(Value); if fBackupLocation <> TrimVal then begin fBackupLocation := TrimVal; Modified := True; end; end; procedure TBatchList.SetFileSaveFormat(const Value: WideString); var TrimVal: WideString; begin TrimVal := WideTrim(Value); if fFileSaveFormat <> TrimVal then begin fFileSaveFormat := TrimVal; Modified := True; end; end; procedure TBatchList.SetBackupSetting(const Value: TBackupSetting); begin if fBackupSetting <> Value then begin fBackupSetting := Value; Modified := True; end; end; procedure TBatchList.SetOutFilePrefix(const Value: WideString); var TrimVal: WideString; begin TrimVal := WideTrim(Value); if fOutFilePrefix <> TrimVal then begin fOutFilePrefix := TrimVal; Modified := True; end; end; procedure TBatchList.SetOutFileSuffix(const Value: WideString); var TrimVal: WideString; begin TrimVal := WideTrim(Value); if fOutFileSuffix <> TrimVal then begin fOutFileSuffix := TrimVal; Modified := True; end; end; procedure TBatchList.SetOutFileUseOrigExtension(const Value: Boolean); begin if fOutFileUseOrigExtension <> Value then begin fOutFileUseOrigExtension := Value; Modified := True; end; end; procedure TBatchList.SetOutputFilename(const Value: TOutputFilename); begin if fOutputFilename <> Value then begin fOutputFilename := Value; Modified := True; end; end; procedure TBatchList.SetOutputFolder(const Value: WideString); var TrimVal: WideString; begin TrimVal := WideTrim(Value); if fOutputFolder <> TrimVal then begin fOutputFolder := TrimVal; Modified := True; end; end; procedure TBatchList.SetSaveLocSetting(const Value: TSaveLocSetting); begin if fSaveLocSetting <> Value then begin fSaveLocSetting := Value; Modified := True; end; end; function TBatchList.WriteToXMLFile(FName: WideString): Boolean; var DomImpl: TDomImplementation; DomDoc: TDomDocument; //El: TDomElement; DomToXMLParser: TDomToXMLParser; FileStream: TFileStream; RootNode: TDomElement; FilesNode: TDomElement; ChildNode: TDomElement; TextNode: TDomText; i: integer; procedure WriteWideStringNode(NodeName, Value: WideString); begin ChildNode := TDomElement.Create(DomDoc, NodeName); TextNode := TDomText.Create(DomDoc); TextNode.Data := Value; ChildNode.AppendChild(TextNode); RootNode.AppendChild(ChildNode); end; begin Result := False; //default //Create XDOM objects for building and writing the file DomImpl := TDomImplementation.Create(nil); try DomDoc := TDomDocument.Create(DomImpl); DomToXMLParser := TDomToXMLParser.Create(DomImpl); DomToXMLParser.DOMImpl := DomImpl; //Build the document //Create the root node RootNode := TDomElement.Create(DomDoc, 'batch-list'); DomDoc.AppendChild(RootNode); //Create a parent for the file list FilesNode := TDomElement.Create(DomDoc, 'files'); RootNode.AppendChild(FilesNode); //Create each of the child nodes for the list if Count > 0 then for i := 0 to Count-1 do begin ChildNode := TDomElement.Create(DomDoc, 'file'); TextNode := TDomText.Create(DomDoc); TextNode.Data := Self[i]; ChildNode.AppendChild(TextNode); FilesNode.AppendChild(ChildNode); end; //Add the ancillary file locations if required if SaveSourceFileLocation then if Length(SourceFileLocation) > 0 then if WideFileExists(SourceFileLocation) then WriteWideStringNode('source-file-location', SourceFileLocation); if SaveReplacePairsLocation then if Length(ReplacePairsLocation) > 0 then if WideFileExists(ReplacePairsLocation) then WriteWideStringNode('replace-pairs-location', ReplacePairsLocation); //Now add the backup and i/o settings WriteWideStringNode('file-save-format', FileSaveFormat); WriteWideStringNode('save-loc-setting', WideString(GetEnumName(TypeInfo(TSaveLocSetting), Ord(SaveLocSetting)))); WriteWideStringNode('output-folder', OutputFolder); WriteWideStringNode('output-file-name', WideString(GetEnumName(TypeInfo(TOutputFileName), Ord(OutputFileName)))); WriteWideStringNode('out-file-prefix', OutFilePrefix); WriteWideStringNode('out-file-suffix', OutFileSuffix); if OutFileUseOrigExtension then WriteWideStringNode('use-orig-ext', '1') else WriteWideStringNode('use-orig-ext', '0'); WriteWideStringNode('backup-setting', WideString(GetEnumName(TypeInfo(TBackupSetting), Ord(BackupSetting)))); WriteWideStringNode('backup-location', BackupLocation); FileStream := TFileStream.Create(FName, fmCreate or fmShareDenyWrite); try DomToXMLParser.WriteToStream(DomDoc, 'UTF-8', FileStream); FilePath := FName; finally FileStream.Free; end; Result := True; Modified := False; finally FreeAndNil(DomImpl); //This frees the associated domdoc and parser objects. end; end; function TufrmBatch.SaveChanges: Boolean; begin Result := False; case WideMessageDlg(ustSaveBatchListChanges.Caption, mtWarning, mbYesNoCancel, 0) of mrYes: Result := Save; mrNo: Result := True; end; end; function TufrmBatch.SaveAs: Boolean; begin Result := False; //default, just in case if udlgSaveBatchList.Execute then begin FileList.FilePath := udlgSaveBatchList.FileName; StashSettingsFromGUI; if FileList.WriteToXMLFile(FileList.FilePath) then begin FRecentFiles.AddNewFile(FileList.FilePath); UpdateStatus; Result := True; end; end; end; function TufrmBatch.Save: Boolean; begin Result := False; //default, just in case if WideFileExists(FileList.FilePath) then begin StashSettingsFromGUI; if FileList.WriteToXMLFile(FileList.FilePath) then begin UpdateStatus; FRecentFiles.AddNewFile(FileList.FilePath); Result := True; Exit; end; end else begin Result := SaveAs; end; end; procedure TufrmBatch.aNewBatchListExecute(Sender: TObject); begin if (not FileList.Modified) or SaveChanges then begin FileList.Empty; udlgSaveBatchList.FileName := ''; ulbFiles.Clear; UpdateStatus; end; end; procedure TufrmBatch.UpdateStatus; var AvailWidth: integer; SFPath: WideString; begin AvailWidth := usbrBatch.Panels[0].Width - 50; SFPath := MinimizeName(FileList.FilePath, Canvas, AvailWidth); usbrBatch.Panels[0].Text := SFPath; end; function TufrmBatch.LoadFile(FileName: WideString): Boolean; begin Result := False; if FileList.ReadFromXMLFile(FileName, True) then begin ulbFiles.Clear; WriteSettingsToGUI; WriteFileListToListBox; UpdateStatus; FRecentFiles.AddNewFile(FileName); Result := True; end; end; function TufrmBatch.OpenFile: Boolean; var i: integer; begin Result := False; if (not FileList.Modified) or SaveChanges then begin udlgSaveBatchList.FileName := ''; if udlgOpenBatchList.Execute then Result := LoadFile(udlgOpenBatchList.FileName); end; end; procedure TufrmBatch.aSaveBatchListExecute(Sender: TObject); begin Save; end; procedure TufrmBatch.aSaveBatchListAsExecute(Sender: TObject); begin SaveAs; end; procedure TufrmBatch.OpenRecent(Sender: TObject; const FileName: WideString); begin if WideFileExists(FileName) then if (not FileList.Modified) or SaveChanges then LoadFile(FileName); end; procedure TufrmBatch.TntFormClose(Sender: TObject; var Action: TCloseAction); begin FreeAndNil(FRecentFiles); end; procedure TufrmBatch.WriteSettingsToGUI; begin if ucbFileFormat.Items.IndexOf(FileList.FileSaveFormat) > -1 then ucbFileFormat.ItemIndex := ucbFileFormat.Items.IndexOf(FileList.FileSaveFormat); urgSaveLocation.ItemIndex := Ord(FileList.SaveLocSetting); uedNewLocation.Text := FileList.OutputFolder; urgOutputFileName.ItemIndex := Ord(FileList.OutputFileName); uedNewFilenamePrefix.Text := FileList.OutFilePrefix; uedNewFilenameSuffix.Text := FileList.OutFileSuffix; urgBackups.ItemIndex := Ord(FileList.BackupSetting); uedBackupLocation.Text := FileList.BackupLocation; ucbUseOrigExtension.Checked := FileList.OutFileUseOrigExtension; end; procedure TufrmBatch.StashSettingsFromGUI; begin FileList.FileSaveFormat := ucbFileFormat.Text; FileList.SaveLocSetting := TSaveLocSetting(urgSaveLocation.ItemIndex); FileList.OutputFolder := uedNewLocation.Text; FileList.OutputFileName := TOutputFilename(urgOutputFileName.ItemIndex); FileList.OutFilePrefix := uedNewFilenamePrefix.Text; FileList.OutFileSuffix := uedNewFilenameSuffix.Text; FileList.BackupSetting := TBackupSetting(urgBackups.ItemIndex); FileList.BackupLocation := uedBackupLocation.Text; FileList.OutFileUseOrigExtension := ucbUseOrigExtension.Checked; end; procedure TufrmBatch.aOpenBatchListExecute(Sender: TObject); begin OpenFile; end; procedure TufrmBatch.WriteFileListToListBox; var i: integer; begin ulbFiles.Clear; if FileList.Count > 0 then for i := 0 to FileList.Count-1 do ulbFiles.Items.Add(FileList.ShortFileName[i]); end; procedure TufrmBatch.TntFormResize(Sender: TObject); begin usbrBatch.Panels[0].Width := ClientWidth-50; UpdateStatus; end; procedure TufrmBatch.TntFormCloseQuery(Sender: TObject; var CanClose: Boolean); begin CanClose := (not FileList.Modified) or SaveChanges; end; procedure TufrmBatch.ReportBatchProgress(CurrStage, TotalStages: integer); begin ufrmProgress.ShowProgress(CurrStage, TotalStages, ufrmProgress.Caption, ufrmProgress.ulbProgMessage.Caption); if ufrmProgress.OperationCancelled then BatchCancelled := True; end; procedure TufrmBatch.aTransformSelectedFilesExecute(Sender: TObject); begin DoTransformationBatch(True); end; end.