├── .gitattributes ├── .gitignore ├── LICENSE ├── README.md ├── build ├── TaskRunner.iss └── TaskRunner.job ├── examples ├── BuildDelphiProject.job ├── BuildInnoSetupScript.job └── TestScripterTask.job ├── images ├── TaskRunner.jpg ├── task-runner-1-4.jpg └── taskrunner-1-3.jpg └── src ├── About ├── AboutForm.dfm └── AboutForm.pas ├── CallJob ├── CallJobItem.pas ├── CallJobItemFrm.dfm └── CallJobItemFrm.pas ├── Classes ├── JobClasses.pas ├── JobConsts.pas ├── JobDskClasses.pas └── OperationClasses.pas ├── CommandJob ├── CommandBatchJobItem.pas ├── CommandBatchJobItemFrm.dfm └── CommandBatchJobItemFrm.pas ├── ConnectionSetup ├── ConnectionSetup.dfm └── ConnectionSetup.pas ├── CustomForms ├── CustomModalDlg.dfm └── CustomModalDlg.pas ├── CustomJob ├── CustomDialog.dfm ├── CustomDialog.pas ├── CustomJobItems.pas ├── CustomParametersDialog.dfm ├── CustomParametersDialog.pas ├── CustomScriptDialog.dfm ├── CustomScriptDialog.pas ├── TabEditors.dfm └── TabEditors.pas ├── CustomRunJob ├── CustomRunJobItem.pas ├── CustomRunJobItemFrm.dfm └── CustomRunJobItemFrm.pas ├── GlobalParams ├── GlobalParamsJobItemFrm.dfm └── GlobalParamsJobItemFrm.pas ├── ItemListView ├── ItemListView.dfm └── ItemListView.pas ├── Lib └── JobControls │ ├── JobControls.dpk │ ├── JobControls.dproj │ ├── JobControls.res │ ├── JobCtrls.pas │ ├── JobMemData.pas │ └── JobRegister.pas ├── Main ├── App-Icon-150.png ├── App-Icon-44.png ├── JobsMain.dfm ├── JobsMain.pas ├── TaskRunner.dpr ├── TaskRunner.dproj ├── TaskRunner.res ├── TaskRunner_Icon.ico ├── main.dfm └── main.pas ├── ParamJob ├── ParametersJobItem.pas ├── ParametersJobItemFrm.dfm └── ParametersJobItemFrm.pas ├── References ├── ReferendesForm.dfm └── ReferendesForm.pas ├── RunJob ├── RunJobForm.dfm └── RunJobForm.pas ├── SQLJob ├── SQLScriptJobItem.pas ├── SQLScriptJobItemFrm.dfm └── SQLScriptJobItemFrm.pas ├── ScriptJob ├── JavaScriptExecutor.pas ├── PascalScriptClassesProxy.pas ├── PascalScriptExecutor.pas ├── ScriptExecutor.pas ├── ScripterJobItem.pas ├── ScripterJobItemFrm.dfm ├── ScripterJobItemFrm.pas └── uPSI_PascalScriptClassesProxy.pas ├── SelectJob ├── SelectJobItem.dfm └── SelectJobItem.pas └── Utils ├── BuildNo.inc ├── JobConverter.pas ├── JobUtils.pas ├── OperationUtils.pas ├── VerInfo.pas ├── XMLUtils.pas └── clErrorHandling.pas /.gitattributes: -------------------------------------------------------------------------------- 1 | # Set the default behavior, in case people don't have core.autocrlf set. 2 | * text=auto 3 | 4 | # Denote all files that are truly binary and should not be modified. 5 | *.dat binary 6 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # Uncomment these types if you want even more clean repository. But be careful. 2 | # It can make harm to an existing project source. Read explanations below. 3 | # 4 | # Resource files are binaries containing manifest, project icon and version info. 5 | # They can not be viewed as text or compared by diff-tools. Consider replacing them with .rc files. 6 | #*.res 7 | # 8 | # Type library file (binary). In old Delphi versions it should be stored. 9 | # Since Delphi 2009 it is produced from .ridl file and can safely be ignored. 10 | #*.tlb 11 | # 12 | # Diagram Portfolio file. Used by the diagram editor up to Delphi 7. 13 | # Uncomment this if you are not using diagrams or use newer Delphi version. 14 | #*.ddp 15 | # 16 | # Visual LiveBindings file. Added in Delphi XE2. 17 | # Uncomment this if you are not using LiveBindings Designer. 18 | #*.vlb 19 | # 20 | # Deployment Manager configuration file for your project. Added in Delphi XE2. 21 | # Uncomment this if it is not mobile development and you do not use remote debug feature. 22 | #*.deployproj 23 | # 24 | # C++ object files produced when C/C++ Output file generation is configured. 25 | # Uncomment this if you are not using external objects (zlib library for example). 26 | #*.obj 27 | # 28 | 29 | # Delphi compiler-generated binaries (safe to delete) 30 | *.exe 31 | *.dll 32 | *.bpl 33 | *.bpi 34 | *.dcp 35 | *.so 36 | *.apk 37 | *.drc 38 | *.map 39 | *.dres 40 | *.rsm 41 | *.tds 42 | *.dcu 43 | *.lib 44 | *.a 45 | *.o 46 | *.ocx 47 | 48 | # Delphi autogenerated files (duplicated info) 49 | *.cfg 50 | *.hpp 51 | *Resource.rc 52 | 53 | # Delphi local files (user-specific info) 54 | *.local 55 | *.identcache 56 | *.projdata 57 | *.tvsconfig 58 | *.dsk 59 | 60 | # Delphi history and backups 61 | __history/ 62 | __recovery/ 63 | *.~* 64 | 65 | # Castalia statistics file (since XE7 Castalia is distributed with Delphi) 66 | *.stat 67 | 68 | # Boss dependency manager vendor folder https://github.com/HashLoad/boss 69 | modules/ 70 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # TaskRunner 2 | 3 | 4 | 5 | This program serves for Software build automation, executing sequential tasks, including database backup/restore, running SQL scripts, Windows shell commands, Pascal scripts, passing variables through the whole task execution chain, and many more. You can set up a list of global parameters, such as Delphi application path, and use these parameters in tasks. You can even call a separated task chain from another task in the same way as you call Delphi procedure or a function, with passing parameters. 6 | 7 | 8 | 9 | The first version of TaskRunner was created in 2002. The program UI was not modified for a long time. Now, we are working on improving the program, migrating to the latest version of RAD Studio, and replacing the user interface with modern controls and forms. 10 | Initially, the program supported different scriping languages, including JavaScript, VBScript, and Delphi script. We used Dream Company scripting engine, which is not available anymore. The current version utilizes the PascalScripting library (by RemObjects) for running Pascal scripts. We are planning to implement JavaScript and VBScript, as well. 11 | 12 | 13 | 14 | We hope, the publishing the TaskRunner sources on GitHub will help developers to automate their routine tasks, and save time on building and deploying their products. 15 | 16 | You can contribute to the TaskRunner development by suggesting your fixes and improvements. Forks and pull requests are welcome. 17 | 18 | 19 | 20 | Please feel free to star our repository to help other devs to learn about this project. 21 | 22 | 23 | 24 | Note: The program requires [Visual C++ Redistributable for Visual Studio 2015 (x86)](https://www.microsoft.com/en-US/download/details.aspx?id=48145) to be installed. 25 | 26 | ## Examples 27 | 28 | * [Build InnoSetup Script](examples/BuildInnoSetupScript.job) - automates the compiling of an InnoSetup installation script, customizes the input parameters, and cleanups the output folder. 29 | * [Build Delphi Project](examples/BuildDelphiProject.job) - tasks to compile a program using the Delphi command line compiler and pack using the pkzipc utility. 30 | Video tutorial on CleverComponents YouTube channel: [How to set up and run a project in TaskRunner](https://youtu.be/cndY-BVm8yA) 31 | * [Test Scripter Task](examples/TestScripterTask.job) - a simple project, which shows how to run a Pascal script and pass parameters to this script. 32 | -------------------------------------------------------------------------------- /build/TaskRunner.iss: -------------------------------------------------------------------------------- 1 | ; Script generated by the Inno Setup Script Wizard. 2 | ; SEE THE DOCUMENTATION FOR DETAILS ON CREATING INNO SETUP SCRIPT FILES! 3 | 4 | #define MyAppSourceDir "d:\Progects\Task-Runner" 5 | #define MyAppOutputDir "d:\Progects\Task-Runner\OutPut" 6 | #define MyAppVersion "1.4" 7 | 8 | #define MyAppName "Task Runner" 9 | #define MyAppPublisher "Clever Components" 10 | #define MyAppURL "https://github.com/CleverComponents/Task-Runner" 11 | #define MyAppExeName "TaskRunner.exe" 12 | #define MyAppAssocName MyAppName + " File" 13 | #define MyAppAssocExt ".job" 14 | #define MyAppAssocKey StringChange(MyAppAssocName, " ", "") + MyAppAssocExt 15 | #define MyAppSetup "taskrunner-setup-" + MyAppVersion 16 | 17 | [Setup] 18 | ; NOTE: The value of AppId uniquely identifies this application. Do not use the same AppId value in installers for other applications. 19 | ; (To generate a new GUID, click Tools | Generate GUID inside the IDE.) 20 | AppId={{CFD5F92E-F7A3-42FF-A976-F50481054307} 21 | AppName={#MyAppName} 22 | AppVersion={#MyAppVersion} 23 | ;AppVerName={#MyAppName} {#MyAppVersion} 24 | AppPublisher={#MyAppPublisher} 25 | AppPublisherURL={#MyAppURL} 26 | AppSupportURL={#MyAppURL} 27 | AppUpdatesURL={#MyAppURL} 28 | DefaultDirName={autopf}\{#MyAppPublisher}\{#MyAppName} 29 | ChangesAssociations=yes 30 | DisableProgramGroupPage=yes 31 | LicenseFile=LICENSE 32 | ; Uncomment the following line to run in non administrative install mode (install for current user only.) 33 | ;PrivilegesRequired=lowest 34 | PrivilegesRequiredOverridesAllowed=dialog 35 | SourceDir={#MyAppSourceDir} 36 | OutputDir={#MyAppOutputDir} 37 | OutputBaseFilename={#MyAppSetup} 38 | Compression=lzma 39 | SolidCompression=yes 40 | WizardStyle=modern 41 | SignTool=cleversign 42 | 43 | [Languages] 44 | Name: "english"; MessagesFile: "compiler:Default.isl" 45 | Name: "armenian"; MessagesFile: "compiler:Languages\Armenian.isl" 46 | Name: "brazilianportuguese"; MessagesFile: "compiler:Languages\BrazilianPortuguese.isl" 47 | Name: "catalan"; MessagesFile: "compiler:Languages\Catalan.isl" 48 | Name: "corsican"; MessagesFile: "compiler:Languages\Corsican.isl" 49 | Name: "czech"; MessagesFile: "compiler:Languages\Czech.isl" 50 | Name: "danish"; MessagesFile: "compiler:Languages\Danish.isl" 51 | Name: "dutch"; MessagesFile: "compiler:Languages\Dutch.isl" 52 | Name: "finnish"; MessagesFile: "compiler:Languages\Finnish.isl" 53 | Name: "french"; MessagesFile: "compiler:Languages\French.isl" 54 | Name: "german"; MessagesFile: "compiler:Languages\German.isl" 55 | Name: "hebrew"; MessagesFile: "compiler:Languages\Hebrew.isl" 56 | Name: "icelandic"; MessagesFile: "compiler:Languages\Icelandic.isl" 57 | Name: "italian"; MessagesFile: "compiler:Languages\Italian.isl" 58 | Name: "japanese"; MessagesFile: "compiler:Languages\Japanese.isl" 59 | Name: "norwegian"; MessagesFile: "compiler:Languages\Norwegian.isl" 60 | Name: "polish"; MessagesFile: "compiler:Languages\Polish.isl" 61 | Name: "portuguese"; MessagesFile: "compiler:Languages\Portuguese.isl" 62 | Name: "russian"; MessagesFile: "compiler:Languages\Russian.isl" 63 | Name: "slovak"; MessagesFile: "compiler:Languages\Slovak.isl" 64 | Name: "slovenian"; MessagesFile: "compiler:Languages\Slovenian.isl" 65 | Name: "spanish"; MessagesFile: "compiler:Languages\Spanish.isl" 66 | Name: "turkish"; MessagesFile: "compiler:Languages\Turkish.isl" 67 | Name: "ukrainian"; MessagesFile: "compiler:Languages\Ukrainian.isl" 68 | 69 | [Tasks] 70 | Name: "desktopicon"; Description: "{cm:CreateDesktopIcon}"; GroupDescription: "{cm:AdditionalIcons}"; Flags: unchecked 71 | 72 | [Files] 73 | Source: "{#MyAppVersion}\{#MyAppExeName}"; DestDir: "{app}"; Flags: ignoreversion 74 | Source: "{#MyAppVersion}\mozglue.dll"; DestDir: "{app}"; Flags: ignoreversion 75 | Source: "{#MyAppVersion}\nspr4.dll"; DestDir: "{app}"; Flags: ignoreversion 76 | Source: "{#MyAppVersion}\plc4.dll"; DestDir: "{app}"; Flags: ignoreversion 77 | Source: "{#MyAppVersion}\plds4.dll"; DestDir: "{app}"; Flags: ignoreversion 78 | Source: "{#MyAppVersion}\synmozjs52.dll"; DestDir: "{app}"; Flags: ignoreversion 79 | ; NOTE: Don't use "Flags: ignoreversion" on any shared system files 80 | 81 | [Registry] 82 | Root: HKA; Subkey: "Software\Classes\{#MyAppAssocExt}\OpenWithProgids"; ValueType: string; ValueName: "{#MyAppAssocKey}"; ValueData: ""; Flags: uninsdeletevalue 83 | Root: HKA; Subkey: "Software\Classes\{#MyAppAssocKey}"; ValueType: string; ValueName: ""; ValueData: "{#MyAppAssocName}"; Flags: uninsdeletekey 84 | Root: HKA; Subkey: "Software\Classes\{#MyAppAssocKey}\DefaultIcon"; ValueType: string; ValueName: ""; ValueData: "{app}\{#MyAppExeName},0" 85 | Root: HKA; Subkey: "Software\Classes\{#MyAppAssocKey}\shell\open\command"; ValueType: string; ValueName: ""; ValueData: """{app}\{#MyAppExeName}"" ""%1""" 86 | Root: HKA; Subkey: "Software\Classes\Applications\{#MyAppExeName}\SupportedTypes"; ValueType: string; ValueName: "{#MyAppAssocExt}"; ValueData: "" 87 | 88 | [Icons] 89 | Name: "{autoprograms}\{#MyAppName}"; Filename: "{app}\{#MyAppExeName}" 90 | Name: "{autodesktop}\{#MyAppName}"; Filename: "{app}\{#MyAppExeName}"; Tasks: desktopicon 91 | 92 | [Run] 93 | Filename: "{app}\{#MyAppExeName}"; Description: "{cm:LaunchProgram,{#StringChange(MyAppName, '&', '&&')}}"; Flags: nowait postinstall skipifsilent 94 | 95 | -------------------------------------------------------------------------------- /build/TaskRunner.job: -------------------------------------------------------------------------------- 1 | 2 |
3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | Success 11 | 12 | d:\Progects\Task-Runner 13 | d:\Progects\Task-Runner\output 14 | 1.4 15 | d: 16 | 17 | 18 | 19 | 20 | 21 | 22 | Success 23 | and 24 | 25 | 26 | No 27 | No 28 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | Success 40 | 41 | :source_dir 42 | :app_version 43 | @@SIGNTOOL32 44 | @@CERTISSUEDBY 45 | @@CERTISSUEDTO 46 | :source_drv 47 | TaskRunner.exe 48 | 49 | Sign File 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | Success 58 | 59 | :source_dir 60 | :output_dir 61 | :app_version 62 | @@INNOSETUP6 63 | 64 | Build InnoSetup Script 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | Success 74 | and 75 | 76 | 77 | No 78 | No 79 | 173 | 174 | ::INNOSETUP ::SCRIPT 175 | 176 | 177 | 178 | 179 | 180 | 181 | 182 | 183 | 184 | Success 185 | and 186 | 187 | 188 | No 189 | No 190 | 204 | 205 | 206 | 207 | 208 |
209 | -------------------------------------------------------------------------------- /examples/BuildDelphiProject.job: -------------------------------------------------------------------------------- 1 | 2 |
3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | Success 11 | 12 | c:\Users\Nikita\22\TaskRunner\output 13 | C: 14 | Users\Nikita\22\TaskRunner 15 | 16 | TaskRunner.zip 17 | @@PKZIPC 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | Success 26 | and 27 | 28 | 29 | No 30 | No 31 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | Success 42 | and 43 | 44 | 45 | No 46 | No 47 | 60 | 61 | Delphi Script 62 | 63 | 64 | 65 | 66 | 67 | 68 | Success 69 | 70 | @@DELPHI103 71 | :BINPATH 72 | :ROOTDIR 73 | :SOURCEPATH 74 | TaskRunner.dpr 75 | 76 | TaskRunner.log 77 | @@LIBPATHS 78 | 79 | -NSSystem;System.Win;Winapi;Vcl;Data;Data.Win 80 | 81 | Build Delphi Project 82 | 83 | 84 | 85 | 86 | 87 | 88 | 89 | Success 90 | and 91 | 92 | 93 | No 94 | No 95 | 113 | 114 | 115 | 116 | 117 | 118 | 119 | 120 | 121 | Success 122 | or 123 | 124 | 125 | No 126 | No 127 | 157 | Failed 158 | Fatal 159 | FATAL 160 | FAILED 161 | 162 | 163 | 164 | 165 |
166 | -------------------------------------------------------------------------------- /examples/BuildInnoSetupScript.job: -------------------------------------------------------------------------------- 1 | 2 |
3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | Success 11 | 12 | c:\Users\user\Documents\Task-Runner 13 | c:\Users\user\Documents\OutPut 14 | 1.3 15 | 16 | 17 | 18 | 19 | 20 | 21 | Success 22 | and 23 | 24 | 25 | No 26 | No 27 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | Success 39 | 40 | :source_dir 41 | :output_dir 42 | :app_version 43 | @@INNOSETUP 44 | 45 | Build InnoSetup Script 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | Success 55 | and 56 | 57 | 58 | No 59 | No 60 | 153 | 154 | ::INNOSETUP ::SCRIPT 155 | 156 | 157 | 158 | 159 | 160 | 161 |
162 | -------------------------------------------------------------------------------- /examples/TestScripterTask.job: -------------------------------------------------------------------------------- 1 | 2 |
3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | Success 11 | 12 | value1 13 | value2 14 | 15 | 16 | 17 | 18 | qwwqqw 19 | 20 | 21 | Success 22 | and 23 | 24 | c:\Users\Public\Log.txt 25 | No 26 | No 27 | 48 | 49 | PascalScript 50 | 51 | 52 | 53 | 54 | 55 | 56 | Success 57 | and 58 | 59 | 60 | No 61 | No 62 | 76 | 77 | JavaScript 78 | 79 | 80 | 81 | 82 |
83 | -------------------------------------------------------------------------------- /images/TaskRunner.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CleverComponents/Task-Runner/cf8374f1eec7e72a8b4e978ad8e2300eb8b6a36c/images/TaskRunner.jpg -------------------------------------------------------------------------------- /images/task-runner-1-4.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CleverComponents/Task-Runner/cf8374f1eec7e72a8b4e978ad8e2300eb8b6a36c/images/task-runner-1-4.jpg -------------------------------------------------------------------------------- /images/taskrunner-1-3.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CleverComponents/Task-Runner/cf8374f1eec7e72a8b4e978ad8e2300eb8b6a36c/images/taskrunner-1-3.jpg -------------------------------------------------------------------------------- /src/About/AboutForm.pas: -------------------------------------------------------------------------------- 1 | unit AboutForm; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 | CustomModalDlg, StdCtrls, ExtCtrls; 8 | 9 | type 10 | TAboutDialog = class(TCustomModalDialog) 11 | Image1: TImage; 12 | procedure FormKeyDown(Sender: TObject; var Key: Word; 13 | Shift: TShiftState); 14 | procedure Image1MouseDown(Sender: TObject; Button: TMouseButton; 15 | Shift: TShiftState; X, Y: Integer); 16 | procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X, 17 | Y: Integer); 18 | end; 19 | 20 | procedure ShowAbout; 21 | 22 | implementation 23 | 24 | {$R *.DFM} 25 | 26 | procedure ShowAbout; 27 | var 28 | Dlg: TAboutDialog; 29 | begin 30 | Dlg := TAboutDialog.Create(nil); 31 | try 32 | Dlg.ShowModal(); 33 | finally 34 | Dlg.Free(); 35 | end; 36 | end; 37 | 38 | procedure TAboutDialog.FormKeyDown(Sender: TObject; var Key: Word; 39 | Shift: TShiftState); 40 | begin 41 | if (Key = VK_ESCAPE) then Close(); 42 | end; 43 | 44 | procedure TAboutDialog.Image1MouseDown(Sender: TObject; 45 | Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 46 | begin 47 | Close(); 48 | end; 49 | 50 | procedure TAboutDialog.Image1MouseMove(Sender: TObject; Shift: TShiftState; 51 | X, Y: Integer); 52 | begin 53 | // 54 | end; 55 | 56 | end. 57 | -------------------------------------------------------------------------------- /src/CallJob/CallJobItem.pas: -------------------------------------------------------------------------------- 1 | unit CallJobItem; 2 | 3 | interface 4 | 5 | uses 6 | System.Classes, JobClasses, System.SysUtils, System.Variants, OperationClasses, CustomJobItems, Winapi.msxml; 7 | 8 | type 9 | TCallJobDataItem = class(TCustomParametersJobDataItem) 10 | private 11 | FCallJobManagerFileName: String; 12 | FCallJobManager: TJobManager; 13 | FCallMediaName: String; 14 | FCallJobName: String; 15 | procedure SetCallJobName(const Value: String); 16 | procedure SetCallMediaName(const Value: String); 17 | protected 18 | procedure InternalSetDataState(const Value: TJobState); override; 19 | function GetDataState: TJobState; override; 20 | procedure InitData; override; 21 | public 22 | constructor Create(AOwner: TJobItem); override; 23 | destructor Destroy; override; 24 | procedure GetGlobalParameterList(AList: TJobOperationParams); override; 25 | function Load(AStream: TStream): Integer; overload; override; 26 | procedure Load(ANode: IXMLDOMNode); overload; override; 27 | procedure Store(ANode: IXMLDOMNode); override; 28 | procedure Assign(Source: TPersistent); override; 29 | procedure Perform(Visitor: TJobVisitor); override; 30 | function GetJobManager(AMediaName: String): TJobManager; 31 | function GetCallJobItem(AJobName: String; AMediaName: String): TJobItem; 32 | function FindCallJobItem(AJobName: String; AMediaName: String): TJobItem; 33 | property CallJobName: String read FCallJobName write SetCallJobName; 34 | property CallMediaName: String read FCallMediaName write SetCallMediaName; 35 | end; 36 | 37 | implementation 38 | 39 | uses 40 | JobConsts; 41 | 42 | { TCallJobDataItem } 43 | 44 | procedure TCallJobDataItem.Assign(Source: TPersistent); 45 | begin 46 | inherited Assign(Source); 47 | BeginUpdate(); 48 | try 49 | if (Source is TCallJobDataItem) then 50 | begin 51 | FCallJobName := TCallJobDataItem(Source).CallJobName; 52 | FCallMediaName := TCallJobDataItem(Source).CallMediaName; 53 | end else 54 | begin 55 | InitData(); 56 | end; 57 | finally 58 | EndUpdate(); 59 | end; 60 | end; 61 | 62 | constructor TCallJobDataItem.Create(AOwner: TJobItem); 63 | begin 64 | inherited Create(AOwner); 65 | FCallJobName := ''; 66 | FCallMediaName := ''; 67 | FCallJobManager := nil; 68 | FCallJobManagerFileName := ''; 69 | end; 70 | 71 | function TCallJobDataItem.GetCallJobItem(AJobName: String; AMediaName: String): TJobItem; 72 | var 73 | i: Integer; 74 | Item: TJobItem; 75 | AJobManager: TJobManager; 76 | begin 77 | Result := nil; 78 | AJobManager := GetJobManager(AMediaName); 79 | if (AJobManager = nil) then Exit; 80 | for i := 0 to AJobManager.RootItemsCount - 1 do 81 | begin 82 | Item := AJobManager.RootItems[i]; 83 | if (Item.Data <> Self) and (CompareText(Item.JobName, AJobName) = 0) then 84 | begin 85 | Result := Item; 86 | Break; 87 | end; 88 | end; 89 | end; 90 | 91 | function TCallJobDataItem.GetJobManager(AMediaName: String): TJobManager; 92 | function GetJobLibPath: String; 93 | var 94 | Params: TJobOperationParams; 95 | Param: TJobOperationParam; 96 | begin 97 | Result := ''; 98 | if (Owner <> nil) and (Owner.JobManager <> nil) then 99 | begin 100 | Params := Owner.JobManager.GetGlobalParameters(); 101 | if (Params <> nil) then 102 | begin 103 | Param := Params.FindParam(cGlobalJobLibPath); 104 | if (Param <> nil) then 105 | begin 106 | Result := VarToStr(Param.Value); 107 | end; 108 | end; 109 | end; 110 | if (Result = '') then 111 | begin 112 | Result := ExtractFilePath(ParamStr(0)); 113 | end; 114 | if (Result <> '') and (Result[Length(Result)] <> '\') then 115 | begin 116 | Result := Result + '\'; 117 | end; 118 | end; 119 | 120 | function DoLoadAsXML(const AFileName: string): Boolean; 121 | var 122 | Doc: IXMLDOMDocument; 123 | MainNode: IXMLDOMNode; 124 | begin 125 | Doc := CoDOMDocument.Create(); 126 | Doc.load(AFileName); 127 | Result := (Doc.xml <> ''); 128 | if not Result then Exit; 129 | MainNode := Doc.selectSingleNode('Main'); 130 | if MainNode = nil then 131 | begin 132 | raise Exception.CreateFmt(cUnknownImportMediaFile, [AFileName]); 133 | end; 134 | FCallJobManager.Load(MainNode); 135 | end; 136 | 137 | procedure DoLoadAsStream(const AFileName: string); 138 | var 139 | Stream: TStream; 140 | begin 141 | Stream := TFileStream.Create(AFileName, fmOpenRead); 142 | try 143 | FCallJobManager.Load(Stream); 144 | finally 145 | Stream.Free(); 146 | end; 147 | end; 148 | 149 | var 150 | AFileName: String; 151 | begin 152 | Result := Owner.JobManager; 153 | if (FCallJobManagerFileName <> AMediaName) then 154 | begin 155 | FreeAndNil(FCallJobManager); 156 | FCallJobManagerFileName := AMediaName; 157 | end; 158 | if (FCallJobManagerFileName = '') then Exit; 159 | 160 | AFileName := FCallJobManagerFileName; 161 | if (ExtractFilePath(AFileName) = '') then 162 | begin 163 | AFileName := GetJobLibPath() + AFileName; 164 | end; 165 | 166 | if FileExists(AFileName) then 167 | begin 168 | if (FCallJobManager = nil) then 169 | begin 170 | FCallJobManager := TJobManager.Create(); 171 | FCallJobManager.OnGetGlobalParams := Owner.JobManager.OnGetGlobalParams; 172 | if not DoLoadAsXML(AFileName) then 173 | begin 174 | DoLoadAsStream(AFileName); 175 | end; 176 | end; 177 | Result := FCallJobManager; 178 | end; 179 | end; 180 | 181 | function TCallJobDataItem.Load(AStream: TStream): Integer; 182 | var 183 | R: TReader; 184 | begin 185 | Result := inherited Load(AStream); 186 | BeginUpdate(); 187 | R := TReader.Create(AStream, 1024); 188 | try 189 | FCallJobName := R.ReadString(); 190 | if (Result > 7) then 191 | begin 192 | FCallMediaName := R.ReadString(); 193 | end; 194 | finally 195 | R.Free(); 196 | EndUpdate(); 197 | end; 198 | end; 199 | 200 | procedure TCallJobDataItem.Perform(Visitor: TJobVisitor); 201 | var 202 | Item: TJobItem; 203 | CallVisitor: TJobVisitor; 204 | begin 205 | inherited Perform(Visitor); 206 | 207 | Item := FindCallJobItem(FCallJobName, FCallMediaName); 208 | CallVisitor := TJobVisitor.Create(); 209 | try 210 | CallVisitor.Params.Assign(Parameters); 211 | AssignParams(CallVisitor.Params, Visitor.Params, cParseLexems); 212 | if not CallVisitor.Perform(Item, False) then 213 | begin 214 | raise Exception.CreateFmt(cCallJobError, [Item.JobName]); 215 | end; 216 | AssignParams(Visitor.Params, CallVisitor.Params, cParseLexems); 217 | finally 218 | Visitor.Log.AddStrings(CallVisitor.FullLog); 219 | Visitor.Errors.AddStrings(CallVisitor.FullErrors); 220 | CallVisitor.Free(); 221 | end; 222 | end; 223 | 224 | procedure TCallJobDataItem.Store(ANode: IXMLDOMNode); 225 | var 226 | ChildNode: IXMLDOMNode; 227 | begin 228 | inherited Store(ANode); 229 | 230 | ChildNode := ANode.ownerDocument.createElement('CallJobName'); 231 | ANode.appendChild(ChildNode); 232 | ChildNode.text := FCallJobName; 233 | 234 | ChildNode := ANode.ownerDocument.createElement('CallMediaName'); 235 | ANode.appendChild(ChildNode); 236 | ChildNode.text := FCallMediaName; 237 | end; 238 | 239 | procedure TCallJobDataItem.SetCallJobName(const Value: String); 240 | begin 241 | if (FCallJobName <> Value) then 242 | begin 243 | FCallJobName := Value; 244 | DoDataChanged(); 245 | end; 246 | end; 247 | 248 | function TCallJobDataItem.GetDataState: TJobState; 249 | var 250 | Item: TJobItem; 251 | begin 252 | Result := inherited GetDataState(); 253 | if (Result = jsNormal) then 254 | begin 255 | if (FCallMediaName = '') then //TODO 256 | begin 257 | Item := GetCallJobItem(FCallJobName, ''); 258 | if (Item <> nil) then 259 | begin 260 | if Item.CheckJobState(jsEdited) then 261 | begin 262 | Result := jsEdited; 263 | end else 264 | if Item.CheckJobState(jsRun) then 265 | begin 266 | Result := jsRun; 267 | end; 268 | end; 269 | end; 270 | end; 271 | end; 272 | 273 | function TCallJobDataItem.FindCallJobItem(AJobName: String; AMediaName: String): TJobItem; 274 | begin 275 | Result := GetCallJobItem(AJobName, AMediaName); 276 | if (Result = nil) then 277 | begin 278 | raise Exception.CreateFmt(cCallJobNonExist, [FCallJobName, AMediaName]); 279 | end; 280 | end; 281 | 282 | procedure TCallJobDataItem.InternalSetDataState(const Value: TJobState); 283 | var 284 | Item: TJobItem; 285 | begin 286 | inherited InternalSetDataState(Value); 287 | if (DataState <> jsEdited) then 288 | begin 289 | if (FCallMediaName = '') then //TODO 290 | begin 291 | Item := GetCallJobItem(FCallJobName, ''); 292 | if (Item <> nil) then 293 | begin 294 | Item.SetJobState(Value); 295 | end; 296 | end; 297 | end; 298 | end; 299 | 300 | procedure TCallJobDataItem.SetCallMediaName(const Value: String); 301 | begin 302 | if (FCallMediaName <> Value) then 303 | begin 304 | FCallMediaName := Value; 305 | DoDataChanged(); 306 | end; 307 | end; 308 | 309 | destructor TCallJobDataItem.Destroy; 310 | begin 311 | FCallJobManager.Free(); 312 | inherited Destroy(); 313 | end; 314 | 315 | procedure TCallJobDataItem.GetGlobalParameterList(AList: TJobOperationParams); 316 | begin 317 | inherited GetGlobalParameterList(AList); 318 | AList.Add(cGlobalJobLibPath, NULL); 319 | end; 320 | 321 | procedure TCallJobDataItem.Load(ANode: IXMLDOMNode); 322 | var 323 | ChildNode: IXMLDOMNode; 324 | begin 325 | inherited Load(ANode); 326 | BeginUpdate(); 327 | try 328 | ChildNode := ANode.selectSingleNode('CallJobName'); 329 | if ChildNode <> nil then FCallJobName := ChildNode.text; 330 | 331 | ChildNode := ANode.selectSingleNode('CallMediaName'); 332 | if ChildNode <> nil then FCallMediaName := ChildNode.text; 333 | finally 334 | EndUpdate(); 335 | end; 336 | end; 337 | 338 | procedure TCallJobDataItem.InitData; 339 | begin 340 | inherited InitData(); 341 | FCallJobName := ''; 342 | FCallMediaName := ''; 343 | end; 344 | 345 | initialization 346 | RegisterClass(TCallJobDataItem); 347 | 348 | end. 349 | -------------------------------------------------------------------------------- /src/CallJob/CallJobItemFrm.dfm: -------------------------------------------------------------------------------- 1 | inherited CallJobItemForm: TCallJobItemForm 2 | inherited PageControl: TPageControl 3 | inherited tabDetails: TTabSheet 4 | inherited Panel2: TPanel 5 | Height = 67 6 | ExplicitHeight = 67 7 | object Label2: TLabel [0] 8 | Left = 235 9 | Top = 37 10 | Width = 37 11 | Height = 13 12 | Caption = 'Call Job' 13 | end 14 | object lblProject: TLabel [1] 15 | Left = 235 16 | Top = 16 17 | Width = 33 18 | Height = 13 19 | Caption = 'Project' 20 | end 21 | inherited Navigator: TDBNavigator 22 | Width = 224 23 | VisibleButtons = [nbFirst, nbPrior, nbNext, nbLast, nbEdit, nbPost, nbCancel, nbRefresh] 24 | Hints.Strings = () 25 | ExplicitWidth = 224 26 | end 27 | object cmbCallJob: TComboBox 28 | Left = 281 29 | Top = 34 30 | Width = 192 31 | Height = 21 32 | TabOrder = 2 33 | OnChange = cmbCallJobChange 34 | OnDropDown = cmbCallJobDropDown 35 | end 36 | object edtMediaName: TEdit 37 | Left = 281 38 | Top = 12 39 | Width = 192 40 | Height = 21 41 | TabOrder = 1 42 | OnChange = edtMediaNameChange 43 | end 44 | object btnEditJob: TButton 45 | Left = 477 46 | Top = 33 47 | Width = 23 48 | Height = 23 49 | Caption = '...' 50 | TabOrder = 3 51 | OnClick = btnEditJobClick 52 | end 53 | end 54 | inherited List: TDBGrid 55 | Top = 67 56 | Height = 358 57 | OnKeyDown = ListKeyDown 58 | Columns = < 59 | item 60 | Expanded = False 61 | FieldName = 'paramname' 62 | ReadOnly = True 63 | Title.Caption = 'Parameter Name' 64 | Width = 100 65 | Visible = True 66 | end 67 | item 68 | Expanded = False 69 | FieldName = 'paramvalue' 70 | Title.Caption = 'Parameter Value' 71 | Width = 359 72 | Visible = True 73 | end> 74 | end 75 | end 76 | end 77 | end 78 | -------------------------------------------------------------------------------- /src/CallJob/CallJobItemFrm.pas: -------------------------------------------------------------------------------- 1 | unit CallJobItemFrm; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 | CustomParametersDialog, StdCtrls, ComCtrls, ExtCtrls, CustomDialog, JobClasses, 8 | Db, Grids, DBGrids, DBCtrls, JobCtrls, Datasnap.DBClient, JobMemData; 9 | 10 | type 11 | TCallJobItemForm = class(TCustomParamsJobItemForm) 12 | Label2: TLabel; 13 | cmbCallJob: TComboBox; 14 | btnEditJob: TButton; 15 | edtMediaName: TEdit; 16 | lblProject: TLabel; 17 | procedure cmbCallJobDropDown(Sender: TObject); 18 | procedure cmbCallJobChange(Sender: TObject); 19 | procedure btnEditJobClick(Sender: TObject); 20 | procedure ListKeyDown(Sender: TObject; var Key: Word; 21 | Shift: TShiftState); 22 | procedure edtMediaNameChange(Sender: TObject); 23 | private 24 | procedure DoFillCallJobs; 25 | procedure DoBeforeRefresh(DataSet: TDataSet); 26 | procedure DoEditDefinedJob; 27 | protected 28 | procedure AssignData(IsFromDataItem: Boolean = False); override; 29 | procedure UpdateControls; override; 30 | public 31 | constructor Create(AOwner: TComponent); override; 32 | end; 33 | 34 | TCallJobEditorItem = class(TCustomJobEditorItem) 35 | protected 36 | function GetEditorFormClass: TCustomDialogFormClass; override; 37 | end; 38 | 39 | implementation 40 | 41 | {$R *.DFM} 42 | 43 | uses 44 | CallJobItem, OperationClasses, JobConsts; 45 | 46 | { TCallJobEditorItem } 47 | 48 | function TCallJobEditorItem.GetEditorFormClass: TCustomDialogFormClass; 49 | begin 50 | Result := TCallJobItemForm; 51 | end; 52 | 53 | procedure TCallJobItemForm.DoFillCallJobs(); 54 | var 55 | i: Integer; 56 | JobMgr: TJobManager; 57 | Job: TJobItem; 58 | begin 59 | cmbCallJob.Items.BeginUpdate(); 60 | try 61 | cmbCallJob.Items.Clear(); 62 | JobMgr := TCallJobDataItem(Data).GetJobManager(edtMediaName.Text); 63 | 64 | for i := 0 to JobMgr.RootItemsCount - 1 do 65 | begin 66 | Job := JobMgr.RootItems[i]; 67 | if (Job.Data <> Data) then 68 | begin 69 | cmbCallJob.Items.Add(Job.JobName); 70 | end; 71 | end; 72 | finally 73 | cmbCallJob.Items.EndUpdate(); 74 | end; 75 | end; 76 | 77 | procedure TCallJobItemForm.cmbCallJobDropDown(Sender: TObject); 78 | begin 79 | DoFillCallJobs(); 80 | end; 81 | 82 | procedure TCallJobItemForm.cmbCallJobChange(Sender: TObject); 83 | begin 84 | if IsLoading then Exit; 85 | MemData.Close(); 86 | MemData.Open(); 87 | IsModified := True; 88 | UpdateControls(); 89 | end; 90 | 91 | procedure TCallJobItemForm.AssignData(IsFromDataItem: Boolean); 92 | begin 93 | inherited AssignData(IsFromDataItem); 94 | 95 | if IsFromDataItem then 96 | begin 97 | cmbCallJob.Text := TCallJobDataItem(Data).CallJobName; 98 | edtMediaName.Text := TCallJobDataItem(Data).CallMediaName; 99 | end else 100 | begin 101 | TCallJobDataItem(Data).CallJobName := cmbCallJob.Text; 102 | TCallJobDataItem(Data).CallMediaName := edtMediaName.Text; 103 | end; 104 | end; 105 | 106 | procedure TCallJobItemForm.DoBeforeRefresh(DataSet: TDataSet); 107 | var 108 | AJob: TJobItem; 109 | Params: TJobOperationParams; 110 | begin 111 | if IsLoading or (cmbCallJob.Text = '') then Exit; 112 | AJob := TCallJobDataItem(Data).GetCallJobItem(cmbCallJob.Text, edtMediaName.Text); 113 | 114 | if (AJob <> nil) then 115 | begin 116 | Params := TJobOperationParams.Create(); 117 | try 118 | AJob.Data.GetParameterList(Params); 119 | LoadMemData(Params, True); 120 | IsModified := True; 121 | finally 122 | Params.Free(); 123 | end; 124 | end else 125 | begin 126 | MemData.Close(); 127 | MemData.Open(); 128 | end; 129 | end; 130 | 131 | constructor TCallJobItemForm.Create(AOwner: TComponent); 132 | begin 133 | inherited Create(AOwner); 134 | MemData.BeforeRefresh := DoBeforeRefresh; 135 | end; 136 | 137 | procedure TCallJobItemForm.UpdateControls; 138 | begin 139 | inherited UpdateControls(); 140 | btnEditJob.Enabled := (cmbCallJob.Text <> ''); 141 | cmbCallJob.Enabled := not ReadOnly; 142 | end; 143 | 144 | procedure TCallJobItemForm.DoEditDefinedJob(); 145 | var 146 | AJob: TJobItem; 147 | AMediaName, AName: String; 148 | begin 149 | AMediaName := edtMediaName.Text; 150 | AName := cmbCallJob.Text; 151 | AJob := TCallJobDataItem(Data).FindCallJobItem(AName, AMediaName); 152 | TCallJobDataItem(Data).GetJobManager(AMediaName).EditJobItem(AJob, AMediaName <> ''); 153 | end; 154 | 155 | procedure TCallJobItemForm.btnEditJobClick(Sender: TObject); 156 | begin 157 | DoEditDefinedJob(); 158 | end; 159 | 160 | procedure TCallJobItemForm.ListKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); 161 | begin 162 | inherited; 163 | if (not (Sender as TDBGrid).EditorMode and (Key in [VK_DELETE, VK_INSERT])) 164 | or ((Key = VK_DOWN) and (MemData.RecNo = MemData.RecordCount)) then 165 | begin 166 | Key := 0; 167 | end; 168 | end; 169 | 170 | procedure TCallJobItemForm.edtMediaNameChange(Sender: TObject); 171 | begin 172 | if IsLoading then Exit; 173 | IsModified := True; 174 | cmbCallJob.Clear(); 175 | end; 176 | 177 | initialization 178 | RegisterEditorItem(TCallJobEditorItem, TCallJobDataItem, 'Call Job'); 179 | 180 | end. 181 | -------------------------------------------------------------------------------- /src/Classes/JobConsts.pas: -------------------------------------------------------------------------------- 1 | unit JobConsts; 2 | 3 | interface 4 | 5 | type 6 | TFlowAction = (faComplete, faSuccess, faFailure, faDisable, faFailThrow, faCompleteThrow); 7 | TJobRunState = (jsStarted, jsDone, jsFailed, jsWaiting, jsDisabled); 8 | TJobListBindType = (btAND, btOR); 9 | TScripterLanguage = (slPascalScript, slJavaScript); 10 | TSQLPerformWith = (spOSQLUtilite, spADOLibrary); 11 | 12 | const 13 | cGlobalJobLibPath = 'JOBLIBRARYPATH'; 14 | cJobDeskTopFileName = 'TaskRunner.dsw'; 15 | cJobGlobalParamsFileName = 'TaskRunner.prm'; 16 | cParseLexems = ':'; 17 | cWordDelimiters = #32; 18 | 19 | cGlobalParamsParseLexems = '@@'; 20 | cCommandBatchParseLexems = '::'; 21 | cCommandBatchWordDelimiters = #32 + '='; 22 | 23 | cSQLScriptWordDelimiters = #32 + '[]''"'; 24 | 25 | cPascalScriptParams = 'JobParams'; 26 | cPascalScriptJobLog = 'JobLog'; 27 | cPascalScriptParseLexems = 'etParam('''; 28 | cPascalScriptWordDelimiters = ''''; 29 | 30 | cJavaScriptParams = 'jobParams'; 31 | cJavaScriptJobLog = 'jobLog'; 32 | cJavaScriptParseLexems = 'etParam("'; 33 | cJavaScriptWordDelimiters = '"'; 34 | 35 | cNOClause = 'NO'; 36 | cScriptClause = 'SCRIPT'; 37 | cSQlErrorWords: array[0..1] of string = ('Msg', 'Level'); 38 | 39 | const 40 | cFlowActionNames: array[TFlowAction] of string = ('Complete', 'Success', 'Failure', 'Disable', 41 | 'Fail&Throw', 'Complete&Throw'); 42 | cJobStateNames: array[TJobRunState] of string = ('Started', 'Done', 'Failed', 'Waiting', 'Disabled'); 43 | cJobListBindTypeNames: array[TJobListBindType] of string = ('AND', 'OR'); 44 | 45 | cScripterLanguages: array[TScripterLanguage] of string = ('PascalScript', 'JavaScript'); 46 | 47 | cSQLPerformWithNames: array[TSQLPerformWith] of string = ( 48 | 'OSQL Utilite', 'OLE DB'); 49 | 50 | cStoreFlowActionNames: array[TFlowAction] of string = ('Complete', 'Success', 'Failure', 'Disable', 51 | 'FailThrow', 'CompleteThrow'); 52 | cStoreBindTypeNames: array[TJobListBindType] of string = ('and', 'or'); 53 | cStoreBoolean: array[Boolean] of string = ('No', 'Yes'); 54 | cStoreSQLPerformWithNames: array[TSQLPerformWith] of string = ( 55 | 'OSQLUtilite', 'ADOLibrary'); 56 | 57 | resourcestring 58 | cGlobalParamsEditor = 'Global Parameters Editor'; 59 | 60 | cMediaModified = 'The project has been modified, do you want to save your changes?'; 61 | cCallJobNonExist = 'The call job ''%s'' does not exist within the ''%s'' project'; 62 | cJobDataLocked = 'The job has been modified or run'; 63 | cJobLocked = 'Some jobs have been modified or run'; 64 | cJobModified = 'Some jobs have been modified'; 65 | cJobNotFound = 'The job is not found in the job list'; 66 | cJobAlreadyRun = 'The job is already run'; 67 | cJobRunning = 'The job is run, cannot modify'; 68 | cPerformanceStopped = 'The job performance was stopped'; 69 | cNonRegisteredEditor = 'The editor for this job is not registered'; 70 | cJobModifiedQuery = 'The job has been modified, do you wish to apply your changes?'; 71 | cParameterAdded = 'The job parameter ''%s'' has been added with value = ''%s'''; 72 | cParameterReplaced = 'The job parameter ''%s'' has been replaced with value = ''%s'''; 73 | cJobLogInFile = 'The job log is in ''%s'' file'; 74 | cJobPerformMessage = 'Job name: %s ============================================='; 75 | cNewJobItemName = 'New %s Item'; 76 | cCallJobError = 'An error occured while running the ''%s'' job'; 77 | cJobDisabled = 'The job ''%s'' is disabled'; 78 | 79 | cCreateError = 'Cannot create ''%s'''; 80 | cDeleteError = 'Cannot delete ''%s'''; 81 | cCannotRunFile = 'Cannot run the file ''%s'', GetLastError = %d'; 82 | cFileNameEmpty = '%s file name is empty'; 83 | cFileNotExists = 'The file ''%s'' does not exist'; 84 | cUnkmownImportJobFile = 'Unknown import job file ''%s'''; 85 | cUnknownImportMediaFile = 'Unknown import project file ''%s'''; 86 | cLoadError = 'Loading error'; 87 | 88 | cScriptError = 'The script engine was returned with some errors, see the error log'; 89 | cJobSkipped = 'The execution of the ''%s'' job was skipped due to the ''Can Perform'' condition'; 90 | cCommandLineDescr = 'Command Line to Run: %s'; 91 | 92 | cScriptSetParamError = '''setParam'' accepts two string parameters'; 93 | cScriptGetParamError = '''getParam'' accepts one string parameter'; 94 | cScriptAddLogError = '''add'' accepts one string parameter'; 95 | 96 | const 97 | cCursorPositionMask = 'Ln %s, Col %s'; 98 | cMinDskEditorsCount = 10; 99 | cMinDskMediaCount = 5; 100 | 101 | cCtrlShiftS = 24659; 102 | 103 | implementation 104 | 105 | end. 106 | -------------------------------------------------------------------------------- /src/CommandJob/CommandBatchJobItem.pas: -------------------------------------------------------------------------------- 1 | unit CommandBatchJobItem; 2 | 3 | interface 4 | 5 | uses 6 | Classes, JobClasses, sysutils, CustomJobItems, JobUtils; 7 | 8 | type 9 | TCommandBatchDataItem = class(TCustomScriptJobDataItem) 10 | private 11 | FJobUtilities: TJobUtilities; 12 | protected 13 | function GetParseLexems: String; override; 14 | function GetWordDelimiters: String; override; 15 | public 16 | constructor Create(AOwner: TJobItem); override; 17 | destructor Destroy; override; 18 | procedure Perform(Visitor: TJobVisitor); override; 19 | end; 20 | 21 | implementation 22 | 23 | uses 24 | JobConsts; 25 | 26 | { TCommandBatchDataItem } 27 | 28 | constructor TCommandBatchDataItem.Create(AOwner: TJobItem); 29 | begin 30 | inherited Create(AOwner); 31 | FJobUtilities := TJobUtilities.Create(); 32 | end; 33 | 34 | destructor TCommandBatchDataItem.Destroy; 35 | begin 36 | FJobUtilities.Free(); 37 | inherited Destroy(); 38 | end; 39 | 40 | function TCommandBatchDataItem.GetParseLexems: String; 41 | begin 42 | Result := cCommandBatchParseLexems; 43 | end; 44 | 45 | function TCommandBatchDataItem.GetWordDelimiters: String; 46 | begin 47 | Result := cCommandBatchWordDelimiters; 48 | end; 49 | 50 | procedure TCommandBatchDataItem.Perform(Visitor: TJobVisitor); 51 | var 52 | AOutput, AErrors: TStrings; 53 | begin 54 | inherited Perform(Visitor); 55 | AOutput := TStringList.Create(); 56 | AErrors := TStringList.Create(); 57 | try 58 | //TODO for run from file 59 | FJobUtilities.PerformCmdFile(Script, AOutput, AErrors); 60 | CheckForErrorsInLog(AOutput); 61 | finally 62 | Visitor.Log.AddStrings(AOutput); 63 | Visitor.Errors.AddStrings(AErrors); 64 | AErrors.Free(); 65 | AOutput.Free(); 66 | end; 67 | end; 68 | 69 | initialization 70 | RegisterClass(TCommandBatchDataItem); 71 | 72 | end. 73 | -------------------------------------------------------------------------------- /src/CommandJob/CommandBatchJobItemFrm.dfm: -------------------------------------------------------------------------------- 1 | inherited CommandBatchJobItemForm: TCommandBatchJobItemForm 2 | inherited PageControl: TPageControl 3 | inherited tabDetails: TTabSheet 4 | inherited sbScript: TStatusBar 5 | Panels = < 6 | item 7 | Alignment = taRightJustify 8 | Text = 'Ln 1, Col 1' 9 | Width = 10 10 | end> 11 | end 12 | end 13 | end 14 | end 15 | -------------------------------------------------------------------------------- /src/CommandJob/CommandBatchJobItemFrm.pas: -------------------------------------------------------------------------------- 1 | unit CommandBatchJobItemFrm; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 | CustomScriptDialog, CustomDialog, StdCtrls, ComCtrls, ExtCtrls, JobClasses, 8 | JobCtrls; 9 | 10 | type 11 | TCommandBatchJobItemForm = class(TCustomScriptJobItemForm) 12 | protected 13 | procedure UpdateControls; override; 14 | end; 15 | 16 | TCommandBatchJobEditorItem = class(TCustomJobEditorItem) 17 | protected 18 | function GetEditorFormClass: TCustomDialogFormClass; override; 19 | end; 20 | 21 | implementation 22 | 23 | {$R *.DFM} 24 | 25 | uses 26 | CommandBatchJobItem; 27 | 28 | { TCommandBatchJobItem } 29 | 30 | function TCommandBatchJobEditorItem.GetEditorFormClass: TCustomDialogFormClass; 31 | begin 32 | Result := TCommandBatchJobItemForm; 33 | end; 34 | 35 | { TCommandBatchJobItemForm } 36 | 37 | procedure TCommandBatchJobItemForm.UpdateControls; 38 | begin 39 | inherited UpdateControls(); 40 | EnableControl(edtScriptFile, False); 41 | EnableControl(edtLogFile, False); 42 | chkScriptFile.Enabled := False; 43 | chkLogFile.Enabled := False; 44 | end; 45 | 46 | initialization 47 | RegisterEditorItem(TCommandBatchJobEditorItem, TCommandBatchDataItem, 'Command Batch'); 48 | 49 | end. 50 | -------------------------------------------------------------------------------- /src/ConnectionSetup/ConnectionSetup.dfm: -------------------------------------------------------------------------------- 1 | inherited ConnectionSetupForm: TConnectionSetupForm 2 | Left = 266 3 | Top = 105 4 | BorderStyle = bsDialog 5 | Caption = 'Connection Setup' 6 | ClientHeight = 206 7 | ClientWidth = 352 8 | OldCreateOrder = False 9 | Position = poOwnerFormCenter 10 | OnCreate = FormCreate 11 | OnShow = FormShow 12 | ExplicitWidth = 358 13 | ExplicitHeight = 235 14 | PixelsPerInch = 96 15 | TextHeight = 13 16 | object Label1: TLabel 17 | Left = 5 18 | Top = 11 19 | Width = 26 20 | Height = 13 21 | Caption = 'Login' 22 | end 23 | object Label2: TLabel 24 | Left = 5 25 | Top = 33 26 | Width = 46 27 | Height = 13 28 | Caption = 'Password' 29 | end 30 | object Label3: TLabel 31 | Left = 5 32 | Top = 55 33 | Width = 31 34 | Height = 13 35 | Caption = 'Server' 36 | end 37 | object Label4: TLabel 38 | Left = 5 39 | Top = 77 40 | Width = 46 41 | Height = 13 42 | Caption = 'Database' 43 | end 44 | object Label5: TLabel 45 | Left = 5 46 | Top = 99 47 | Width = 43 48 | Height = 13 49 | Caption = 'Time Out' 50 | end 51 | object edtLogin: TEdit 52 | Left = 65 53 | Top = 8 54 | Width = 278 55 | Height = 21 56 | TabOrder = 0 57 | end 58 | object edtPassword: TEdit 59 | Left = 65 60 | Top = 30 61 | Width = 278 62 | Height = 21 63 | PasswordChar = '*' 64 | TabOrder = 1 65 | OnChange = edtPasswordChange 66 | end 67 | object edtServer: TEdit 68 | Left = 65 69 | Top = 52 70 | Width = 278 71 | Height = 21 72 | TabOrder = 2 73 | OnChange = edtServerChange 74 | end 75 | object edtDatabase: TComboBox 76 | Left = 65 77 | Top = 74 78 | Width = 278 79 | Height = 21 80 | TabOrder = 3 81 | OnDropDown = edtDatabaseDropDown 82 | end 83 | object btnOK: TButton 84 | Left = 196 85 | Top = 176 86 | Width = 72 87 | Height = 22 88 | Caption = 'OK' 89 | Default = True 90 | ModalResult = 1 91 | TabOrder = 8 92 | end 93 | object btnCancel: TButton 94 | Left = 272 95 | Top = 176 96 | Width = 72 97 | Height = 22 98 | Cancel = True 99 | Caption = 'Cancel' 100 | ModalResult = 2 101 | TabOrder = 9 102 | end 103 | object edtTimeOut: TEdit 104 | Left = 65 105 | Top = 96 106 | Width = 278 107 | Height = 21 108 | TabOrder = 4 109 | end 110 | object edtOLEDB: TEdit 111 | Left = 65 112 | Top = 145 113 | Width = 253 114 | Height = 21 115 | TabOrder = 6 116 | end 117 | object chkUseOLEDB: TCheckBox 118 | Left = 5 119 | Top = 126 120 | Width = 129 121 | Height = 17 122 | Caption = 'Use OLE DB Provider' 123 | TabOrder = 5 124 | OnClick = chkUseOLEDBClick 125 | end 126 | object btnBuildOLEDB: TButton 127 | Left = 320 128 | Top = 145 129 | Width = 23 130 | Height = 21 131 | Caption = '...' 132 | TabOrder = 7 133 | OnClick = btnBuildOLEDBClick 134 | end 135 | end 136 | -------------------------------------------------------------------------------- /src/ConnectionSetup/ConnectionSetup.pas: -------------------------------------------------------------------------------- 1 | unit ConnectionSetup; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, System.SysUtils, System.Variants, System.Classes, Graphics, Controls, Forms, Dialogs, 7 | StdCtrls, Mask, ComCtrls, JobUtils, CustomModalDlg, JobConsts; 8 | 9 | type 10 | TConnectionSetupForm = class(TCustomModalDialog) 11 | edtLogin: TEdit; 12 | edtPassword: TEdit; 13 | edtServer: TEdit; 14 | edtDatabase: TComboBox; 15 | Label1: TLabel; 16 | Label2: TLabel; 17 | Label3: TLabel; 18 | Label4: TLabel; 19 | btnOK: TButton; 20 | btnCancel: TButton; 21 | edtTimeOut: TEdit; 22 | Label5: TLabel; 23 | edtOLEDB: TEdit; 24 | chkUseOLEDB: TCheckBox; 25 | btnBuildOLEDB: TButton; 26 | procedure edtDatabaseDropDown(Sender: TObject); 27 | procedure edtServerChange(Sender: TObject); 28 | procedure edtPasswordChange(Sender: TObject); 29 | procedure FormCreate(Sender: TObject); 30 | procedure chkUseOLEDBClick(Sender: TObject); 31 | procedure FormShow(Sender: TObject); 32 | procedure btnBuildOLEDBClick(Sender: TObject); 33 | private 34 | FSection: Boolean; 35 | FReadOnly: Boolean; 36 | procedure SetReadOnly(const Value: Boolean); 37 | procedure GetSQLDatabasesList(AServer, ALogin, APassword: String; List: TStrings); 38 | procedure UpdateControls; 39 | protected 40 | property ReadOnly: Boolean read FReadOnly write SetReadOnly; 41 | end; 42 | 43 | function ShowConnectionSetup(Info: TSQLConnectionInfo; AReadOnly: Boolean; 44 | var APerformWith: TSQLPerformWith): Boolean; 45 | 46 | implementation 47 | 48 | {$R *.DFM} 49 | 50 | uses 51 | ADODB, JobCtrls; 52 | 53 | function ShowConnectionSetup(Info: TSQLConnectionInfo; AReadOnly: Boolean; 54 | var APerformWith: TSQLPerformWith): Boolean; 55 | var 56 | Dlg: TConnectionSetupForm; 57 | begin 58 | Dlg := TConnectionSetupForm.Create(nil); 59 | try 60 | Dlg.edtLogin.Text := Info.User; 61 | Dlg.edtPassword.Text := Info.Password; 62 | Dlg.edtServer.Text := Info.Server; 63 | Dlg.edtDatabase.Text := Info.Database; 64 | Dlg.edtTimeOut.Text := Info.TimeOut; 65 | Dlg.edtOLEDB.Text := Info.ConnectionString; 66 | Dlg.chkUseOLEDB.Checked := (APerformWith = spADOLibrary); 67 | Dlg.ReadOnly := AReadOnly; 68 | 69 | Result := (Dlg.ShowModal() = mrOK) and (not AReadOnly); 70 | 71 | if Result then 72 | begin 73 | Info.User := Dlg.edtLogin.Text; 74 | Info.Password := Dlg.edtPassword.Text; 75 | Info.Server := Dlg.edtServer.Text; 76 | Info.Database := Dlg.edtDatabase.Text; 77 | Info.TimeOut := Dlg.edtTimeOut.Text; 78 | Info.ConnectionString := Dlg.edtOLEDB.Text; 79 | if Dlg.chkUseOLEDB.Checked then 80 | begin 81 | APerformWith := spADOLibrary; 82 | end else 83 | begin 84 | APerformWith := spOSQLUtilite; 85 | end; 86 | end; 87 | finally 88 | Dlg.Free(); 89 | end; 90 | end; 91 | 92 | { TConnectionSetupForm } 93 | 94 | procedure TConnectionSetupForm.GetSQLDatabasesList(AServer, ALogin, 95 | APassword: String; List: TStrings); 96 | var 97 | Connection: TADOConnection; 98 | RS: _RecordSet; 99 | Info: TSQLConnectionInfo; 100 | begin 101 | List.Clear(); 102 | Connection := TADOConnection.Create(nil); 103 | try 104 | Connection.LoginPrompt := False; 105 | Info := TSQLConnectionInfo.Create(); 106 | try 107 | Info.User := ALogin; 108 | Info.Password := APassword; 109 | Info.Database := 'master'; 110 | Info.Server := AServer; 111 | Connection.ConnectionString := Info.CreateConnectionString(); 112 | finally 113 | Info.Free(); 114 | end; 115 | Connection.Connected := True; 116 | RS := Connection.Execute('select name from sysdatabases order by name'); 117 | 118 | RS.MoveFirst(); 119 | while (not RS.EOF) do 120 | begin 121 | List.Add(VarToStr(RS.Fields['name'].Value)); 122 | RS.MoveNext(); 123 | end; 124 | finally 125 | RS := nil; 126 | Connection.Free(); 127 | end; 128 | end; 129 | 130 | procedure TConnectionSetupForm.edtDatabaseDropDown(Sender: TObject); 131 | begin 132 | if (edtDatabase.Items.Count > 0) then Exit; 133 | 134 | try 135 | GetSQLDatabasesList(edtServer.Text, edtLogin.Text, edtPassword.Text, edtDatabase.Items); 136 | except 137 | end; 138 | end; 139 | 140 | procedure TConnectionSetupForm.edtServerChange(Sender: TObject); 141 | begin 142 | edtDatabase.Text := ''; 143 | edtDatabase.Items.Clear(); 144 | end; 145 | 146 | procedure TConnectionSetupForm.SetReadOnly(const Value: Boolean); 147 | begin 148 | if (FReadOnly <> Value) then 149 | begin 150 | FReadOnly := Value; 151 | UpdateControls(); 152 | end; 153 | end; 154 | 155 | procedure TConnectionSetupForm.edtPasswordChange(Sender: TObject); 156 | var 157 | s: string; 158 | FStart, FEnd: integer; 159 | begin 160 | if FSection then Exit; 161 | FSection := True; 162 | try 163 | s := edtPassword.Text; 164 | SendMessage(edtPassword.Handle, EM_GETSEL, WPARAM(@FStart), LPARAM(@FEnd)); 165 | if (s <> '') and (s[1] = ':') then 166 | begin 167 | edtPassword.PasswordChar := #0; 168 | end else 169 | begin 170 | edtPassword.PasswordChar := '*'; 171 | end; 172 | SendMessage(edtPassword.Handle, EM_SETSEL, WPARAM(WORD(FStart)), LPARAM(WORD(FEnd))); 173 | finally 174 | FSection := False; 175 | end; 176 | end; 177 | 178 | procedure TConnectionSetupForm.FormCreate(Sender: TObject); 179 | begin 180 | inherited; 181 | FSection := False; 182 | end; 183 | 184 | procedure TConnectionSetupForm.UpdateControls; 185 | var 186 | IsOLEDB: Boolean; 187 | begin 188 | IsOLEDB := chkUseOLEDB.Checked; 189 | chkUseOLEDB.Enabled := not FReadOnly; 190 | 191 | EnableControl(edtLogin, not IsOLEDB); 192 | EnableControl(edtPassword, not IsOLEDB); 193 | EnableControl(edtServer, not IsOLEDB); 194 | EnableControl(edtDatabase, not IsOLEDB); 195 | EnableControl(edtTimeOut, not IsOLEDB); 196 | EnableControl(edtOLEDB, IsOLEDB); 197 | btnBuildOLEDB.Enabled := IsOLEDB; 198 | if IsOLEDB then 199 | begin 200 | edtOLEDB.ReadOnly := FReadOnly; 201 | btnBuildOLEDB.Enabled := not FReadOnly; 202 | end else 203 | begin 204 | edtLogin.ReadOnly := FReadOnly; 205 | edtPassword.ReadOnly := FReadOnly; 206 | edtServer.ReadOnly := FReadOnly; 207 | edtDatabase.Enabled := not FReadOnly; 208 | edtTimeOut.ReadOnly := FReadOnly; 209 | end; 210 | end; 211 | 212 | procedure TConnectionSetupForm.chkUseOLEDBClick(Sender: TObject); 213 | begin 214 | UpdateControls(); 215 | end; 216 | 217 | procedure TConnectionSetupForm.FormShow(Sender: TObject); 218 | begin 219 | inherited; 220 | UpdateControls(); 221 | end; 222 | 223 | procedure TConnectionSetupForm.btnBuildOLEDBClick(Sender: TObject); 224 | begin 225 | edtOLEDB.Text := PromptDataSource(Handle, edtOLEDB.Text); 226 | end; 227 | 228 | end. 229 | -------------------------------------------------------------------------------- /src/CustomForms/CustomModalDlg.dfm: -------------------------------------------------------------------------------- 1 | object CustomModalDialog: TCustomModalDialog 2 | Left = 360 3 | Top = 176 4 | Width = 320 5 | Height = 240 6 | Color = clBtnFace 7 | Font.Charset = DEFAULT_CHARSET 8 | Font.Color = clWindowText 9 | Font.Height = -11 10 | Font.Name = 'MS Sans Serif' 11 | Font.Style = [] 12 | OldCreateOrder = True 13 | PixelsPerInch = 96 14 | TextHeight = 13 15 | end 16 | -------------------------------------------------------------------------------- /src/CustomForms/CustomModalDlg.pas: -------------------------------------------------------------------------------- 1 | unit CustomModalDlg; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Classes, Controls, Forms; 7 | 8 | type 9 | TCustomModalDialog = class(TForm) 10 | protected 11 | procedure CreateParams(var Params: TCreateParams); override; 12 | end; 13 | 14 | implementation 15 | 16 | {$R *.dfm} 17 | 18 | { TCustomModalDialog } 19 | 20 | procedure TCustomModalDialog.CreateParams(var Params: TCreateParams); 21 | var 22 | hwnd: THandle; 23 | begin 24 | inherited CreateParams(Params); 25 | if (Screen.ActiveCustomForm <> nil) then 26 | begin 27 | hwnd := Screen.ActiveCustomForm.Handle; 28 | end else 29 | begin 30 | hwnd := 0; 31 | end; 32 | Params.WndParent := hwnd; 33 | end; 34 | 35 | end. -------------------------------------------------------------------------------- /src/CustomJob/CustomDialog.dfm: -------------------------------------------------------------------------------- 1 | object CustomDialogForm: TCustomDialogForm 2 | Left = 0 3 | Top = 0 4 | Width = 532 5 | Height = 451 6 | Font.Charset = DEFAULT_CHARSET 7 | Font.Color = clWindowText 8 | Font.Height = -11 9 | Font.Name = 'MS Sans Serif' 10 | Font.Style = [] 11 | ParentFont = False 12 | TabOrder = 0 13 | object PageControl: TPageControl 14 | Left = 0 15 | Top = 0 16 | Width = 532 17 | Height = 451 18 | ActivePage = tabAddition 19 | Align = alClient 20 | TabOrder = 0 21 | TabPosition = tpBottom 22 | object tabDetails: TTabSheet 23 | Caption = 'Details' 24 | ExplicitLeft = 0 25 | ExplicitTop = 0 26 | ExplicitWidth = 0 27 | ExplicitHeight = 341 28 | end 29 | object tabAddition: TTabSheet 30 | Caption = 'Addition' 31 | ImageIndex = 1 32 | ExplicitLeft = 0 33 | ExplicitTop = 0 34 | ExplicitWidth = 0 35 | ExplicitHeight = 0 36 | object pAddTop: TPanel 37 | Left = 0 38 | Top = 0 39 | Width = 524 40 | Height = 47 41 | Align = alTop 42 | BevelOuter = bvNone 43 | TabOrder = 0 44 | object Label1: TLabel 45 | Left = 6 46 | Top = 16 47 | Width = 55 48 | Height = 13 49 | Caption = 'Flow Action' 50 | end 51 | object lblCanPerform: TLabel 52 | Left = 258 53 | Top = 16 54 | Width = 58 55 | Height = 13 56 | Caption = 'Can Perform' 57 | end 58 | object cmbFlowAction: TJobComboBox 59 | Left = 76 60 | Top = 12 61 | Width = 145 62 | Height = 21 63 | Style = csDropDownList 64 | TabOrder = 0 65 | OnChange = AdditionDataChange 66 | OnCloseUp = AdditionDataChange 67 | end 68 | object edtCanPerform: TEdit 69 | Left = 328 70 | Top = 12 71 | Width = 145 72 | Height = 21 73 | TabOrder = 1 74 | OnChange = AdditionDataChange 75 | end 76 | end 77 | object MemoDescription: TJobRichEdit 78 | Left = 0 79 | Top = 47 80 | Width = 524 81 | Height = 359 82 | Align = alClient 83 | Font.Charset = RUSSIAN_CHARSET 84 | Font.Color = clWindowText 85 | Font.Height = -13 86 | Font.Name = 'MS Sans Serif' 87 | Font.Style = [] 88 | Lines.Strings = ( 89 | 'MemoDescription') 90 | ParentFont = False 91 | PlainText = True 92 | ScrollBars = ssBoth 93 | TabOrder = 1 94 | WantTabs = True 95 | WordWrap = False 96 | Zoom = 100 97 | OnChange = AdditionDataChange 98 | OnSelectionChange = MemoDescriptionSelectionChange 99 | end 100 | object sbDescription: TStatusBar 101 | Left = 0 102 | Top = 406 103 | Width = 524 104 | Height = 19 105 | Panels = < 106 | item 107 | Alignment = taRightJustify 108 | Text = 'Ln 1, Col 1' 109 | Width = 50 110 | end> 111 | end 112 | end 113 | end 114 | end 115 | -------------------------------------------------------------------------------- /src/CustomJob/CustomParametersDialog.dfm: -------------------------------------------------------------------------------- 1 | inherited CustomParamsJobItemForm: TCustomParamsJobItemForm 2 | inherited PageControl: TPageControl 3 | ActivePage = tabDetails 4 | inherited tabDetails: TTabSheet 5 | ExplicitLeft = 4 6 | ExplicitTop = 4 7 | ExplicitWidth = 524 8 | ExplicitHeight = 425 9 | object Panel2: TPanel 10 | Left = 0 11 | Top = 0 12 | Width = 524 13 | Height = 47 14 | Align = alTop 15 | BevelOuter = bvNone 16 | TabOrder = 0 17 | object Navigator: TDBNavigator 18 | Left = 0 19 | Top = 10 20 | Width = 234 21 | Height = 25 22 | DataSource = DataSource 23 | VisibleButtons = [nbFirst, nbPrior, nbNext, nbLast, nbInsert, nbDelete, nbEdit, nbPost, nbCancel] 24 | ConfirmDelete = False 25 | TabOrder = 0 26 | end 27 | end 28 | object List: TDBGrid 29 | Left = 0 30 | Top = 47 31 | Width = 524 32 | Height = 378 33 | Align = alClient 34 | DataSource = DataSource 35 | Options = [dgEditing, dgTitles, dgIndicator, dgColumnResize, dgColLines, dgRowLines, dgTabs, dgCancelOnExit] 36 | TabOrder = 1 37 | TitleFont.Charset = DEFAULT_CHARSET 38 | TitleFont.Color = clWindowText 39 | TitleFont.Height = -11 40 | TitleFont.Name = 'MS Sans Serif' 41 | TitleFont.Style = [] 42 | Columns = < 43 | item 44 | Expanded = False 45 | FieldName = 'paramname' 46 | Title.Caption = 'Parameter Name' 47 | Width = 100 48 | Visible = True 49 | end 50 | item 51 | Expanded = False 52 | FieldName = 'paramvalue' 53 | Title.Caption = 'Parameter Value' 54 | Width = 356 55 | Visible = True 56 | end> 57 | end 58 | end 59 | inherited tabAddition: TTabSheet 60 | ExplicitLeft = 4 61 | ExplicitTop = 4 62 | ExplicitWidth = 524 63 | ExplicitHeight = 425 64 | end 65 | end 66 | object DataSource: TDataSource 67 | DataSet = MemData 68 | OnStateChange = DataSourceStateChange 69 | Left = 178 70 | Top = 152 71 | end 72 | object MemData: TJobMemData 73 | Aggregates = <> 74 | Params = <> 75 | AfterDelete = MemDataAfterDelete 76 | Left = 248 77 | Top = 152 78 | object MemDataparamname: TStringField 79 | FieldName = 'paramname' 80 | Size = 150 81 | end 82 | object MemDataparamvalue: TStringField 83 | FieldName = 'paramvalue' 84 | Size = 150 85 | end 86 | end 87 | end 88 | -------------------------------------------------------------------------------- /src/CustomJob/CustomParametersDialog.pas: -------------------------------------------------------------------------------- 1 | unit CustomParametersDialog; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Classes, System.Variants, Graphics, Controls, Forms, Dialogs, 7 | CustomDialog, StdCtrls, ComCtrls, ExtCtrls, JobClasses, Grids, DBGrids, 8 | DBCtrls, Db, OperationClasses, JobCtrls, Datasnap.DBClient, 9 | JobMemData; 10 | 11 | type 12 | TCustomParamsJobItemForm = class(TCustomDialogForm) 13 | Panel2: TPanel; 14 | List: TDBGrid; 15 | Navigator: TDBNavigator; 16 | DataSource: TDataSource; 17 | MemData: TJobMemData; 18 | MemDataparamname: TStringField; 19 | MemDataparamvalue: TStringField; 20 | procedure DataSourceStateChange(Sender: TObject); 21 | procedure FormKeyDown(Sender: TObject; var Key: Word; 22 | Shift: TShiftState); 23 | procedure MemDataAfterDelete(DataSet: TDataSet); 24 | protected 25 | procedure LoadMemData(AParams: TJobOperationParams; IsAppend: Boolean = False; NeedDelete: Boolean = True); 26 | procedure StoreMemData(AParams: TJobOperationParams); 27 | procedure AssignData(IsFromDataItem: Boolean = False); override; 28 | procedure UpdateControls; override; 29 | end; 30 | 31 | implementation 32 | 33 | {$R *.DFM} 34 | 35 | uses 36 | CustomJobItems; 37 | 38 | procedure TCustomParamsJobItemForm.AssignData(IsFromDataItem: Boolean); 39 | begin 40 | inherited AssignData(IsFromDataItem); 41 | 42 | if IsFromDataItem then 43 | begin 44 | LoadMemData(TCustomParametersJobDataItem(Data).Parameters); 45 | end else 46 | begin 47 | StoreMemData(TCustomParametersJobDataItem(Data).Parameters); 48 | end; 49 | end; 50 | 51 | procedure TCustomParamsJobItemForm.LoadMemData(AParams: TJobOperationParams; IsAppend: Boolean = False; 52 | NeedDelete: Boolean = True); 53 | var 54 | i: Integer; 55 | Param: TJobOperationParam; 56 | IsReadOnly: Boolean; 57 | begin 58 | MemData.DisableControls(); 59 | IsReadOnly := MemData.ReadOnly; 60 | try 61 | MemData.ReadOnly := False; 62 | if not IsAppend then 63 | begin 64 | MemData.Close(); 65 | end; 66 | MemData.Open(); 67 | 68 | for i := 0 to AParams.Count - 1 do 69 | begin 70 | Param := AParams.Items[i]; 71 | 72 | if not (IsAppend and MemData.Locate('paramname', Param.Name, [])) then 73 | begin 74 | MemData.Append(); 75 | try 76 | MemDataparamname.AsString := Param.Name; 77 | MemDataparamvalue.AsString := VarToStr(Param.Value); 78 | MemData.Post(); 79 | except 80 | MemData.Cancel(); 81 | raise; 82 | end; 83 | end; 84 | end; 85 | 86 | if IsAppend and NeedDelete then 87 | begin 88 | MemData.First(); 89 | while not MemData.Eof do 90 | begin 91 | if (AParams.FindParam(MemDataparamname.AsString) = nil) then 92 | begin 93 | MemData.Delete(); 94 | end else 95 | begin 96 | MemData.Next(); 97 | end; 98 | end; 99 | end; 100 | finally 101 | MemData.ReadOnly := IsReadOnly; 102 | MemData.EnableControls(); 103 | end; 104 | end; 105 | 106 | procedure TCustomParamsJobItemForm.StoreMemData(AParams: TJobOperationParams); 107 | var 108 | bm: TBookMark; 109 | begin 110 | if (MemData.State in dsEditModes) then 111 | begin 112 | MemData.Post(); 113 | end; 114 | 115 | MemData.DisableControls(); 116 | try 117 | if MemData.Active then 118 | begin 119 | bm := MemData.GetBookmark; 120 | end else 121 | begin 122 | bm := nil; 123 | end; 124 | 125 | AParams.Clear(); 126 | 127 | MemData.First(); 128 | while not MemData.Eof do 129 | begin 130 | AParams.Add(MemDataparamname.AsString, MemDataparamvalue.AsString); 131 | MemData.Next(); 132 | end; 133 | 134 | if (bm <> nil) then 135 | begin 136 | if MemData.BookmarkValid(bm) then 137 | begin 138 | try 139 | MemData.GotoBookmark(bm); 140 | except 141 | end; 142 | end; 143 | MemData.FreeBookmark(bm); 144 | end; 145 | finally 146 | MemData.EnableControls(); 147 | end; 148 | end; 149 | 150 | procedure TCustomParamsJobItemForm.DataSourceStateChange(Sender: TObject); 151 | begin 152 | if IsLoading then Exit; 153 | if (DataSource.State in dsEditModes) then 154 | begin 155 | IsModified := True; 156 | end; 157 | end; 158 | 159 | procedure TCustomParamsJobItemForm.UpdateControls; 160 | begin 161 | inherited UpdateControls(); 162 | MemData.ReadOnly := ReadOnly; 163 | end; 164 | 165 | procedure TCustomParamsJobItemForm.FormKeyDown(Sender: TObject; 166 | var Key: Word; Shift: TShiftState); 167 | begin 168 | inherited; 169 | if (Key = VK_F8) then 170 | begin 171 | MemData.Refresh(); 172 | end; 173 | end; 174 | 175 | procedure TCustomParamsJobItemForm.MemDataAfterDelete(DataSet: TDataSet); 176 | begin 177 | if IsLoading then Exit; 178 | IsModified := True; 179 | end; 180 | 181 | end. 182 | -------------------------------------------------------------------------------- /src/CustomJob/CustomScriptDialog.dfm: -------------------------------------------------------------------------------- 1 | inherited CustomScriptJobItemForm: TCustomScriptJobItemForm 2 | inherited PageControl: TPageControl 3 | ActivePage = tabDetails 4 | OnChange = PageControlChange 5 | inherited tabDetails: TTabSheet 6 | ExplicitHeight = 425 7 | object memoScript: TJobRichEdit 8 | Left = 0 9 | Top = 0 10 | Width = 524 11 | Height = 406 12 | Align = alClient 13 | Font.Charset = RUSSIAN_CHARSET 14 | Font.Color = clWindowText 15 | Font.Height = -13 16 | Font.Name = 'MS Sans Serif' 17 | Font.Style = [] 18 | Lines.Strings = ( 19 | 'Memo') 20 | ParentFont = False 21 | PlainText = True 22 | ScrollBars = ssBoth 23 | TabOrder = 0 24 | WantTabs = True 25 | WordWrap = False 26 | Zoom = 100 27 | OnChange = memoScriptChange 28 | OnSelectionChange = memoScriptSelectionChange 29 | end 30 | object sbScript: TStatusBar 31 | Left = 0 32 | Top = 406 33 | Width = 524 34 | Height = 19 35 | BiDiMode = bdLeftToRight 36 | Panels = < 37 | item 38 | Alignment = taRightJustify 39 | BiDiMode = bdRightToLeft 40 | ParentBiDiMode = False 41 | Text = 'Ln 1, Col 1' 42 | Width = 10 43 | end> 44 | ParentBiDiMode = False 45 | end 46 | end 47 | inherited tabAddition: TTabSheet 48 | ExplicitLeft = 4 49 | ExplicitTop = 4 50 | ExplicitWidth = 524 51 | ExplicitHeight = 425 52 | inherited pAddTop: TPanel 53 | Height = 87 54 | ExplicitHeight = 87 55 | object Label2: TLabel [1] 56 | Left = 6 57 | Top = 37 58 | Width = 46 59 | Height = 13 60 | Caption = 'Script File' 61 | end 62 | object Label3: TLabel [2] 63 | Left = 6 64 | Top = 59 65 | Width = 37 66 | Height = 13 67 | Caption = 'Log File' 68 | end 69 | inherited edtCanPerform: TEdit 70 | TabOrder = 6 71 | end 72 | object edtScriptFile: TEdit 73 | Left = 76 74 | Top = 34 75 | Width = 145 76 | Height = 21 77 | TabOrder = 1 78 | OnChange = EditFileChange 79 | end 80 | object edtLogFile: TEdit 81 | Left = 76 82 | Top = 56 83 | Width = 145 84 | Height = 21 85 | TabOrder = 3 86 | OnChange = EditFileChange 87 | end 88 | object btnErrorWords: TButton 89 | Left = 328 90 | Top = 56 91 | Width = 72 92 | Height = 22 93 | Caption = 'Error Words' 94 | TabOrder = 5 95 | OnClick = btnErrorWordsClick 96 | end 97 | object chkScriptFile: TCheckBox 98 | Left = 226 99 | Top = 36 100 | Width = 18 101 | Height = 17 102 | TabOrder = 2 103 | OnClick = CheckBoxChange 104 | end 105 | object chkLogFile: TCheckBox 106 | Left = 226 107 | Top = 58 108 | Width = 19 109 | Height = 17 110 | TabOrder = 4 111 | OnClick = CheckBoxChange 112 | end 113 | end 114 | inherited MemoDescription: TJobRichEdit 115 | Top = 87 116 | Height = 319 117 | ExplicitTop = 87 118 | ExplicitHeight = 319 119 | end 120 | inherited sbDescription: TStatusBar 121 | ExplicitWidth = 492 122 | end 123 | end 124 | end 125 | end 126 | -------------------------------------------------------------------------------- /src/CustomJob/CustomScriptDialog.pas: -------------------------------------------------------------------------------- 1 | unit CustomScriptDialog; 2 | 3 | interface 4 | 5 | uses 6 | System.UITypes, Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 | StdCtrls, ExtCtrls, ToolWin, ComCtrls, CustomDialog, JobConsts, JobClasses, 8 | JobCtrls; 9 | 10 | type 11 | TCustomScriptJobItemForm = class(TCustomDialogForm) 12 | memoScript: TJobRichEdit; 13 | Label2: TLabel; 14 | edtScriptFile: TEdit; 15 | edtLogFile: TEdit; 16 | Label3: TLabel; 17 | btnErrorWords: TButton; 18 | chkScriptFile: TCheckBox; 19 | chkLogFile: TCheckBox; 20 | sbScript: TStatusBar; 21 | procedure memoScriptChange(Sender: TObject); 22 | procedure btnErrorWordsClick(Sender: TObject); 23 | procedure CheckBoxChange(Sender: TObject); 24 | procedure EditFileChange(Sender: TObject); 25 | procedure PageControlChange(Sender: TObject); 26 | procedure memoScriptSelectionChange(Sender: TObject); 27 | private 28 | FErrorWords: TStrings; 29 | FErrorBindType: TJobListBindType; 30 | FScriptFileChanged: Boolean; 31 | procedure LoadIfNeedScript; 32 | protected 33 | procedure DoChangeErrorWords; virtual; 34 | procedure AssignData(IsFromDataItem: Boolean = False); override; 35 | procedure UpdateControls; override; 36 | public 37 | constructor Create(AOwner: TComponent); override; 38 | destructor Destroy; override; 39 | end; 40 | 41 | implementation 42 | 43 | {$R *.DFM} 44 | 45 | uses 46 | CustomJobItems, ItemListView; 47 | 48 | { TSQLScriptJobItemForm } 49 | 50 | procedure TCustomScriptJobItemForm.AssignData(IsFromDataItem: Boolean); 51 | var 52 | IsScriptFileChecked, IsLogFileChecked: Boolean; 53 | ScriptFileName, LogFileName, S: String; 54 | ScriptData: TCustomScriptJobDataItem; 55 | begin 56 | inherited AssignData(IsFromDataItem); 57 | ScriptData := Data as TCustomScriptJobDataItem; 58 | 59 | if IsFromDataItem then 60 | begin 61 | IsScriptFileChecked := ScriptData.IsUseScriptFile; 62 | IsLogFileChecked := ScriptData.IsUseLogFile; 63 | ScriptFileName := ScriptData.ScriptFile; 64 | LogFileName := ScriptData.LogFile; 65 | 66 | edtScriptFile.Text := ScriptFileName; 67 | edtLogFile.Text := LogFileName; 68 | chkScriptFile.Checked := IsScriptFileChecked; 69 | chkLogFile.Checked := IsLogFileChecked; 70 | FErrorWords.Assign(ScriptData.ErrorWords); 71 | FErrorBindType := ScriptData.ErrorBindType; 72 | 73 | if IsScriptFileChecked then 74 | begin 75 | if FileExists(ScriptFileName) then 76 | begin 77 | memoScript.Lines.LoadFromFile(ScriptFileName); 78 | end else 79 | begin 80 | memoScript.Lines.Clear(); 81 | if not ScriptData.IsValueParameter(ScriptFileName, S) then 82 | begin 83 | MessageDlg(Format(cFileNotExists, [ScriptFileName]), mtWarning, [mbOK], 0); 84 | end; 85 | end; 86 | end else 87 | begin 88 | memoScript.Lines.Assign(ScriptData.Script); 89 | end; 90 | end else 91 | begin 92 | LoadIfNeedScript(); 93 | IsScriptFileChecked := chkScriptFile.Checked; 94 | IsLogFileChecked := chkLogFile.Checked; 95 | ScriptFileName := Trim(edtScriptFile.Text); 96 | LogFileName := Trim(edtLogFile.Text); 97 | 98 | if IsScriptFileChecked and (ScriptFileName = '') then 99 | begin 100 | raise Exception.CreateFmt(cFileNameEmpty, ['Script ']); 101 | end; 102 | if IsLogFileChecked and (LogFileName = '') then 103 | begin 104 | raise Exception.CreateFmt(cFileNameEmpty, ['Log ']); 105 | end; 106 | 107 | if IsScriptFileChecked then 108 | begin 109 | if not ScriptData.IsValueParameter(ScriptFileName, S) then 110 | begin 111 | memoScript.Lines.SaveToFile(ScriptFileName); 112 | end; 113 | end else 114 | begin 115 | ScriptData.Script.Assign(memoScript.Lines); 116 | end; 117 | 118 | ScriptData.ScriptFile := ScriptFileName; 119 | ScriptData.LogFile := LogFileName; 120 | ScriptData.IsUseScriptFile := IsScriptFileChecked; 121 | ScriptData.IsUseLogFile := IsLogFileChecked; 122 | ScriptData.ErrorWords.Assign(FErrorWords); 123 | ScriptData.ErrorBindType := FErrorBindType; 124 | end; 125 | end; 126 | 127 | procedure TCustomScriptJobItemForm.LoadIfNeedScript; 128 | begin 129 | if FScriptFileChanged and chkScriptFile.Checked and FileExists(edtScriptFile.Text) then 130 | begin 131 | memoScript.Lines.LoadFromFile(edtScriptFile.Text); 132 | end; 133 | FScriptFileChanged := False; 134 | end; 135 | 136 | procedure TCustomScriptJobItemForm.memoScriptChange(Sender: TObject); 137 | begin 138 | if IsLoading then Exit; 139 | IsModified := True; 140 | end; 141 | 142 | procedure TCustomScriptJobItemForm.DoChangeErrorWords(); 143 | begin 144 | if ShowItemList(FErrorWords, FErrorBindType, ReadOnly) then 145 | begin 146 | IsModified := True; 147 | end; 148 | end; 149 | 150 | procedure TCustomScriptJobItemForm.btnErrorWordsClick(Sender: TObject); 151 | begin 152 | DoChangeErrorWords(); 153 | end; 154 | 155 | constructor TCustomScriptJobItemForm.Create(AOwner: TComponent); 156 | begin 157 | inherited Create(AOwner); 158 | FErrorWords := TStringList.Create(); 159 | FScriptFileChanged := False; 160 | end; 161 | 162 | destructor TCustomScriptJobItemForm.Destroy; 163 | begin 164 | FErrorWords.Free(); 165 | inherited Destroy(); 166 | end; 167 | 168 | procedure TCustomScriptJobItemForm.CheckBoxChange(Sender: TObject); 169 | begin 170 | if IsLoading then Exit; 171 | IsModified := True; 172 | UpdateControls(); 173 | end; 174 | 175 | procedure TCustomScriptJobItemForm.EditFileChange(Sender: TObject); 176 | begin 177 | if IsLoading then Exit; 178 | IsModified := True; 179 | FScriptFileChanged := True; 180 | end; 181 | 182 | procedure TCustomScriptJobItemForm.UpdateControls; 183 | begin 184 | inherited UpdateControls(); 185 | memoScript.ReadOnly := ReadOnly; 186 | EnableControl(edtScriptFile, (not ReadOnly) and chkScriptFile.Checked); 187 | EnableControl(edtLogFile, (not ReadOnly) and chkLogFile.Checked); 188 | chkScriptFile.Enabled := not ReadOnly; 189 | chkLogFile.Enabled := not ReadOnly; 190 | end; 191 | 192 | procedure TCustomScriptJobItemForm.PageControlChange(Sender: TObject); 193 | begin 194 | inherited; 195 | if (PageControl.ActivePage = tabDetails) then 196 | begin 197 | LoadIfNeedScript(); 198 | end; 199 | end; 200 | 201 | procedure TCustomScriptJobItemForm.memoScriptSelectionChange(Sender: TObject); 202 | begin 203 | inherited; 204 | sbScript.Panels[0].Text := 205 | Format(cCursorPositionMask, [IntToStr(memoScript.CaretPos.y + 1), IntToStr(memoScript.CaretPos.x + 1)]); 206 | end; 207 | 208 | end. 209 | -------------------------------------------------------------------------------- /src/CustomJob/TabEditors.dfm: -------------------------------------------------------------------------------- 1 | object TabEditorsFrame: TTabEditorsFrame 2 | Left = 0 3 | Top = 0 4 | Width = 320 5 | Height = 240 6 | TabOrder = 0 7 | object PageControl: TPageControl 8 | Left = 0 9 | Top = 0 10 | Width = 320 11 | Height = 240 12 | Align = alClient 13 | Images = imgTabs 14 | TabOrder = 0 15 | TabStop = False 16 | OnChange = PageControlChange 17 | OnContextPopup = PageControlContextPopup 18 | end 19 | object PopupMenu: TPopupMenu 20 | Left = 144 21 | Top = 104 22 | object Close1: TMenuItem 23 | Caption = '&Close' 24 | OnClick = Close1Click 25 | end 26 | end 27 | object imgTabs: TImageList 28 | Left = 144 29 | Top = 56 30 | Bitmap = { 31 | 494C010101000800040010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 32 | 0000000000003600000028000000400000001000000001002000000000000010 33 | 0000000000000000000000000000000000000000000000000000000000000000 34 | 0000000000000000000000000000000000000000000000000000000000000000 35 | 0000000000000000000000000000000000000000000000000000000000000000 36 | 0000000000000000000000000000000000000000000000000000000000000000 37 | 0000000000000000000000000000000000000000000000000000000000000000 38 | 0000000000000000000000000000000000000000000000000000000000000000 39 | 0000000000000000000000000000000000000000000000000000000000000000 40 | 0000000000000000000000000000000000000000000000000000000000000000 41 | 0000000000000000000000000000000000000000000000000000000000000000 42 | 0000000000000000000000000000000000000000000000000000000000000000 43 | 0000000000000000000000000000000000000000000000000000000000000000 44 | 0000000000000000000000000000000000000000000000000000000000000000 45 | 0000000000000000000000000000000000000000000000000000000000000000 46 | 0000000000000000000000000000000000000000000000000000000000000000 47 | 0000000000000000000000000000000000000000000000000000000000000000 48 | 0000000000000000000000000000000000000000000000000000000000000000 49 | 0000000000000000000000000000000000000000000000000000000000000000 50 | 0000000000000000000000000000000000000000000000000000000000000000 51 | 0000000000000000000000000000000000000000000000000000000000000000 52 | 0000000000000000000000000000000000000000000000000000000000000000 53 | 0000000000000000000000000000000000000000000000000000000000000000 54 | 0000000000000000000000000000000000000000000000000000000000000000 55 | 0000000000000000000000000000000000000000000000000000000000000000 56 | 0000000000000000000000000000000000000000000000000000000000000000 57 | 0000000000000000000000000000000000000000000000000000000000000000 58 | 0000000000000000000000000000000000000000000000000000000000000000 59 | 0000000000000000000000000000000000000000000000000000000000000000 60 | 0000000000000000000000000000000000000000000000000000000000000000 61 | 0000000000000000000000000000000000000000000000000000000000000000 62 | 0000000000000000000000000000000000000000000000000000000000000000 63 | 0000000000000000000000000000000000000000000000000000000000000000 64 | 0000000000000000000000000000000000000000000000000000000000000000 65 | 0000000000000000000000000000000000000000000000000000000000000000 66 | 0000D7780000D7780000D7780000D7780000D7780000D7780000D7780000D778 67 | 0000000000000000000000000000000000000000000000000000000000000000 68 | 0000000000000000000000000000000000000000000000000000000000000000 69 | 0000000000000000000000000000000000000000000000000000000000000000 70 | 0000000000000000000000000000000000000000000000000000000000000000 71 | 0000000000000000000000000000000000000000000000000000000000000000 72 | 0000000000000000000000000000000000000000000000000000000000000000 73 | 0000000000000000000000000000000000000000000000000000000000000000 74 | 0000D7780000F3D6B200F3D6B200F3D6B200F3D6B200F3D6B200F3D6B200D778 75 | 0000000000000000000000000000000000000000000000000000000000000000 76 | 0000000000000000000000000000000000000000000000000000000000000000 77 | 0000000000000000000000000000000000000000000000000000000000000000 78 | 0000000000000000000000000000000000000000000000000000000000000000 79 | 0000000000000000000000000000000000000000000000000000000000000000 80 | 0000000000000000000000000000000000000000000000000000000000000000 81 | 0000000000000000000000000000000000000000000000000000000000000000 82 | 0000D7780000F3D6B200F3D6B200F3D6B200F3D6B200F3D6B200F3D6B200D778 83 | 0000000000000000000000000000000000000000000000000000000000000000 84 | 0000000000000000000000000000000000000000000000000000000000000000 85 | 0000000000000000000000000000000000000000000000000000000000000000 86 | 0000000000000000000000000000000000000000000000000000000000000000 87 | 0000000000000000000000000000000000000000000000000000000000000000 88 | 0000000000000000000000000000000000000000000000000000000000000000 89 | 0000000000000000000000000000000000000000000000000000000000000000 90 | 0000D7780000F3D6B200F3D6B200F3D6B200F3D6B200F3D6B200F3D6B200D778 91 | 0000000000000000000000000000000000000000000000000000000000000000 92 | 0000000000000000000000000000000000000000000000000000000000000000 93 | 0000000000000000000000000000000000000000000000000000000000000000 94 | 0000000000000000000000000000000000000000000000000000000000000000 95 | 0000000000000000000000000000000000000000000000000000000000000000 96 | 0000000000000000000000000000000000000000000000000000000000000000 97 | 0000000000000000000000000000000000000000000000000000000000000000 98 | 0000D7780000F3D6B200F3D6B200F3D6B200F3D6B200F3D6B200F3D6B200D778 99 | 0000000000000000000000000000000000000000000000000000000000000000 100 | 0000000000000000000000000000000000000000000000000000000000000000 101 | 0000000000000000000000000000000000000000000000000000000000000000 102 | 0000000000000000000000000000000000000000000000000000000000000000 103 | 0000000000000000000000000000000000000000000000000000000000000000 104 | 0000000000000000000000000000000000000000000000000000000000000000 105 | 0000000000000000000000000000000000000000000000000000000000000000 106 | 0000D7780000F3D6B200F3D6B200F3D6B200F3D6B200F3D6B200F3D6B200D778 107 | 0000000000000000000000000000000000000000000000000000000000000000 108 | 0000000000000000000000000000000000000000000000000000000000000000 109 | 0000000000000000000000000000000000000000000000000000000000000000 110 | 0000000000000000000000000000000000000000000000000000000000000000 111 | 0000000000000000000000000000000000000000000000000000000000000000 112 | 0000000000000000000000000000000000000000000000000000000000000000 113 | 0000000000000000000000000000000000000000000000000000000000000000 114 | 0000D7780000F3D6B200F3D6B200F3D6B200F3D6B200F3D6B200F3D6B200D778 115 | 0000000000000000000000000000000000000000000000000000000000000000 116 | 0000000000000000000000000000000000000000000000000000000000000000 117 | 0000000000000000000000000000000000000000000000000000000000000000 118 | 0000000000000000000000000000000000000000000000000000000000000000 119 | 0000000000000000000000000000000000000000000000000000000000000000 120 | 0000000000000000000000000000000000000000000000000000000000000000 121 | 0000000000000000000000000000000000000000000000000000000000000000 122 | 0000D7780000D7780000D7780000D7780000D7780000D7780000D7780000D778 123 | 0000000000000000000000000000000000000000000000000000000000000000 124 | 0000000000000000000000000000000000000000000000000000000000000000 125 | 0000000000000000000000000000000000000000000000000000000000000000 126 | 0000000000000000000000000000000000000000000000000000000000000000 127 | 0000000000000000000000000000000000000000000000000000000000000000 128 | 0000000000000000000000000000000000000000000000000000000000000000 129 | 0000000000000000000000000000000000000000000000000000000000000000 130 | 0000000000000000000000000000000000000000000000000000000000000000 131 | 0000000000000000000000000000000000000000000000000000000000000000 132 | 0000000000000000000000000000000000000000000000000000000000000000 133 | 0000000000000000000000000000000000000000000000000000000000000000 134 | 0000000000000000000000000000000000000000000000000000000000000000 135 | 0000000000000000000000000000000000000000000000000000000000000000 136 | 0000000000000000000000000000000000000000000000000000000000000000 137 | 0000000000000000000000000000000000000000000000000000000000000000 138 | 0000000000000000000000000000000000000000000000000000000000000000 139 | 0000000000000000000000000000000000000000000000000000000000000000 140 | 0000000000000000000000000000000000000000000000000000000000000000 141 | 0000000000000000000000000000000000000000000000000000000000000000 142 | 0000000000000000000000000000000000000000000000000000000000000000 143 | 0000000000000000000000000000000000000000000000000000000000000000 144 | 0000000000000000000000000000000000000000000000000000000000000000 145 | 0000000000000000000000000000000000000000000000000000000000000000 146 | 0000000000000000000000000000000000000000000000000000000000000000 147 | 0000000000000000000000000000000000000000000000000000000000000000 148 | 0000000000000000000000000000000000000000000000000000000000000000 149 | 0000000000000000000000000000000000000000000000000000000000000000 150 | 0000000000000000000000000000000000000000000000000000000000000000 151 | 0000000000000000000000000000000000000000000000000000000000000000 152 | 0000000000000000000000000000000000000000000000000000000000000000 153 | 0000000000000000000000000000000000000000000000000000000000000000 154 | 0000000000000000000000000000000000000000000000000000000000000000 155 | 0000000000000000000000000000000000000000000000000000000000000000 156 | 0000000000000000000000000000000000000000000000000000000000000000 157 | 0000000000000000000000000000000000000000000000000000000000000000 158 | 0000000000000000000000000000000000000000000000000000000000000000 159 | 0000000000000000000000000000000000000000000000000000000000000000 160 | 0000000000000000000000000000000000000000000000000000000000000000 161 | 000000000000000000000000000000000000424D3E000000000000003E000000 162 | 2800000040000000100000000100010000000000800000000000000000000000 163 | 000000000000000000000000FFFFFF00FFFF000000000000FFFF000000000000 164 | FFFF000000000000FFFF000000000000F00F000000000000F00F000000000000 165 | F00F000000000000F00F000000000000F00F000000000000F00F000000000000 166 | F00F000000000000F00F000000000000FFFF000000000000FFFF000000000000 167 | FFFF000000000000FFFF00000000000000000000000000000000000000000000 168 | 000000000000} 169 | end 170 | end 171 | -------------------------------------------------------------------------------- /src/CustomJob/TabEditors.pas: -------------------------------------------------------------------------------- 1 | unit TabEditors; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Graphics, 7 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.Menus, System.UITypes, 8 | System.Generics.Collections, JobClasses, OperationUtils, System.ImageList, 9 | Vcl.ImgList; 10 | 11 | type 12 | TTabEditorsManager = class; 13 | 14 | TTabEditorsFrame = class(TFrame) 15 | PageControl: TPageControl; 16 | PopupMenu: TPopupMenu; 17 | Close1: TMenuItem; 18 | imgTabs: TImageList; 19 | procedure PageControlContextPopup(Sender: TObject; MousePos: TPoint; 20 | var Handled: Boolean); 21 | procedure Close1Click(Sender: TObject); 22 | procedure PageControlChange(Sender: TObject); 23 | private 24 | FTabManager: TTabEditorsManager; 25 | public 26 | constructor Create(AOwner: TComponent); override; 27 | destructor Destroy; override; 28 | 29 | property TabManager: TTabEditorsManager read FTabManager; 30 | end; 31 | 32 | TTabItem = class 33 | private 34 | FTab: TTabSheet; 35 | FEditor: TJobEditorItem; 36 | public 37 | property Tab: TTabSheet read FTab write FTab; 38 | property Editor: TJobEditorItem read FEditor write FEditor; 39 | end; 40 | 41 | TTabEditorsManager = class 42 | private 43 | FTabEditorsFrame: TTabEditorsFrame; 44 | FTabItems: TObjectList; 45 | 46 | function FindTabItem(AEditor: TJobEditorItem): TTabItem; overload; 47 | function FindTabItem(ATab: TTabSheet): TTabItem; overload; 48 | protected 49 | procedure ActivateEditor; 50 | public 51 | constructor Create(ATabEditorsFrame: TTabEditorsFrame); 52 | destructor Destroy; override; 53 | 54 | procedure AddEditor(AEditor: TJobEditorItem; AEditorControl: TWinControl); 55 | procedure RemoveEditor(AEditor: TJobEditorItem); 56 | procedure UpdateEditor(AEditor: TJobEditorItem; AIsModified: Boolean); 57 | end; 58 | 59 | implementation 60 | 61 | {$R *.dfm} 62 | 63 | const 64 | ModifiedImages: array[Boolean] of Integer = (-1, 0); 65 | 66 | { TTabEditorsFrame } 67 | 68 | procedure TTabEditorsFrame.Close1Click(Sender: TObject); 69 | begin 70 | if (TJobOperationManager.Instance.CurrentOperationList <> nil) then 71 | begin 72 | TJobOperationManager.Instance.CurrentOperationList.PerformOperation(opCloseJob, Sender); 73 | end; 74 | end; 75 | 76 | constructor TTabEditorsFrame.Create(AOwner: TComponent); 77 | begin 78 | inherited Create(AOwner); 79 | FTabManager := TTabEditorsManager.Create(Self); 80 | end; 81 | 82 | destructor TTabEditorsFrame.Destroy; 83 | begin 84 | FTabManager.Free(); 85 | inherited Destroy(); 86 | end; 87 | 88 | procedure TTabEditorsFrame.PageControlChange(Sender: TObject); 89 | begin 90 | TabManager.ActivateEditor(); 91 | end; 92 | 93 | procedure TTabEditorsFrame.PageControlContextPopup(Sender: TObject; 94 | MousePos: TPoint; var Handled: Boolean); 95 | var 96 | HitTests: THitTests; 97 | Point: TPoint; 98 | ind: Integer; 99 | begin 100 | ind := PageControl.IndexOfTabAt(MousePos.X, MousePos.Y); 101 | if (ind > -1) then 102 | begin 103 | PageControl.ActivePageIndex := ind; 104 | TabManager.ActivateEditor(); 105 | end; 106 | 107 | HitTests := PageControl.GetHitTestInfoAt(MousePos.X, MousePos.Y); 108 | Handled := (htOnLabel in HitTests); 109 | if Handled then 110 | begin 111 | Point := ClientToScreen(MousePos); 112 | PopupMenu.Popup(Point.X, Point.Y); 113 | end; 114 | end; 115 | 116 | { TTabEditorsManager } 117 | 118 | procedure TTabEditorsManager.ActivateEditor; 119 | var 120 | ti: TTabItem; 121 | begin 122 | ti := FindTabItem(FTabEditorsFrame.PageControl.ActivePage); 123 | if (ti <> nil) then 124 | begin 125 | ti.Editor.Perform(); 126 | end; 127 | end; 128 | 129 | procedure TTabEditorsManager.AddEditor(AEditor: TJobEditorItem; AEditorControl: TWinControl); 130 | var 131 | ti: TTabItem; 132 | ts: TTabSheet; 133 | begin 134 | ti := FindTabItem(AEditor); 135 | if (ti = nil) then 136 | begin 137 | ti := TTabItem.Create(); 138 | FTabItems.Add(ti); 139 | 140 | ts := TTabSheet.Create(FTabEditorsFrame); 141 | ts.PageControl := FTabEditorsFrame.PageControl; 142 | ts.Caption := AEditor.Data.JobName; 143 | ts.ImageIndex := -1; 144 | 145 | ti.Editor := AEditor; 146 | ti.Tab := ts; 147 | 148 | AEditorControl.Parent := ts; 149 | AEditorControl.Align := alClient; 150 | end; 151 | FTabEditorsFrame.PageControl.ActivePage := ti.Tab; 152 | end; 153 | 154 | constructor TTabEditorsManager.Create(ATabEditorsFrame: TTabEditorsFrame); 155 | begin 156 | inherited Create(); 157 | 158 | FTabItems := TObjectList.Create(); 159 | FTabEditorsFrame := ATabEditorsFrame; 160 | end; 161 | 162 | destructor TTabEditorsManager.Destroy; 163 | begin 164 | FTabItems.Free(); 165 | inherited Destroy(); 166 | end; 167 | 168 | function TTabEditorsManager.FindTabItem(ATab: TTabSheet): TTabItem; 169 | var 170 | i: Integer; 171 | begin 172 | for i := 0 to FTabItems.Count - 1 do 173 | begin 174 | Result := FTabItems[i]; 175 | if (Result.Tab = ATab) then 176 | begin 177 | Exit; 178 | end; 179 | end; 180 | Result := nil; 181 | end; 182 | 183 | procedure TTabEditorsManager.RemoveEditor(AEditor: TJobEditorItem); 184 | var 185 | ti: TTabItem; 186 | begin 187 | ti := FindTabItem(AEditor); 188 | if (ti <> nil) then 189 | begin 190 | ti.Tab.Free(); 191 | FTabItems.Remove(ti); 192 | ActivateEditor(); 193 | end; 194 | end; 195 | 196 | procedure TTabEditorsManager.UpdateEditor(AEditor: TJobEditorItem; AIsModified: Boolean); 197 | var 198 | ti: TTabItem; 199 | begin 200 | ti := FindTabItem(AEditor); 201 | if (ti <> nil) then 202 | begin 203 | ti.Tab.ImageIndex := ModifiedImages[AIsModified]; 204 | ti.Tab.Caption := AEditor.Data.JobName; 205 | end; 206 | end; 207 | 208 | function TTabEditorsManager.FindTabItem(AEditor: TJobEditorItem): TTabItem; 209 | var 210 | i: Integer; 211 | begin 212 | for i := 0 to FTabItems.Count - 1 do 213 | begin 214 | Result := FTabItems[i]; 215 | if (Result.Editor = AEditor) then 216 | begin 217 | Exit; 218 | end; 219 | end; 220 | Result := nil; 221 | end; 222 | 223 | end. 224 | -------------------------------------------------------------------------------- /src/CustomRunJob/CustomRunJobItem.pas: -------------------------------------------------------------------------------- 1 | unit CustomRunJobItem; 2 | 3 | interface 4 | 5 | uses 6 | Classes, JobClasses, CustomJobItems, OperationClasses, JobUtils, Winapi.msxml; 7 | 8 | type 9 | TCustomRunDataItem = class(TCustomScriptJobDataItem) 10 | private 11 | FCommandLine: string; 12 | FParamDelimiter: string; 13 | FParamPrefix: string; 14 | FJobUtilities: TJobUtilities; 15 | FScriptExt: string; 16 | procedure SetCommandLine(const Value: string); 17 | procedure SetParamDelimiter(const Value: string); 18 | procedure SetParamPrefix(const Value: string); 19 | procedure SetScriptExt(const Value: string); 20 | procedure AssignDefaultParseParams; 21 | protected 22 | function CanAddParameter(const AParamName: string): Boolean; override; 23 | function GetParseLexems: String; override; 24 | function GetWordDelimiters: String; override; 25 | procedure DoBeforePerform(Visitor: TJobVisitor); override; 26 | procedure DoAfterPerform(Visitor: TJobVisitor); override; 27 | procedure InitData; override; 28 | public 29 | constructor Create(AOwner: TJobItem); override; 30 | destructor Destroy; override; 31 | function Load(AStream: TStream): Integer; overload; override; 32 | procedure Load(ANode: IXMLDOMNode); overload; override; 33 | procedure Store(ANode: IXMLDOMNode); override; 34 | procedure Perform(Visitor: TJobVisitor); override; 35 | procedure Assign(Source: TPersistent); override; 36 | procedure GetParameterList(AList: TJobOperationParams); override; 37 | property CommandLine: string read FCommandLine write SetCommandLine; 38 | property ParamPrefix: string read FParamPrefix write SetParamPrefix; 39 | property ParamDelimiter: string read FParamDelimiter write SetParamDelimiter; 40 | property ScriptExt: string read FScriptExt write SetScriptExt; 41 | end; 42 | 43 | implementation 44 | 45 | uses 46 | JobConsts, SysUtils, XMLUtils; 47 | 48 | { TCustomRunDataItem } 49 | 50 | procedure TCustomRunDataItem.Assign(Source: TPersistent); 51 | var 52 | Data: TCustomRunDataItem; 53 | begin 54 | inherited Assign(Source); 55 | BeginUpdate(); 56 | try 57 | if (Source is TCustomRunDataItem) then 58 | begin 59 | Data := TCustomRunDataItem(Source); 60 | FCommandLine := Data.CommandLine; 61 | FParamDelimiter := Data.ParamDelimiter; 62 | FParamPrefix := Data.ParamPrefix; 63 | FScriptExt := Data.ScriptExt; 64 | end else 65 | begin 66 | InitData(); 67 | end; 68 | finally 69 | EndUpdate(); 70 | end; 71 | end; 72 | 73 | procedure TCustomRunDataItem.AssignDefaultParseParams; 74 | begin 75 | FParamDelimiter := inherited GetWordDelimiters(); 76 | FParamPrefix := inherited GetParseLexems(); 77 | FScriptExt := ''; 78 | end; 79 | 80 | function TCustomRunDataItem.CanAddParameter(const AParamName: string): Boolean; 81 | begin 82 | Result := (AParamName <> cScriptClause); 83 | end; 84 | 85 | constructor TCustomRunDataItem.Create(AOwner: TJobItem); 86 | begin 87 | inherited Create(AOwner); 88 | FJobUtilities := TJobUtilities.Create(); 89 | AssignDefaultParseParams(); 90 | end; 91 | 92 | destructor TCustomRunDataItem.Destroy; 93 | begin 94 | FJobUtilities.Free(); 95 | inherited Destroy(); 96 | end; 97 | 98 | procedure TCustomRunDataItem.DoAfterPerform(Visitor: TJobVisitor); 99 | begin 100 | inherited DoAfterPerform(Visitor); 101 | Script.Delete(Script.Count - 1); 102 | end; 103 | 104 | procedure TCustomRunDataItem.DoBeforePerform(Visitor: TJobVisitor); 105 | begin 106 | Script.Add(FCommandLine); 107 | inherited DoBeforePerform(Visitor); 108 | end; 109 | 110 | procedure TCustomRunDataItem.GetParameterList(AList: TJobOperationParams); 111 | begin 112 | Script.Add(FCommandLine); 113 | try 114 | inherited GetParameterList(AList); 115 | finally 116 | Script.Delete(Script.Count - 1); 117 | end; 118 | end; 119 | 120 | function TCustomRunDataItem.GetParseLexems: String; 121 | begin 122 | Result := FParamPrefix; 123 | end; 124 | 125 | function TCustomRunDataItem.GetWordDelimiters: String; 126 | begin 127 | Result := FParamDelimiter; 128 | end; 129 | 130 | procedure TCustomRunDataItem.InitData; 131 | begin 132 | inherited InitData(); 133 | FCommandLine := ''; 134 | AssignDefaultParseParams(); 135 | end; 136 | 137 | function TCustomRunDataItem.Load(AStream: TStream): Integer; 138 | var 139 | R: TReader; 140 | begin 141 | Result := inherited Load(AStream); 142 | BeginUpdate(); 143 | try 144 | R := TReader.Create(AStream, 1024); 145 | try 146 | FCommandLine := R.ReadString(); 147 | FParamDelimiter := R.ReadString(); 148 | FParamPrefix := R.ReadString(); 149 | finally 150 | R.Free(); 151 | end; 152 | finally 153 | EndUpdate(); 154 | end; 155 | end; 156 | 157 | procedure TCustomRunDataItem.Load(ANode: IXMLDOMNode); 158 | var 159 | ChildNode: IXMLDOMNode; 160 | begin 161 | inherited Load(ANode); 162 | BeginUpdate(); 163 | try 164 | ChildNode := ANode.selectSingleNode('CommandLine'); 165 | if ChildNode <> nil then FCommandLine := ChildNode.text; 166 | 167 | ChildNode := ANode.selectSingleNode('ParamDelimiter'); 168 | if ChildNode <> nil then FParamDelimiter := ChildNode.text; 169 | 170 | ChildNode := ANode.selectSingleNode('ParamPrefix'); 171 | if ChildNode <> nil then FParamPrefix := ChildNode.text; 172 | 173 | ChildNode := ANode.selectSingleNode('ScriptExt'); 174 | if ChildNode <> nil then FScriptExt := ChildNode.text; 175 | 176 | finally 177 | EndUpdate(); 178 | end; 179 | end; 180 | 181 | procedure TCustomRunDataItem.Perform(Visitor: TJobVisitor); 182 | var 183 | ACmdLine, s, ext: string; 184 | AOutput, AErrors: TStrings; 185 | begin 186 | inherited Perform(Visitor); 187 | AOutput := TStringList.Create(); 188 | AErrors := TStringList.Create(); 189 | try 190 | ACmdLine := Script[Script.Count - 1]; 191 | Script.Delete(Script.Count - 1); 192 | try 193 | Visitor.Log.Add(Format(cCommandLineDescr, [ACmdLine])); 194 | //TODO for run from file 195 | s := FJobUtilities.ReplaceString(ACmdLine, GetParseLexems() + cScriptClause, cJobInputFile); 196 | ext := ScriptExt; 197 | if (ext = '') then 198 | begin 199 | ext := 'run'; 200 | end; 201 | FJobUtilities.PerformCmdLine(s, Script, AOutput, AErrors, ext); 202 | CheckForErrorsInLog(AOutput); 203 | finally 204 | Script.Add(ACmdLine); 205 | end; 206 | finally 207 | Visitor.Log.AddStrings(AOutput); 208 | Visitor.Errors.AddStrings(AErrors); 209 | AErrors.Free(); 210 | AOutput.Free(); 211 | end; 212 | end; 213 | 214 | procedure TCustomRunDataItem.SetCommandLine(const Value: string); 215 | begin 216 | if (FCommandLine <> Value) then 217 | begin 218 | FCommandLine := Value; 219 | DoDataChanged(); 220 | end; 221 | end; 222 | 223 | procedure TCustomRunDataItem.SetParamDelimiter(const Value: string); 224 | begin 225 | if (FParamDelimiter <> Value) then 226 | begin 227 | FParamDelimiter := Value; 228 | DoDataChanged(); 229 | end; 230 | end; 231 | 232 | procedure TCustomRunDataItem.SetParamPrefix(const Value: string); 233 | begin 234 | if (FParamPrefix <> Value) then 235 | begin 236 | FParamPrefix := Value; 237 | DoDataChanged(); 238 | end; 239 | end; 240 | 241 | procedure TCustomRunDataItem.SetScriptExt(const Value: string); 242 | begin 243 | if (FScriptExt <> Value) then 244 | begin 245 | FScriptExt := Value; 246 | DoDataChanged(); 247 | end; 248 | end; 249 | 250 | procedure TCustomRunDataItem.Store(ANode: IXMLDOMNode); 251 | var 252 | ChildNode, CDATANode: IXMLDOMNode; 253 | begin 254 | inherited Store(ANode); 255 | ChildNode := ANode.ownerDocument.createElement('CommandLine'); 256 | ANode.appendChild(ChildNode); 257 | ChildNode.text := FCommandLine; 258 | 259 | ChildNode := ANode.ownerDocument.createElement('ParamDelimiter'); 260 | ANode.appendChild(ChildNode); 261 | CDATANode := ChildNode.ownerDocument.createCDATASection(FParamDelimiter); 262 | ChildNode.appendChild(CDATANode); 263 | 264 | ChildNode := ANode.ownerDocument.createElement('ParamPrefix'); 265 | ANode.appendChild(ChildNode); 266 | CDATANode := ChildNode.ownerDocument.createCDATASection(FParamPrefix); 267 | ChildNode.appendChild(CDATANode); 268 | 269 | ChildNode := ANode.ownerDocument.createElement('ScriptExt'); 270 | ANode.appendChild(ChildNode); 271 | ChildNode.text := FScriptExt; 272 | end; 273 | 274 | initialization 275 | RegisterClass(TCustomRunDataItem); 276 | AddCDataNodeName('ParamDelimiter'); 277 | AddCDataNodeName('ParamPrefix'); 278 | 279 | end. 280 | -------------------------------------------------------------------------------- /src/CustomRunJob/CustomRunJobItemFrm.dfm: -------------------------------------------------------------------------------- 1 | inherited CustomRunJobItemForm: TCustomRunJobItemForm 2 | inherited PageControl: TPageControl 3 | ActivePage = tabAddition 4 | inherited tabDetails: TTabSheet 5 | ExplicitLeft = 4 6 | ExplicitTop = 4 7 | ExplicitWidth = 524 8 | inherited memoScript: TJobRichEdit 9 | Top = 53 10 | Height = 353 11 | TabOrder = 1 12 | ExplicitTop = 53 13 | ExplicitHeight = 353 14 | end 15 | inherited sbScript: TStatusBar 16 | Panels = < 17 | item 18 | Alignment = taRightJustify 19 | Text = 'Ln 1, Col 1' 20 | Width = 10 21 | end> 22 | end 23 | object Panel2: TPanel 24 | Left = 0 25 | Top = 0 26 | Width = 524 27 | Height = 53 28 | Align = alTop 29 | BevelOuter = bvNone 30 | TabOrder = 0 31 | ExplicitWidth = 484 32 | object Label4: TLabel 33 | Left = 2 34 | Top = 7 35 | Width = 70 36 | Height = 13 37 | Caption = 'Command Line' 38 | end 39 | object Label5: TLabel 40 | Left = 2 41 | Top = 29 42 | Width = 59 43 | Height = 13 44 | Caption = 'Param Prefix' 45 | end 46 | object Label6: TLabel 47 | Left = 262 48 | Top = 29 49 | Width = 73 50 | Height = 13 51 | Caption = 'Param Delimiter' 52 | end 53 | object edtCommandLine: TEdit 54 | Left = 79 55 | Top = 4 56 | Width = 410 57 | Height = 21 58 | TabOrder = 0 59 | OnChange = edtCommandLineChange 60 | end 61 | object edtParamPrefix: TEdit 62 | Left = 79 63 | Top = 26 64 | Width = 150 65 | Height = 21 66 | TabOrder = 1 67 | OnChange = edtCommandLineChange 68 | end 69 | object edtParamDelimiter: TEdit 70 | Left = 339 71 | Top = 26 72 | Width = 150 73 | Height = 21 74 | TabOrder = 2 75 | OnChange = edtCommandLineChange 76 | end 77 | end 78 | end 79 | end 80 | end 81 | -------------------------------------------------------------------------------- /src/CustomRunJob/CustomRunJobItemFrm.pas: -------------------------------------------------------------------------------- 1 | unit CustomRunJobItemFrm; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 | CustomScriptDialog, StdCtrls, JobCtrls, ComCtrls, ExtCtrls, JobClasses, CustomDialog; 8 | 9 | type 10 | TCustomRunJobItemForm = class(TCustomScriptJobItemForm) 11 | Panel2: TPanel; 12 | edtCommandLine: TEdit; 13 | Label4: TLabel; 14 | Label5: TLabel; 15 | edtParamPrefix: TEdit; 16 | Label6: TLabel; 17 | edtParamDelimiter: TEdit; 18 | procedure edtCommandLineChange(Sender: TObject); 19 | protected 20 | procedure UpdateControls; override; 21 | procedure AssignData(IsFromDataItem: Boolean = False); override; 22 | end; 23 | 24 | TCustomRunJobEditorItem = class(TCustomJobEditorItem) 25 | protected 26 | function GetEditorFormClass: TCustomDialogFormClass; override; 27 | end; 28 | 29 | implementation 30 | 31 | uses 32 | CustomRunJobItem; 33 | 34 | {$R *.DFM} 35 | 36 | { TCustomRunJobEditorItem } 37 | 38 | function TCustomRunJobEditorItem.GetEditorFormClass: TCustomDialogFormClass; 39 | begin 40 | Result := TCustomRunJobItemForm; 41 | end; 42 | 43 | procedure TCustomRunJobItemForm.AssignData(IsFromDataItem: Boolean); 44 | begin 45 | inherited AssignData(IsFromDataItem); 46 | if IsFromDataItem then 47 | begin 48 | edtCommandLine.Text := TCustomRunDataItem(Data).CommandLine; 49 | edtParamPrefix.Text := TCustomRunDataItem(Data).ParamPrefix; 50 | edtParamDelimiter.Text := TCustomRunDataItem(Data).ParamDelimiter; 51 | //TODO edtScriptExt.Text := TCustomRunDataItem(Data).ScriptExt; 52 | end else 53 | begin 54 | TCustomRunDataItem(Data).CommandLine := edtCommandLine.Text; 55 | TCustomRunDataItem(Data).ParamPrefix := edtParamPrefix.Text; 56 | TCustomRunDataItem(Data).ParamDelimiter := edtParamDelimiter.Text; 57 | //TODO TCustomRunDataItem(Data).ScriptExt := edtScriptExt.Text; 58 | end; 59 | end; 60 | 61 | procedure TCustomRunJobItemForm.edtCommandLineChange(Sender: TObject); 62 | begin 63 | if IsLoading then Exit; 64 | IsModified := True; 65 | UpdateControls(); 66 | end; 67 | 68 | procedure TCustomRunJobItemForm.UpdateControls; 69 | begin 70 | inherited UpdateControls(); 71 | edtCommandLine.Enabled := not ReadOnly; 72 | edtParamPrefix.Enabled := not ReadOnly; 73 | edtParamDelimiter.Enabled := not ReadOnly; 74 | //TODO edtScriptExt.Enabled := not ReadOnly; 75 | EnableControl(edtScriptFile, False); 76 | EnableControl(edtLogFile, False); 77 | chkScriptFile.Enabled := False; 78 | chkLogFile.Enabled := False; 79 | end; 80 | 81 | initialization 82 | RegisterEditorItem(TCustomRunJobEditorItem, TCustomRunDataItem, 'Custom Run'); 83 | 84 | end. 85 | -------------------------------------------------------------------------------- /src/GlobalParams/GlobalParamsJobItemFrm.dfm: -------------------------------------------------------------------------------- 1 | object GlobalParamsJobItemForm: TGlobalParamsJobItemForm 2 | Left = 264 3 | Top = 109 4 | Caption = 'Global Parameters Editor' 5 | ClientHeight = 363 6 | ClientWidth = 498 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'MS Sans Serif' 12 | Font.Style = [] 13 | KeyPreview = True 14 | OldCreateOrder = False 15 | Position = poOwnerFormCenter 16 | OnCloseQuery = FormCloseQuery 17 | OnKeyDown = FormKeyDown 18 | PixelsPerInch = 96 19 | TextHeight = 13 20 | object pBottom: TPanel 21 | Left = 0 22 | Top = 328 23 | Width = 498 24 | Height = 35 25 | Align = alBottom 26 | BevelOuter = bvNone 27 | TabOrder = 0 28 | object Panel1: TPanel 29 | Left = 269 30 | Top = 0 31 | Width = 229 32 | Height = 35 33 | Align = alRight 34 | BevelOuter = bvNone 35 | Caption = 'Panel1' 36 | TabOrder = 0 37 | object btnOK: TButton 38 | Left = 6 39 | Top = 8 40 | Width = 72 41 | Height = 22 42 | Caption = 'OK' 43 | Default = True 44 | ModalResult = 1 45 | TabOrder = 0 46 | OnClick = btnOKClick 47 | end 48 | object btnCancel: TButton 49 | Left = 79 50 | Top = 8 51 | Width = 72 52 | Height = 22 53 | Cancel = True 54 | Caption = 'Cancel' 55 | ModalResult = 2 56 | TabOrder = 1 57 | OnClick = btnCancelClick 58 | end 59 | object btnApply: TButton 60 | Left = 152 61 | Top = 8 62 | Width = 72 63 | Height = 22 64 | Caption = 'Apply' 65 | TabOrder = 2 66 | OnClick = btnApplyClick 67 | end 68 | end 69 | end 70 | object pMain: TPanel 71 | Left = 0 72 | Top = 0 73 | Width = 498 74 | Height = 328 75 | Align = alClient 76 | BevelOuter = bvNone 77 | TabOrder = 1 78 | object Panel2: TPanel 79 | Left = 0 80 | Top = 0 81 | Width = 498 82 | Height = 47 83 | Align = alTop 84 | BevelOuter = bvNone 85 | TabOrder = 0 86 | object Navigator: TDBNavigator 87 | Left = 0 88 | Top = 10 89 | Width = 230 90 | Height = 25 91 | DataSource = DataSource 92 | ConfirmDelete = False 93 | TabOrder = 0 94 | end 95 | end 96 | object List: TDBGrid 97 | Left = 0 98 | Top = 47 99 | Width = 498 100 | Height = 281 101 | Align = alClient 102 | DataSource = DataSource 103 | Options = [dgEditing, dgTitles, dgIndicator, dgColumnResize, dgColLines, dgRowLines, dgTabs, dgCancelOnExit] 104 | TabOrder = 1 105 | TitleFont.Charset = DEFAULT_CHARSET 106 | TitleFont.Color = clWindowText 107 | TitleFont.Height = -11 108 | TitleFont.Name = 'MS Sans Serif' 109 | TitleFont.Style = [] 110 | Columns = < 111 | item 112 | Expanded = False 113 | FieldName = 'paramname' 114 | Title.Caption = 'Parameter Name' 115 | Width = 100 116 | Visible = True 117 | end 118 | item 119 | Expanded = False 120 | FieldName = 'paramvalue' 121 | Title.Caption = 'Parameter Value' 122 | Width = 356 123 | Visible = True 124 | end> 125 | end 126 | end 127 | object DataSource: TDataSource 128 | DataSet = MemData 129 | OnStateChange = DataSourceStateChange 130 | Left = 178 131 | Top = 152 132 | end 133 | object MemData: TJobMemData 134 | Aggregates = <> 135 | Params = <> 136 | AfterDelete = MemDataAfterDelete 137 | Left = 248 138 | Top = 152 139 | object MemDataparamname: TStringField 140 | FieldName = 'paramname' 141 | Size = 150 142 | end 143 | object MemDataparamvalue: TStringField 144 | FieldName = 'paramvalue' 145 | Size = 150 146 | end 147 | end 148 | end 149 | -------------------------------------------------------------------------------- /src/ItemListView/ItemListView.dfm: -------------------------------------------------------------------------------- 1 | inherited ItemListViewForm: TItemListViewForm 2 | Left = 262 3 | Top = 107 4 | BorderStyle = bsDialog 5 | Caption = 'Edit Items' 6 | ClientHeight = 195 7 | ClientWidth = 318 8 | OldCreateOrder = False 9 | Position = poOwnerFormCenter 10 | OnCreate = FormCreate 11 | ExplicitWidth = 324 12 | ExplicitHeight = 224 13 | PixelsPerInch = 96 14 | TextHeight = 13 15 | object Label1: TLabel 16 | Left = 8 17 | Top = 168 18 | Width = 48 19 | Height = 13 20 | Caption = 'Bind Type' 21 | end 22 | object btnOK: TButton 23 | Left = 164 24 | Top = 164 25 | Width = 72 26 | Height = 22 27 | Caption = 'OK' 28 | Default = True 29 | ModalResult = 1 30 | TabOrder = 2 31 | end 32 | object btnCancel: TButton 33 | Left = 237 34 | Top = 164 35 | Width = 72 36 | Height = 22 37 | Cancel = True 38 | Caption = 'Cancel' 39 | ModalResult = 2 40 | TabOrder = 3 41 | end 42 | object Memo: TMemo 43 | Left = 0 44 | Top = 0 45 | Width = 318 46 | Height = 147 47 | Align = alTop 48 | TabOrder = 0 49 | end 50 | object cmbBindType: TJobComboBox 51 | Left = 64 52 | Top = 165 53 | Width = 87 54 | Height = 21 55 | Style = csDropDownList 56 | TabOrder = 1 57 | end 58 | end 59 | -------------------------------------------------------------------------------- /src/ItemListView/ItemListView.pas: -------------------------------------------------------------------------------- 1 | unit ItemListView; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 | StdCtrls, JobCtrls, JobConsts, CustomModalDlg; 8 | 9 | type 10 | TItemListViewForm = class(TCustomModalDialog) 11 | btnOK: TButton; 12 | btnCancel: TButton; 13 | Memo: TMemo; 14 | Label1: TLabel; 15 | cmbBindType: TJobComboBox; 16 | procedure FormCreate(Sender: TObject); 17 | private 18 | FReadOnly: Boolean; 19 | procedure SetReadOnly(const Value: Boolean); 20 | protected 21 | property ReadOnly: Boolean read FReadOnly write SetReadOnly; 22 | end; 23 | 24 | function ShowItemList(AList: TStrings; var ABindType: TJobListBindType; AReadOnly: Boolean): Boolean; 25 | 26 | implementation 27 | 28 | {$R *.DFM} 29 | 30 | function ShowItemList(AList: TStrings; var ABindType: TJobListBindType; AReadOnly: Boolean): Boolean; 31 | var 32 | Dlg: TItemListViewForm; 33 | begin 34 | Dlg := TItemListViewForm.Create(nil); 35 | try 36 | Dlg.cmbBindType.ItemIndex := Integer(ABindType); 37 | Dlg.Memo.Lines.Assign(AList); 38 | Dlg.ReadOnly := AReadOnly; 39 | Result := (Dlg.ShowModal() = mrOK) and (not AReadOnly); 40 | if Result then 41 | begin 42 | ABindType := TJobListBindType(Dlg.cmbBindType.ItemIndex); 43 | AList.Assign(Dlg.Memo.Lines); 44 | end; 45 | finally 46 | Dlg.Free(); 47 | end; 48 | end; 49 | 50 | procedure TItemListViewForm.FormCreate(Sender: TObject); 51 | var 52 | i: TJobListBindType; 53 | begin 54 | cmbBindType.Items.Clear(); 55 | for i := Low(cJobListBindTypeNames) to High(cJobListBindTypeNames) do 56 | begin 57 | cmbBindType.Items.Add(cJobListBindTypeNames[i]); 58 | end; 59 | end; 60 | 61 | procedure TItemListViewForm.SetReadOnly(const Value: Boolean); 62 | begin 63 | if (FReadOnly <> Value) then 64 | begin 65 | FReadOnly := Value; 66 | Memo.ReadOnly := FReadOnly; 67 | cmbBindType.Enabled := not FReadOnly; 68 | end; 69 | end; 70 | 71 | end. 72 | -------------------------------------------------------------------------------- /src/Lib/JobControls/JobControls.dpk: -------------------------------------------------------------------------------- 1 | package JobControls; 2 | 3 | {$R *.res} 4 | {$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} 5 | {$ALIGN 8} 6 | {$ASSERTIONS ON} 7 | {$BOOLEVAL OFF} 8 | {$DEBUGINFO OFF} 9 | {$EXTENDEDSYNTAX ON} 10 | {$IMPORTEDDATA ON} 11 | {$IOCHECKS ON} 12 | {$LOCALSYMBOLS ON} 13 | {$LONGSTRINGS ON} 14 | {$OPENSTRINGS ON} 15 | {$OPTIMIZATION OFF} 16 | {$OVERFLOWCHECKS OFF} 17 | {$RANGECHECKS OFF} 18 | {$REFERENCEINFO ON} 19 | {$SAFEDIVIDE OFF} 20 | {$STACKFRAMES ON} 21 | {$TYPEDADDRESS OFF} 22 | {$VARSTRINGCHECKS ON} 23 | {$WRITEABLECONST OFF} 24 | {$MINENUMSIZE 1} 25 | {$IMAGEBASE $400000} 26 | {$DEFINE DEBUG} 27 | {$ENDIF IMPLICITBUILDING} 28 | {$IMPLICITBUILD ON} 29 | 30 | requires 31 | rtl, 32 | vcl, 33 | dbrtl, 34 | dsnap; 35 | 36 | contains 37 | JobCtrls in 'JobCtrls.pas', 38 | JobRegister in 'JobRegister.pas', 39 | JobMemData in 'JobMemData.pas'; 40 | 41 | end. 42 | 43 | -------------------------------------------------------------------------------- /src/Lib/JobControls/JobControls.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CleverComponents/Task-Runner/cf8374f1eec7e72a8b4e978ad8e2300eb8b6a36c/src/Lib/JobControls/JobControls.res -------------------------------------------------------------------------------- /src/Lib/JobControls/JobCtrls.pas: -------------------------------------------------------------------------------- 1 | unit JobCtrls; 2 | 3 | interface 4 | 5 | uses 6 | Vcl.StdCtrls, Winapi.Windows, Winapi.Messages, System.Classes, Vcl.Controls, Vcl.ComCtrls, Vcl.Dialogs; 7 | 8 | type 9 | TJobComboBox = class(TComboBox) 10 | end; 11 | 12 | TJobRichEdit = class(TRichEdit) 13 | private 14 | FFindDialog: TFindDialog; 15 | FReplaceDialog: TReplaceDialog; 16 | 17 | procedure FindOne(Sender: TObject); 18 | procedure ReplaceOne(Sender: TObject); 19 | protected 20 | procedure KeyDown(var Key: Word; Shift: TShiftState); override; 21 | public 22 | constructor Create(AOwner: TComponent); override; 23 | destructor Destroy; override; 24 | procedure FindDialog; 25 | procedure ReplaceDialog; 26 | end; 27 | 28 | TJobTreeView = class(TTreeView) 29 | end; 30 | 31 | procedure EnableControl(AControl: TWinControl; IsEnable: Boolean); 32 | 33 | const 34 | cRichEditTextNotFound = 'The search text is not found.'; 35 | cRichEditReplaceAllResult = 'Replaced %d occurances.'; 36 | cRichEditFoundResultCaption = 'Information'; 37 | 38 | implementation 39 | 40 | uses 41 | Vcl.Forms, System.SysUtils, Vcl.Graphics; 42 | 43 | type 44 | TD = class(TWinControl); 45 | 46 | procedure EnableControl(AControl: TWinControl; IsEnable: Boolean); 47 | begin 48 | AControl.Enabled := IsEnable; 49 | if IsEnable then 50 | begin 51 | TD(AControl).Color := clWindow; 52 | end else 53 | begin 54 | TD(AControl).Color := clBtnFace; 55 | end; 56 | end; 57 | 58 | { TJobRichEdit } 59 | 60 | constructor TJobRichEdit.Create(AOwner: TComponent); 61 | begin 62 | inherited Create(AOwner); 63 | FFindDialog := nil; 64 | FReplaceDialog := nil; 65 | end; 66 | 67 | destructor TJobRichEdit.Destroy; 68 | begin 69 | if (FFindDialog <> nil) then 70 | begin 71 | FFindDialog.Free(); 72 | end; 73 | if (FReplaceDialog <> nil) then 74 | begin 75 | FReplaceDialog.Free(); 76 | end; 77 | inherited Destroy(); 78 | end; 79 | 80 | procedure TJobRichEdit.FindDialog; 81 | begin 82 | SelLength := 0; 83 | SendMessage(Self.Handle, EM_SCROLLCARET, 0, 0); 84 | if (FFindDialog = nil) then 85 | begin 86 | FFindDialog := TFindDialog.Create(nil); 87 | FFindDialog.Options := FFindDialog.Options + [frDisableUpDown]; 88 | end; 89 | FFindDialog.OnFind := FindOne; 90 | FFindDialog.Execute(); 91 | end; 92 | 93 | procedure TJobRichEdit.FindOne(Sender: TObject); 94 | var 95 | StartPos, FindLength, FoundAt: Integer; 96 | Flags: TSearchTypes; 97 | P: TPoint; 98 | CaretR, R, IntersectR: TRect; 99 | hwnd: THandle; 100 | begin 101 | with TFindDialog(Sender) do 102 | begin 103 | if frDown in Options then 104 | begin 105 | if SelLength = 0 then StartPos := SelStart 106 | else StartPos := SelStart + SelLength; 107 | FindLength := Length(Text) - StartPos; 108 | end else 109 | begin 110 | StartPos := SelStart; 111 | FindLength := -StartPos; 112 | end; 113 | Flags := []; 114 | if frMatchCase in Options then Include(Flags, stMatchCase); 115 | if frWholeWord in Options then Include(Flags, stWholeWord); 116 | Screen.Cursor := crHourglass; 117 | FoundAt := Self.FindText(FindText, StartPos, FindLength, Flags); 118 | if not (frReplaceAll in Options) then 119 | begin 120 | Screen.Cursor := crDefault; 121 | end; 122 | if FoundAt > -1 then 123 | begin 124 | if frReplaceAll in Options then 125 | begin 126 | SelStart := FoundAt; 127 | SelLength := Length(FindText); 128 | SendMessage(Self.Handle, EM_SCROLLCARET, 0, 0); 129 | end else 130 | begin 131 | SetFocus(); 132 | SelStart := FoundAt; 133 | SelLength := Length(FindText); 134 | SendMessage(Self.Handle, EM_SCROLLCARET, 0, 0); 135 | 136 | Winapi.Windows.GetCaretPos(P); 137 | P := ClientToScreen(P); 138 | CaretR := Rect(P.X, P.Y, P.X + 2, P.Y + 20); 139 | GetWindowRect(Handle, R); 140 | if IntersectRect(IntersectR, CaretR, R) then 141 | begin 142 | if P.Y < Screen.Height div 2 then 143 | begin 144 | Top := P.Y + 40; 145 | end else 146 | begin 147 | Top := P.Y - (R.Bottom - R.Top + 20); 148 | end; 149 | end; 150 | end; 151 | end else 152 | if not (frReplaceAll in Options) then 153 | begin 154 | if (Screen.ActiveCustomForm <> nil) then 155 | begin 156 | hwnd := Screen.ActiveCustomForm.Handle; 157 | end else 158 | begin 159 | hwnd := 0; 160 | end; 161 | MessageBox(hwnd, cRichEditTextNotFound, cRichEditFoundResultCaption, MB_OK); 162 | end; 163 | end; 164 | end; 165 | 166 | procedure TJobRichEdit.KeyDown(var Key: Word; Shift: TShiftState); 167 | begin 168 | inherited KeyDown(Key, Shift); 169 | if (ssCtrl in Shift) and (Key = Ord('F')) then 170 | begin 171 | FindDialog(); 172 | Key := 0; 173 | end else 174 | if (not ReadOnly) and (ssCtrl in Shift) and (Key = Ord('H')) then 175 | begin 176 | ReplaceDialog(); 177 | Key := 0; 178 | end; 179 | end; 180 | 181 | procedure TJobRichEdit.ReplaceDialog; 182 | begin 183 | SelLength := 0; 184 | SendMessage(Self.Handle, EM_SCROLLCARET, 0, 0); 185 | if (FReplaceDialog = nil) then 186 | begin 187 | FReplaceDialog := TReplaceDialog.Create(nil); 188 | end; 189 | FReplaceDialog.OnFind := FindOne; 190 | FReplaceDialog.OnReplace := ReplaceOne; 191 | FReplaceDialog.Execute(); 192 | end; 193 | 194 | procedure TJobRichEdit.ReplaceOne(Sender: TObject); 195 | var 196 | ReplacedCount, OldSelStart, PrevSelStart: Integer; 197 | S: String; 198 | hwnd: THandle; 199 | begin 200 | with TReplaceDialog(Sender) do 201 | begin 202 | ReplacedCount := 0; 203 | OldSelStart := SelStart; 204 | if frReplaceAll in Options then 205 | Screen.Cursor := crHourglass; 206 | repeat 207 | if (SelLength > 0) and ((SelText = FindText) or 208 | (not (frMatchCase in Options) and 209 | (AnsiUpperCase(SelText) = AnsiUpperCase(FindText)))) then 210 | begin 211 | SelText := ReplaceText; 212 | Inc(ReplacedCount); 213 | end; 214 | PrevSelStart := SelStart; 215 | FindOne(Sender); 216 | until not (frReplaceAll in Options) or (SelStart = PrevSelStart); 217 | if frReplaceAll in Options then 218 | begin 219 | Screen.Cursor := crDefault; 220 | if ReplacedCount = 0 then 221 | begin 222 | S := cRichEditTextNotFound; 223 | end else 224 | begin 225 | SelStart := OldSelStart; 226 | S := Format(cRichEditReplaceAllResult, [ReplacedCount]); 227 | end; 228 | if (Screen.ActiveCustomForm <> nil) then 229 | begin 230 | hwnd := Screen.ActiveCustomForm.Handle; 231 | end else 232 | begin 233 | hwnd := 0; 234 | end; 235 | MessageBox(hwnd, PChar(S), cRichEditFoundResultCaption, MB_OK); 236 | end; 237 | end; 238 | end; 239 | 240 | end. 241 | -------------------------------------------------------------------------------- /src/Lib/JobControls/JobMemData.pas: -------------------------------------------------------------------------------- 1 | unit JobMemData; 2 | 3 | interface 4 | 5 | uses 6 | System.Classes, Data.DB, Datasnap.DBClient; 7 | 8 | type 9 | TJobMemData = class(TClientDataSet) 10 | private 11 | FInitDataSet: Boolean; 12 | protected 13 | function GetCanRefresh: Boolean; override; 14 | procedure SetActive(Value: Boolean); override; 15 | procedure InternalRefresh; override; 16 | public 17 | constructor Create(AOwner: TComponent); override; 18 | end; 19 | 20 | implementation 21 | 22 | { TJobMemData } 23 | 24 | constructor TJobMemData.Create(AOwner: TComponent); 25 | begin 26 | inherited Create(AOwner); 27 | FInitDataSet := False; 28 | end; 29 | 30 | function TJobMemData.GetCanRefresh: Boolean; 31 | begin 32 | Result := GetCanModify(); 33 | end; 34 | 35 | procedure TJobMemData.InternalRefresh; 36 | begin 37 | end; 38 | 39 | procedure TJobMemData.SetActive(Value: Boolean); 40 | begin 41 | if (not Active) and (not FInitDataSet) then 42 | begin 43 | FInitDataSet := True; 44 | try 45 | CreateDataSet(); 46 | finally 47 | FInitDataSet := False; 48 | end; 49 | end; 50 | 51 | inherited SetActive(Value); 52 | end; 53 | 54 | end. 55 | -------------------------------------------------------------------------------- /src/Lib/JobControls/JobRegister.pas: -------------------------------------------------------------------------------- 1 | unit JobRegister; 2 | 3 | interface 4 | 5 | uses 6 | System.Classes, JobCtrls, JobMemData; 7 | 8 | procedure Register; 9 | 10 | implementation 11 | 12 | procedure Register; 13 | begin 14 | RegisterComponents('Job Controls', [TJobComboBox, TJobRichEdit, TJobTreeView, TJobMemData]); 15 | end; 16 | 17 | end. 18 | -------------------------------------------------------------------------------- /src/Main/App-Icon-150.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CleverComponents/Task-Runner/cf8374f1eec7e72a8b4e978ad8e2300eb8b6a36c/src/Main/App-Icon-150.png -------------------------------------------------------------------------------- /src/Main/App-Icon-44.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CleverComponents/Task-Runner/cf8374f1eec7e72a8b4e978ad8e2300eb8b6a36c/src/Main/App-Icon-44.png -------------------------------------------------------------------------------- /src/Main/TaskRunner.dpr: -------------------------------------------------------------------------------- 1 | program TaskRunner; 2 | 3 | uses 4 | FastMM4, 5 | FastMM4Messages, 6 | Vcl.Forms, 7 | main in 'main.pas' {MainForm}, 8 | JobClasses in '..\Classes\JobClasses.pas', 9 | JobConsts in '..\Classes\JobConsts.pas', 10 | JobDskClasses in '..\Classes\JobDskClasses.pas', 11 | OperationClasses in '..\Classes\OperationClasses.pas', 12 | AboutForm in '..\About\AboutForm.pas', 13 | CallJobItem in '..\CallJob\CallJobItem.pas', 14 | CallJobItemFrm in '..\CallJob\CallJobItemFrm.pas', 15 | CommandBatchJobItem in '..\CommandJob\CommandBatchJobItem.pas', 16 | CommandBatchJobItemFrm in '..\CommandJob\CommandBatchJobItemFrm.pas', 17 | ConnectionSetup in '..\ConnectionSetup\ConnectionSetup.pas', 18 | CustomModalDlg in '..\CustomForms\CustomModalDlg.pas' {CustomModalDialog}, 19 | CustomDialog in '..\CustomJob\CustomDialog.pas' {CustomDialogForm}, 20 | CustomJobItems in '..\CustomJob\CustomJobItems.pas', 21 | CustomParametersDialog in '..\CustomJob\CustomParametersDialog.pas' {CustomParamsJobItemForm}, 22 | CustomScriptDialog in '..\CustomJob\CustomScriptDialog.pas' {CustomScriptJobItemForm}, 23 | CustomRunJobItem in '..\CustomRunJob\CustomRunJobItem.pas', 24 | CustomRunJobItemFrm in '..\CustomRunJob\CustomRunJobItemFrm.pas' {CustomRunJobItemForm}, 25 | GlobalParamsJobItemFrm in '..\GlobalParams\GlobalParamsJobItemFrm.pas' {GlobalParamsJobItemForm}, 26 | ItemListView in '..\ItemListView\ItemListView.pas' {ItemListViewForm}, 27 | JobCtrls in '..\Lib\JobControls\JobCtrls.pas', 28 | JobMemData in '..\Lib\JobControls\JobMemData.pas', 29 | ParametersJobItem in '..\ParamJob\ParametersJobItem.pas', 30 | ParametersJobItemFrm in '..\ParamJob\ParametersJobItemFrm.pas' {ParametersJobItemForm}, 31 | ReferendesForm in '..\References\ReferendesForm.pas' {JobsReferencesFrame}, 32 | RunJobForm in '..\RunJob\RunJobForm.pas' {RunJobfrm}, 33 | ScripterJobItem in '..\ScriptJob\ScripterJobItem.pas', 34 | ScripterJobItemFrm in '..\ScriptJob\ScripterJobItemFrm.pas' {ScripterJobItemForm}, 35 | SelectJobItem in '..\SelectJob\SelectJobItem.pas' {SelectjobItemForm}, 36 | SQLScriptJobItem in '..\SQLJob\SQLScriptJobItem.pas', 37 | SQLScriptJobItemFrm in '..\SQLJob\SQLScriptJobItemFrm.pas' {SQLScriptJobItemForm}, 38 | JobConverter in '..\Utils\JobConverter.pas', 39 | JobUtils in '..\Utils\JobUtils.pas', 40 | OperationUtils in '..\Utils\OperationUtils.pas', 41 | XMLUtils in '..\Utils\XMLUtils.pas', 42 | ScriptExecutor in '..\ScriptJob\ScriptExecutor.pas', 43 | PascalScriptExecutor in '..\ScriptJob\PascalScriptExecutor.pas', 44 | JavaScriptExecutor in '..\ScriptJob\JavaScriptExecutor.pas', 45 | PascalScriptClassesProxy in '..\ScriptJob\PascalScriptClassesProxy.pas', 46 | uPSI_PascalScriptClassesProxy in '..\ScriptJob\uPSI_PascalScriptClassesProxy.pas', 47 | JobsMain in 'JobsMain.pas' {JobsMainFrame: TFrame}, 48 | TabEditors in '..\CustomJob\TabEditors.pas' {TabEditorsFrame: TFrame}; 49 | 50 | {$R *.res} 51 | 52 | begin 53 | Application.Initialize; 54 | Application.MainFormOnTaskbar := True; 55 | Application.CreateForm(TMainForm, MainForm); 56 | Application.Run; 57 | end. 58 | -------------------------------------------------------------------------------- /src/Main/TaskRunner.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CleverComponents/Task-Runner/cf8374f1eec7e72a8b4e978ad8e2300eb8b6a36c/src/Main/TaskRunner.res -------------------------------------------------------------------------------- /src/Main/TaskRunner_Icon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CleverComponents/Task-Runner/cf8374f1eec7e72a8b4e978ad8e2300eb8b6a36c/src/Main/TaskRunner_Icon.ico -------------------------------------------------------------------------------- /src/ParamJob/ParametersJobItem.pas: -------------------------------------------------------------------------------- 1 | unit ParametersJobItem; 2 | 3 | interface 4 | 5 | uses 6 | System.Classes, JobClasses, System.SysUtils, System.Variants, OperationClasses, CustomJobItems; 7 | 8 | type 9 | TParametersJobDataItem = class(TCustomParametersJobDataItem) 10 | procedure Perform(Visitor: TJobVisitor); override; 11 | end; 12 | 13 | implementation 14 | 15 | uses 16 | JobConsts; 17 | 18 | { TParametersJobDataItem } 19 | 20 | procedure TParametersJobDataItem.Perform(Visitor: TJobVisitor); 21 | var 22 | i: Integer; 23 | Param, VisitorParam: TJobOperationParam; 24 | begin 25 | inherited Perform(Visitor); 26 | 27 | AssignParams(Parameters, Visitor.Params, cParseLexems); 28 | for i := 0 to Parameters.Count - 1 do 29 | begin 30 | Param := Parameters.Items[i]; 31 | VisitorParam := Visitor.Params.FindParam(Param.Name); 32 | 33 | if (VisitorParam = nil) then 34 | begin 35 | Visitor.Params.Add(Param.Name, Param.Value); 36 | Visitor.Log.Add(Format(cParameterAdded, [Param.Name, VarToStr(Param.Value)])); 37 | end else 38 | begin 39 | VisitorParam.Value := Param.Value; 40 | Visitor.Log.Add(Format(cParameterReplaced, [Param.Name, VarToStr(Param.Value)])); 41 | end; 42 | end; 43 | AssignParams(Visitor.Params, Parameters, cParseLexems); 44 | end; 45 | 46 | initialization 47 | RegisterClass(TParametersJobDataItem); 48 | 49 | end. 50 | -------------------------------------------------------------------------------- /src/ParamJob/ParametersJobItemFrm.dfm: -------------------------------------------------------------------------------- 1 | inherited ParametersJobItemForm: TParametersJobItemForm 2 | inherited PageControl: TPageControl 3 | inherited tabDetails: TTabSheet 4 | inherited Panel2: TPanel 5 | inherited Navigator: TDBNavigator 6 | Width = 230 7 | VisibleButtons = [nbFirst, nbPrior, nbNext, nbLast, nbInsert, nbDelete, nbEdit, nbPost, nbCancel, nbRefresh] 8 | Hints.Strings = () 9 | ExplicitWidth = 230 10 | end 11 | end 12 | end 13 | end 14 | end 15 | -------------------------------------------------------------------------------- /src/ParamJob/ParametersJobItemFrm.pas: -------------------------------------------------------------------------------- 1 | unit ParametersJobItemFrm; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, CustomParametersDialog, 7 | Db, StdCtrls, ComCtrls, Grids, DBGrids, DBCtrls, ExtCtrls, CustomDialog, JobClasses, 8 | JobCtrls, Datasnap.DBClient, JobMemData; 9 | 10 | type 11 | TParametersJobItemForm = class(TCustomParamsJobItemForm) 12 | private 13 | procedure DoBeforeRefresh(DataSet: TDataSet); 14 | public 15 | constructor Create(AOwner: TComponent); override; 16 | end; 17 | 18 | TParametersJobEditorItem = class(TCustomJobEditorItem) 19 | protected 20 | function GetEditorFormClass: TCustomDialogFormClass; override; 21 | end; 22 | 23 | implementation 24 | 25 | {$R *.DFM} 26 | 27 | uses 28 | ParametersJobItem, OperationClasses; 29 | 30 | { TParametersJobEditorItem } 31 | 32 | function TParametersJobEditorItem.GetEditorFormClass: TCustomDialogFormClass; 33 | begin 34 | Result := TParametersJobItemForm; 35 | end; 36 | 37 | { TParametersJobItemForm } 38 | 39 | constructor TParametersJobItemForm.Create(AOwner: TComponent); 40 | begin 41 | inherited Create(AOwner); 42 | MemData.BeforeRefresh := DoBeforeRefresh; 43 | end; 44 | 45 | procedure TParametersJobItemForm.DoBeforeRefresh(DataSet: TDataSet); 46 | { procedure FillJobParams(AJob: TJobItem; AParams: TJobOperationParams); 47 | var 48 | i: Integer; 49 | begin 50 | for i := 0 to AJob.ItemsCount - 1 do 51 | begin 52 | AJob.Items[i].Data.GetParameterList(Params); 53 | FillJobParams(AJob.Items[i], AParams); 54 | end; 55 | end;} 56 | 57 | var 58 | i: Integer; 59 | AJob: TJobItem; 60 | Params: TJobOperationParams; 61 | begin 62 | if IsLoading then Exit; 63 | 64 | Params := TJobOperationParams.Create(); 65 | try 66 | for i := 0 to Data.Owner.ItemsCount - 1 do 67 | begin 68 | AJob := Data.Owner.Items[i]; 69 | AJob.Data.GetParameterList(Params); 70 | end; 71 | LoadMemData(Params, True); 72 | IsModified := True; 73 | finally 74 | Params.Free(); 75 | end; 76 | end; 77 | 78 | initialization 79 | RegisterEditorItem(TParametersJobEditorItem, TParametersJobDataItem, 'Parameters'); 80 | 81 | end. 82 | -------------------------------------------------------------------------------- /src/References/ReferendesForm.pas: -------------------------------------------------------------------------------- 1 | unit ReferendesForm; 2 | 3 | interface 4 | 5 | uses 6 | ComCtrls, Forms, OperationUtils, Menus, Classes, Controls, Dialogs, ExtCtrls, JobCtrls, 7 | ImgList, OperationClasses, JobClasses, System.ImageList; 8 | 9 | type 10 | TJobsReferencesFrame = class(TForm) 11 | pCenter: TPanel; 12 | odMediaFile: TOpenDialog; 13 | ingJobFlowAction: TImageList; 14 | ReferencesList: TJobTreeView; 15 | JobPopupMenu: TPopupMenu; 16 | private 17 | FOperationList: TFormOperationList; 18 | FJobManager: TJobManager; 19 | procedure AddOperations; 20 | procedure FillList; 21 | procedure UpdateControls; 22 | procedure InsertJobs(ANode: TTreeNode; AProject: TJobOperationParam); 23 | public 24 | procedure ShowReferences(AOperationList: TFormOperationList; AJobManager: TJobManager); 25 | end; 26 | 27 | implementation 28 | 29 | {$R *.DFM} 30 | 31 | const 32 | cProjectImage = 0; 33 | cJobImage = 1; 34 | 35 | { TJobsReferencesFrame } 36 | 37 | procedure TJobsReferencesFrame.ShowReferences(AOperationList: TFormOperationList; 38 | AJobManager: TJobManager); 39 | begin 40 | FOperationList := AOperationList; 41 | FJobManager := AJobManager; 42 | AddOperations(); 43 | FillList(); 44 | UpdateControls(); 45 | Show(); 46 | end; 47 | 48 | procedure TJobsReferencesFrame.AddOperations; 49 | begin 50 | //TODO 51 | end; 52 | 53 | procedure TJobsReferencesFrame.FillList; 54 | var 55 | i: Integer; 56 | Param: TJobOperationParam; 57 | Node: TTreeNode; 58 | begin 59 | ReferencesList.Items.BeginUpdate(); 60 | try 61 | ReferencesList.Items.Clear(); 62 | Node := nil; 63 | for i := 0 to FJobManager.References.Count - 1 do 64 | begin 65 | Param := FJobManager.References[i]; 66 | Node := ReferencesList.Items.AddObject(Node, Param.Name, Param); 67 | Node.ImageIndex := cProjectImage; 68 | Node.SelectedIndex := cProjectImage; 69 | InsertJobs(Node, Param); 70 | end; 71 | finally 72 | ReferencesList.Items.EndUpdate(); 73 | end; 74 | end; 75 | 76 | procedure TJobsReferencesFrame.InsertJobs(ANode: TTreeNode; AProject: TJobOperationParam); 77 | begin 78 | //TODO 79 | end; 80 | 81 | procedure TJobsReferencesFrame.UpdateControls; 82 | begin 83 | //TODO 84 | end; 85 | 86 | end. 87 | -------------------------------------------------------------------------------- /src/RunJob/RunJobForm.dfm: -------------------------------------------------------------------------------- 1 | object RunJobfrm: TRunJobfrm 2 | Left = 313 3 | Top = 230 4 | Caption = 'Run Job' 5 | ClientHeight = 466 6 | ClientWidth = 504 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'MS Sans Serif' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | Position = poMainFormCenter 15 | OnClose = FormClose 16 | OnCloseQuery = FormCloseQuery 17 | PixelsPerInch = 96 18 | TextHeight = 13 19 | object sidebarSplitter: TSplitter 20 | Left = 0 21 | Top = 233 22 | Width = 504 23 | Height = 4 24 | Cursor = crVSplit 25 | Align = alTop 26 | MinSize = 1 27 | ExplicitTop = 161 28 | ExplicitWidth = 500 29 | end 30 | object PageControl: TPageControl 31 | Left = 0 32 | Top = 237 33 | Width = 504 34 | Height = 229 35 | ActivePage = tabDescription 36 | Align = alClient 37 | TabOrder = 0 38 | object tabDescription: TTabSheet 39 | Caption = 'Description' 40 | object MemoLog: TJobRichEdit 41 | Left = 0 42 | Top = 0 43 | Width = 496 44 | Height = 201 45 | Align = alClient 46 | Font.Charset = RUSSIAN_CHARSET 47 | Font.Color = clWindowText 48 | Font.Height = -11 49 | Font.Name = 'MS Sans Serif' 50 | Font.Style = [] 51 | Constraints.MinHeight = 20 52 | ParentFont = False 53 | PlainText = True 54 | ReadOnly = True 55 | ScrollBars = ssBoth 56 | TabOrder = 0 57 | Zoom = 100 58 | end 59 | end 60 | object tabErrors: TTabSheet 61 | Caption = 'Errors' 62 | ImageIndex = 1 63 | object MemoError: TJobRichEdit 64 | Left = 0 65 | Top = 0 66 | Width = 496 67 | Height = 201 68 | Align = alClient 69 | Font.Charset = RUSSIAN_CHARSET 70 | Font.Color = clWindowText 71 | Font.Height = -11 72 | Font.Name = 'MS Sans Serif' 73 | Font.Style = [] 74 | Constraints.MinHeight = 20 75 | ParentFont = False 76 | PlainText = True 77 | ReadOnly = True 78 | ScrollBars = ssBoth 79 | TabOrder = 0 80 | Zoom = 100 81 | end 82 | end 83 | end 84 | object List: TDBGrid 85 | Left = 0 86 | Top = 0 87 | Width = 504 88 | Height = 233 89 | Align = alTop 90 | DataSource = DataSource 91 | Options = [dgTitles, dgColumnResize, dgColLines, dgRowLines, dgTabs, dgRowSelect] 92 | ReadOnly = True 93 | TabOrder = 1 94 | TitleFont.Charset = DEFAULT_CHARSET 95 | TitleFont.Color = clWindowText 96 | TitleFont.Height = -11 97 | TitleFont.Name = 'MS Sans Serif' 98 | TitleFont.Style = [] 99 | OnCellClick = ListCellClick 100 | OnKeyDown = ListKeyDown 101 | Columns = < 102 | item 103 | Expanded = False 104 | FieldName = 'jobname' 105 | Title.Caption = 'Job Name' 106 | Width = 133 107 | Visible = True 108 | end 109 | item 110 | Expanded = False 111 | FieldName = 'currentjobname' 112 | Title.Caption = 'Current Job Name' 113 | Width = 261 114 | Visible = True 115 | end 116 | item 117 | Expanded = False 118 | FieldName = 'jobstate' 119 | Title.Caption = 'State' 120 | Width = 82 121 | Visible = True 122 | end> 123 | end 124 | object DataSource: TDataSource 125 | DataSet = MemData 126 | Left = 152 127 | Top = 112 128 | end 129 | object MemData: TJobMemData 130 | Aggregates = <> 131 | Params = <> 132 | Left = 214 133 | Top = 114 134 | object MemDatajobname: TStringField 135 | DisplayWidth = 150 136 | FieldName = 'jobname' 137 | Size = 150 138 | end 139 | object MemDatacurrentjobname: TStringField 140 | DisplayWidth = 150 141 | FieldName = 'currentjobname' 142 | Size = 150 143 | end 144 | object MemDatajobstate: TStringField 145 | FieldName = 'jobstate' 146 | end 147 | object MemDatavisitor: TIntegerField 148 | FieldName = 'visitor' 149 | end 150 | object MemDatalog: TBlobField 151 | FieldName = 'log' 152 | end 153 | object MemDataerrors: TBlobField 154 | FieldName = 'errors' 155 | end 156 | object MemDataisrun: TBooleanField 157 | FieldName = 'isrun' 158 | end 159 | object MemDatacurrentjob: TIntegerField 160 | FieldName = 'currentjob' 161 | end 162 | end 163 | end 164 | -------------------------------------------------------------------------------- /src/SQLJob/SQLScriptJobItem.pas: -------------------------------------------------------------------------------- 1 | unit SQLScriptJobItem; 2 | 3 | interface 4 | 5 | uses 6 | System.Classes, JobClasses, System.SysUtils, System.Variants, CustomJobItems, JobUtils, ADODB, OperationClasses, JobConsts, 7 | Winapi.msxml, Data.DB; 8 | 9 | type 10 | TSQLScriptJobDataItem = class(TCustomScriptJobDataItem) 11 | private 12 | FConnectionInfo: TSQLConnectionInfo; 13 | FOldConnectionInfo: TSQLConnectionInfo; 14 | FPerformWith: TSQLPerformWith; 15 | FJobUtilities: TJobUtilities; 16 | procedure PerformWithADO(Visitor: TJobVisitor); 17 | procedure PerformWithOSQL(Visitor: TJobVisitor); 18 | procedure SetPerformWith(const Value: TSQLPerformWith); 19 | procedure SetConnectionInfo(const Value: TSQLConnectionInfo); 20 | procedure ConnectionChangeEvent(Source: TObject); 21 | protected 22 | procedure DoBeforePerform(Visitor: TJobVisitor); override; 23 | procedure DoAfterPerform(Visitor: TJobVisitor); override; 24 | function GetWordDelimiters: String; override; 25 | procedure InitData; override; 26 | public 27 | constructor Create(AOwner: TJobItem); override; 28 | destructor Destroy; override; 29 | 30 | function Load(AStream: TStream): Integer; overload; override; 31 | procedure Load(ANode: IXMLDOMNode); overload; override; 32 | procedure Store(ANode: IXMLDOMNode); override; 33 | procedure Perform(Visitor: TJobVisitor); override; 34 | procedure Assign(Source: TPersistent); override; 35 | procedure GetParameterList(AList: TJobOperationParams); override; 36 | 37 | property ConnectionInfo: TSQLConnectionInfo read FConnectionInfo write SetConnectionInfo; 38 | property PerformWith: TSQLPerformWith read FPerformWith write SetPerformWith; 39 | end; 40 | 41 | implementation 42 | 43 | uses 44 | XMLUtils; 45 | 46 | { TSQLScriptJobDataItem } 47 | 48 | procedure TSQLScriptJobDataItem.Assign(Source: TPersistent); 49 | var 50 | Data: TSQLScriptJobDataItem; 51 | begin 52 | inherited Assign(Source); 53 | BeginUpdate(); 54 | try 55 | if (Source is TSQLScriptJobDataItem) then 56 | begin 57 | Data := TSQLScriptJobDataItem(Source); 58 | FConnectionInfo.Assign(Data.ConnectionInfo); 59 | FPerformWith := Data.PerformWith; 60 | end else 61 | begin 62 | InitData(); 63 | end; 64 | finally 65 | EndUpdate(); 66 | end; 67 | end; 68 | 69 | procedure TSQLScriptJobDataItem.ConnectionChangeEvent(Source: TObject); 70 | begin 71 | DoDataChanged(); 72 | end; 73 | 74 | constructor TSQLScriptJobDataItem.Create(AOwner: TJobItem); 75 | var 76 | i: Integer; 77 | begin 78 | inherited Create(AOwner); 79 | FJobUtilities := TJobUtilities.Create(); 80 | FConnectionInfo := TSQLConnectionInfo.Create(); 81 | FConnectionInfo.OnChanged := ConnectionChangeEvent; 82 | FOldConnectionInfo := TSQLConnectionInfo.Create(); 83 | FPerformWith := spOSQLUtilite; 84 | for i := Low(cSQLErrorWords) to High(cSQLErrorWords) do 85 | begin 86 | ErrorWords.Add(cSQLErrorWords[i]); 87 | end; 88 | end; 89 | 90 | destructor TSQLScriptJobDataItem.Destroy; 91 | begin 92 | FOldConnectionInfo.Free(); 93 | FConnectionInfo.Free(); 94 | FJobUtilities.Free(); 95 | inherited Destroy(); 96 | end; 97 | 98 | procedure TSQLScriptJobDataItem.DoAfterPerform(Visitor: TJobVisitor); 99 | begin 100 | FConnectionInfo.Assign(FOldConnectionInfo); 101 | inherited DoAfterPerform(Visitor); 102 | end; 103 | 104 | procedure TSQLScriptJobDataItem.DoBeforePerform(Visitor: TJobVisitor); 105 | begin 106 | inherited DoBeforePerform(Visitor); 107 | 108 | FOldConnectionInfo.Assign(FConnectionInfo); 109 | 110 | FConnectionInfo.Server := ReplaceIfNeedParam(Visitor.Params, FConnectionInfo.Server); 111 | FConnectionInfo.User := ReplaceIfNeedParam(Visitor.Params, FConnectionInfo.User); 112 | FConnectionInfo.Password := ReplaceIfNeedParam(Visitor.Params, FConnectionInfo.Password); 113 | FConnectionInfo.Database := ReplaceIfNeedParam(Visitor.Params, FConnectionInfo.Database); 114 | FConnectionInfo.TimeOut := ReplaceIfNeedParam(Visitor.Params, FConnectionInfo.TimeOut); 115 | FConnectionInfo.ConnectionString := ReplaceIfNeedParam(Visitor.Params, FConnectionInfo.ConnectionString); 116 | end; 117 | 118 | procedure TSQLScriptJobDataItem.GetParameterList(AList: TJobOperationParams); 119 | procedure AddIfNeedParameter(AParam: String); 120 | var 121 | S: String; 122 | begin 123 | if IsValueParameter(AParam, S) then 124 | begin 125 | AList.Add(S, NULL); 126 | end; 127 | end; 128 | 129 | begin 130 | inherited GetParameterList(AList); 131 | AddIfNeedParameter(FConnectionInfo.Server); 132 | AddIfNeedParameter(FConnectionInfo.User); 133 | AddIfNeedParameter(FConnectionInfo.Password); 134 | AddIfNeedParameter(FConnectionInfo.Database); 135 | AddIfNeedParameter(FConnectionInfo.TimeOut); 136 | AddIfNeedParameter(FConnectionInfo.ConnectionString); 137 | end; 138 | 139 | function TSQLScriptJobDataItem.GetWordDelimiters: String; 140 | begin 141 | Result := cSQLScriptWordDelimiters; 142 | end; 143 | 144 | procedure TSQLScriptJobDataItem.InitData; 145 | begin 146 | inherited InitData(); 147 | FConnectionInfo.Assign(nil); 148 | FPerformWith := spOSQLUtilite; 149 | end; 150 | 151 | function TSQLScriptJobDataItem.Load(AStream: TStream): Integer; 152 | var 153 | R: TReader; 154 | begin 155 | Result := inherited Load(AStream); 156 | 157 | BeginUpdate(); 158 | try 159 | if (Result > 3) then 160 | begin 161 | AStream.Read(FPerformWith, SizeOf(FPerformWith)); 162 | FConnectionInfo.Load(AStream); 163 | end else 164 | begin 165 | R := TReader.Create(AStream, 1024); 166 | try 167 | FConnectionInfo.Server := R.ReadString(); 168 | FConnectionInfo.User := R.ReadString(); 169 | FConnectionInfo.Password := R.ReadString(); 170 | FConnectionInfo.Database := R.ReadString(); 171 | 172 | if (Result > 2) then 173 | begin 174 | FConnectionInfo.TimeOut := R.ReadString(); 175 | end else 176 | begin 177 | FConnectionInfo.TimeOut := IntToStr(R.ReadInteger()); 178 | end; 179 | FPerformWith := TSQLPerformWith(R.ReadInteger()); 180 | finally 181 | R.Free(); 182 | end; 183 | end; 184 | finally 185 | EndUpdate(); 186 | end; 187 | end; 188 | 189 | procedure TSQLScriptJobDataItem.Load(ANode: IXMLDOMNode); 190 | var 191 | ChildNode: IXMLDOMNode; 192 | ind: Integer; 193 | begin 194 | inherited Load(ANode); 195 | BeginUpdate(); 196 | try 197 | ChildNode := ANode.selectSingleNode('PerformWith'); 198 | if ChildNode <> nil then 199 | begin 200 | ind := GetArrayIndexByName(ChildNode.text, cStoreSQLPerformWithNames); 201 | if (ind > -1) then FPerformWith := TSQLPerformWith(ind); 202 | end; 203 | 204 | ChildNode := ANode.selectSingleNode('ConnectionInfo'); 205 | if ChildNode <> nil then FConnectionInfo.Load(ChildNode); 206 | finally 207 | EndUpdate(); 208 | end; 209 | end; 210 | 211 | procedure TSQLScriptJobDataItem.Perform(Visitor: TJobVisitor); 212 | begin 213 | inherited Perform(Visitor); 214 | case FPerformWith of 215 | spOSQLUtilite: PerformWithOSQL(Visitor); 216 | spADOLibrary: PerformWithADO(Visitor); 217 | end; 218 | end; 219 | 220 | procedure TSQLScriptJobDataItem.PerformWithADO(Visitor: TJobVisitor); 221 | var 222 | i: Integer; 223 | Query: TADOQuery; 224 | S: String; 225 | AOutput: TStrings; 226 | begin 227 | Query := TADOQuery.Create(nil); 228 | AOutput := TStringList.Create(); 229 | try 230 | if (FConnectionInfo.ConnectionString <> '') then 231 | begin 232 | Query.ConnectionString := FConnectionInfo.ConnectionString; 233 | end else 234 | begin 235 | Query.ConnectionString := FConnectionInfo.CreateConnectionString(); 236 | end; 237 | if IsUseScriptFile then 238 | begin 239 | Query.SQL.LoadFromFile(ScriptFile); 240 | end else 241 | begin 242 | Query.SQL.Assign(Script); 243 | end; 244 | Query.Open(); 245 | 246 | S := ''; 247 | for i := 0 to Query.FieldCount - 1 do 248 | begin 249 | S := S + Query.Fields[i].FieldName + ', '; 250 | end; 251 | AOutput.Add(S); 252 | while not Query.Eof do 253 | begin 254 | S := ''; 255 | for i := 0 to Query.FieldCount - 1 do 256 | begin 257 | S := S + Query.Fields[i].AsString + ', '; 258 | end; 259 | AOutput.Add(S); 260 | Query.Next(); 261 | end; 262 | 263 | if IsUseLogFile then 264 | begin 265 | AOutput.SaveToFile(LogFile); 266 | end else 267 | begin 268 | Visitor.Log.Assign(AOutput); 269 | end; 270 | finally 271 | AOutput.Free(); 272 | Query.Free(); 273 | end; 274 | end; 275 | 276 | procedure TSQLScriptJobDataItem.PerformWithOSQL(Visitor: TJobVisitor); 277 | var 278 | CommandLine: String; 279 | AOutput, AErrors: TStrings; 280 | ATimeOut: Integer; 281 | begin 282 | try 283 | ATimeOut := StrToInt(FConnectionInfo.TimeOut); 284 | except 285 | ATimeOut := - 1; 286 | end; 287 | AOutput := TStringList.Create(); 288 | AErrors := TStringList.Create(); 289 | try 290 | CommandLine := 'osql.exe /U ' + FConnectionInfo.User + ' /d ' + FConnectionInfo.Database 291 | + ' /P ' + FConnectionInfo.Password + ' /S ' + FConnectionInfo.Server + ' /w8192 /n'; 292 | if IsUseScriptFile then 293 | begin 294 | CommandLine := CommandLine + ' /i ' + ScriptFile; 295 | end else 296 | begin 297 | CommandLine := CommandLine + ' /i ' + cJobInputFile; 298 | end; 299 | if IsUseLogFile then 300 | begin 301 | CommandLine := CommandLine + ' /o ' + LogFile; 302 | end else 303 | begin 304 | CommandLine := CommandLine + ' /o ' + cJobOutFile; 305 | end; 306 | if (ATimeOut > 0) then 307 | begin 308 | CommandLine := CommandLine + ' /l ' + IntToStr(ATimeOut); 309 | end; 310 | 311 | FJobUtilities.PerformFile(CommandLine, Script, AOutput, AErrors); 312 | 313 | if IsUseLogFile then 314 | begin 315 | AOutput.Add(Format(cJobLogInFile, [LogFile])); 316 | end else 317 | begin 318 | CheckForErrorsInLog(AOutput); 319 | end; 320 | finally 321 | Visitor.Log.AddStrings(AOutput); 322 | Visitor.Errors.AddStrings(AErrors); 323 | AErrors.Free(); 324 | AOutput.Free(); 325 | end; 326 | end; 327 | 328 | procedure TSQLScriptJobDataItem.SetConnectionInfo(const Value: TSQLConnectionInfo); 329 | begin 330 | FConnectionInfo.Assign(Value); 331 | end; 332 | 333 | procedure TSQLScriptJobDataItem.SetPerformWith(const Value: TSQLPerformWith); 334 | begin 335 | if (FPerformWith <> Value) then 336 | begin 337 | FPerformWith := Value; 338 | DoDataChanged(); 339 | end; 340 | end; 341 | 342 | procedure TSQLScriptJobDataItem.Store(ANode: IXMLDOMNode); 343 | var 344 | ChildNode: IXMLDOMNode; 345 | begin 346 | inherited Store(ANode); 347 | 348 | ChildNode := ANode.ownerDocument.createElement('PerformWith'); 349 | ANode.appendChild(ChildNode); 350 | ChildNode.text := cStoreSQLPerformWithNames[FPerformWith]; 351 | 352 | ChildNode := ANode.ownerDocument.createElement('ConnectionInfo'); 353 | ANode.appendChild(ChildNode); 354 | FConnectionInfo.Store(ChildNode); 355 | end; 356 | 357 | initialization 358 | RegisterClass(TSQLScriptJobDataItem); 359 | 360 | end. 361 | -------------------------------------------------------------------------------- /src/SQLJob/SQLScriptJobItemFrm.dfm: -------------------------------------------------------------------------------- 1 | inherited SQLScriptJobItemForm: TSQLScriptJobItemForm 2 | inherited PageControl: TPageControl 3 | inherited tabDetails: TTabSheet 4 | ExplicitLeft = 4 5 | ExplicitTop = 4 6 | ExplicitWidth = 524 7 | inherited memoScript: TJobRichEdit 8 | Top = 40 9 | Height = 366 10 | ExplicitTop = 40 11 | ExplicitHeight = 366 12 | end 13 | inherited sbScript: TStatusBar 14 | Panels = < 15 | item 16 | Alignment = taRightJustify 17 | Text = 'Ln 1, Col 1' 18 | Width = 10 19 | end> 20 | end 21 | object pConnection: TPanel 22 | Left = 0 23 | Top = 0 24 | Width = 524 25 | Height = 40 26 | Align = alTop 27 | BevelOuter = bvNone 28 | TabOrder = 2 29 | object btnConnection: TButton 30 | Left = 5 31 | Top = 7 32 | Width = 72 33 | Height = 22 34 | Caption = 'Connection' 35 | TabOrder = 0 36 | OnClick = btnConnectionClick 37 | end 38 | end 39 | end 40 | inherited tabAddition: TTabSheet 41 | inherited pAddTop: TPanel 42 | object lblPerformWith: TLabel [3] 43 | Left = 258 44 | Top = 37 45 | Width = 61 46 | Height = 13 47 | Caption = 'Perform With' 48 | end 49 | inherited edtCanPerform: TEdit 50 | TabOrder = 7 51 | end 52 | object cmbPerformWith: TJobComboBox 53 | Left = 328 54 | Top = 34 55 | Width = 145 56 | Height = 21 57 | Color = clBtnFace 58 | TabOrder = 6 59 | OnChange = cmbPerformWithChange 60 | end 61 | end 62 | end 63 | end 64 | end 65 | -------------------------------------------------------------------------------- /src/SQLJob/SQLScriptJobItemFrm.pas: -------------------------------------------------------------------------------- 1 | unit SQLScriptJobItemFrm; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 | StdCtrls, ExtCtrls, ToolWin, ComCtrls, CustomDialog, JobConsts, JobClasses, 8 | CustomScriptDialog, JobUtils, JobCtrls; 9 | 10 | type 11 | TSQLScriptJobItemForm = class(TCustomScriptJobItemForm) 12 | btnConnection: TButton; 13 | cmbPerformWith: TJobComboBox; 14 | lblPerformWith: TLabel; 15 | pConnection: TPanel; 16 | procedure btnConnectionClick(Sender: TObject); 17 | procedure cmbPerformWithChange(Sender: TObject); 18 | private 19 | FConnectionInfo: TSQLConnectionInfo; 20 | procedure DoChangeConnection(); 21 | function GetPerformWith: TSQLPerformWith; 22 | procedure SetPerformWith(AValue: TSQLPerformWith); 23 | protected 24 | procedure UpdateControls; override; 25 | procedure AssignData(IsFromDataItem: Boolean = False); override; 26 | public 27 | constructor Create(AOwner: TComponent); override; 28 | destructor Destroy; override; 29 | end; 30 | 31 | TSQLScriptJobEditorItem = class(TCustomJobEditorItem) 32 | protected 33 | function GetEditorFormClass: TCustomDialogFormClass; override; 34 | end; 35 | 36 | implementation 37 | 38 | {$R *.DFM} 39 | 40 | uses 41 | SQLScriptJobItem, ConnectionSetup; 42 | 43 | { TSQLScriptJobItemForm } 44 | 45 | procedure TSQLScriptJobItemForm.AssignData(IsFromDataItem: Boolean); 46 | begin 47 | inherited AssignData(IsFromDataItem); 48 | if IsFromDataItem then 49 | begin 50 | FConnectionInfo.Assign(TSQLScriptJobDataItem(Data).ConnectionInfo); 51 | SetPerformWith(TSQLScriptJobDataItem(Data).PerformWith); 52 | end else 53 | begin 54 | TSQLScriptJobDataItem(Data).ConnectionInfo.Assign(FConnectionInfo); 55 | TSQLScriptJobDataItem(Data).PerformWith := GetPerformWith(); 56 | end; 57 | end; 58 | 59 | procedure TSQLScriptJobItemForm.btnConnectionClick(Sender: TObject); 60 | begin 61 | DoChangeConnection(); 62 | end; 63 | 64 | procedure TSQLScriptJobItemForm.cmbPerformWithChange(Sender: TObject); 65 | begin 66 | if IsLoading then Exit; 67 | IsModified := True; 68 | UpdateControls(); 69 | end; 70 | 71 | procedure TSQLScriptJobItemForm.DoChangeConnection; 72 | var 73 | performWith: TSQLPerformWith; 74 | begin 75 | performWith := GetPerformWith(); 76 | if ShowConnectionSetup(FConnectionInfo, ReadOnly, performWith) then 77 | begin 78 | SetPerformWith(performWith); 79 | IsModified := True; 80 | UpdateControls(); 81 | end; 82 | end; 83 | 84 | function TSQLScriptJobItemForm.GetPerformWith: TSQLPerformWith; 85 | var 86 | Index: Integer; 87 | begin 88 | Index := cmbPerformWith.ItemIndex; 89 | if (Index < 0) then 90 | begin 91 | Result := Low(TSQLPerformWith); 92 | end else 93 | begin 94 | Result := TSQLPerformWith(Index); 95 | end; 96 | end; 97 | 98 | procedure TSQLScriptJobItemForm.SetPerformWith(AValue: TSQLPerformWith); 99 | begin 100 | cmbPerformWith.ItemIndex := Integer(AValue); 101 | end; 102 | 103 | procedure TSQLScriptJobItemForm.UpdateControls; 104 | begin 105 | inherited UpdateControls(); 106 | 107 | btnErrorWords.Enabled := (not ReadOnly) and (GetPerformWith() = spOSQLUtilite); 108 | cmbFlowAction.Enabled := not ReadOnly; 109 | end; 110 | 111 | constructor TSQLScriptJobItemForm.Create(AOwner: TComponent); 112 | var 113 | i: TSQLPerformWith; 114 | begin 115 | inherited Create(AOwner); 116 | 117 | FConnectionInfo := TSQLConnectionInfo.Create(); 118 | 119 | cmbPerformWith.Items.Clear(); 120 | for i := Low(cSQLPerformWithNames) to High(cSQLPerformWithNames) do 121 | begin 122 | cmbPerformWith.Items.Add(cSQLPerformWithNames[i]); 123 | end; 124 | end; 125 | 126 | destructor TSQLScriptJobItemForm.Destroy; 127 | begin 128 | FConnectionInfo.Free(); 129 | inherited Destroy(); 130 | end; 131 | 132 | { TCustomJobEditorItem } 133 | 134 | function TSQLScriptJobEditorItem.GetEditorFormClass: TCustomDialogFormClass; 135 | begin 136 | Result := TSQLScriptJobItemForm; 137 | end; 138 | 139 | initialization 140 | RegisterEditorItem(TSQLScriptJobEditorItem, TSQLScriptJobDataItem, 'SQL Script'); 141 | 142 | end. 143 | -------------------------------------------------------------------------------- /src/ScriptJob/JavaScriptExecutor.pas: -------------------------------------------------------------------------------- 1 | unit JavaScriptExecutor; 2 | 3 | interface 4 | 5 | uses 6 | System.Classes, System.SysUtils, Winapi.Windows, 7 | JobClasses, OperationClasses, ScriptExecutor, JobConsts, 8 | SpiderMonkey, SyNode, SynCommons, SyNodeProto, SyNodeSimpleProto; 9 | 10 | type 11 | {$M+} 12 | TJavaScriptJobParamsProxy = class 13 | private 14 | FParams: TJobOperationParams; 15 | public 16 | constructor Create(AParams: TJobOperationParams); 17 | published 18 | function setParam(cx: PJSContext; argc: uintN; var vp: JSArgRec): Boolean; 19 | function getParam(cx: PJSContext; argc: uintN; var vp: JSArgRec): Boolean; 20 | end; 21 | 22 | TJavaScriptJobLogProxy = class 23 | private 24 | FLog: TStrings; 25 | public 26 | constructor Create(ALog: TStrings); 27 | published 28 | function add(cx: PJSContext; argc: uintN; var vp: JSArgRec): Boolean; 29 | end; 30 | {$M-} 31 | 32 | 33 | TJavaScriptExecutor = class(TScriptExecutor) 34 | private 35 | FParamsProxy: TJavaScriptJobParamsProxy; 36 | FLogProxy: TJavaScriptJobLogProxy; 37 | 38 | procedure DoOnCreateNewEngine(const aEngine: TSMEngine); 39 | function DoOnGetEngineName(const AEngine: TSMEngine): RawUTF8; 40 | public 41 | function GetParseLexems: string; override; 42 | function GetWordDelimiters: string; override; 43 | procedure Execute(AVisitor: TJobVisitor); override; 44 | end; 45 | 46 | implementation 47 | 48 | {$I Synopse.inc} 49 | {$I SynSM.inc} 50 | {$I SyNode.inc} 51 | 52 | { TJavaScriptExecutor } 53 | 54 | procedure TJavaScriptExecutor.DoOnCreateNewEngine(const AEngine: TSMEngine); 55 | begin 56 | AEngine.defineClass(FParamsProxy.ClassType, TSMSimpleRTTIProtoObject, AEngine.GlobalObject); 57 | AEngine.GlobalObject.ptr.DefineProperty(AEngine.cx, cJavaScriptParams, 58 | CreateJSInstanceObjForSimpleRTTI(AEngine.cx, FParamsProxy, AEngine.GlobalObject), 59 | JSPROP_ENUMERATE or JSPROP_READONLY or JSPROP_PERMANENT 60 | ); 61 | 62 | AEngine.defineClass(FLogProxy.ClassType, TSMSimpleRTTIProtoObject, AEngine.GlobalObject); 63 | AEngine.GlobalObject.ptr.DefineProperty(AEngine.cx, cJavaScriptJobLog, 64 | CreateJSInstanceObjForSimpleRTTI(AEngine.cx, FLogProxy, AEngine.GlobalObject), 65 | JSPROP_ENUMERATE or JSPROP_READONLY or JSPROP_PERMANENT 66 | ); 67 | end; 68 | 69 | function TJavaScriptExecutor.DoOnGetEngineName(const AEngine: TSMEngine): RawUTF8; 70 | begin 71 | Result := RawUTF8(Format('TaskRunnerScript%d', [GetCurrentThreadId()])); 72 | end; 73 | 74 | procedure TJavaScriptExecutor.Execute(AVisitor: TJobVisitor); 75 | var 76 | res: jsval; 77 | manager: TSMEngineManager; 78 | engine: TSMEngine; 79 | output: TStrings; 80 | begin 81 | manager := TSMEngineManager.Create(''); 82 | try 83 | manager.MaxPerEngineMemory := 512 * 1024 * 1024; 84 | manager.OnNewEngine := DoOnCreateNewEngine; 85 | manager.OnGetName := DoOnGetEngineName; 86 | 87 | output := nil; 88 | FParamsProxy := nil; 89 | FLogProxy := nil; 90 | try 91 | FParamsProxy := TJavaScriptJobParamsProxy.Create(AVisitor.Params); 92 | 93 | if IsUseLogFile then 94 | begin 95 | FLogProxy := TJavaScriptJobLogProxy.Create(output); 96 | AVisitor.Log.Add(Format(cJobLogInFile, [LogFile])); 97 | end else 98 | begin 99 | FLogProxy := TJavaScriptJobLogProxy.Create(AVisitor.Log); 100 | end; 101 | 102 | engine := manager.ThreadSafeEngine(nil); 103 | engine.Evaluate(Script.Text, 'script.js', 1, res); 104 | finally 105 | FreeAndNil(FLogProxy); 106 | FreeAndNil(FParamsProxy); 107 | if IsUseLogFile then 108 | begin 109 | output.SaveToFile(LogFile); 110 | end; 111 | output.Free(); 112 | end; 113 | finally 114 | manager.ReleaseCurrentThreadEngine(); 115 | manager.Free(); 116 | end; 117 | end; 118 | 119 | function TJavaScriptExecutor.GetParseLexems: string; 120 | begin 121 | Result := cJavaScriptParseLexems; 122 | end; 123 | 124 | function TJavaScriptExecutor.GetWordDelimiters: string; 125 | begin 126 | Result := cJavaScriptWordDelimiters; 127 | end; 128 | 129 | { TJavaScriptJobParamsProxy } 130 | 131 | constructor TJavaScriptJobParamsProxy.Create(AParams: TJobOperationParams); 132 | begin 133 | inherited Create(); 134 | FParams := AParams; 135 | end; 136 | 137 | function TJavaScriptJobParamsProxy.getParam(cx: PJSContext; argc: uintN; var vp: JSArgRec): Boolean; 138 | var 139 | jobParam: TJobOperationParam; 140 | begin 141 | try 142 | if (argc <> 1) or (not vp.argv[0].isString) then 143 | begin 144 | raise Exception.Create(cScriptGetParamError); 145 | end; 146 | 147 | jobParam := FParams.ParamByName(vp.argv[0].asJSString.ToString(cx)); 148 | vp.rval := SimpleVariantToJSval(cx, jobParam.Value); 149 | 150 | Result := true; 151 | except 152 | on E: Exception do 153 | begin 154 | Result := False; 155 | JSError(cx, E); 156 | end; 157 | end; 158 | end; 159 | 160 | function TJavaScriptJobParamsProxy.setParam(cx: PJSContext; argc: uintN; var vp: JSArgRec): Boolean; 161 | var 162 | jobParam: TJobOperationParam; 163 | begin 164 | try 165 | if (argc <> 2) then 166 | begin 167 | raise Exception.Create(cScriptSetParamError); 168 | end; 169 | 170 | if not (vp.argv[0].isString and vp.argv[1].isString) then 171 | begin 172 | raise Exception.Create(cScriptSetParamError); 173 | end; 174 | 175 | jobParam := FParams.ParamByName(vp.argv[0].asJSString.ToString(cx)); 176 | jobParam.Value := vp.argv[1].asJSString.ToString(cx); 177 | 178 | Result := True; 179 | except 180 | on E: Exception do 181 | begin 182 | Result := False; 183 | JSError(cx, E); 184 | end; 185 | end; 186 | end; 187 | 188 | { TJavaScriptJobLogProxy } 189 | 190 | function TJavaScriptJobLogProxy.add(cx: PJSContext; argc: uintN; var vp: JSArgRec): Boolean; 191 | begin 192 | try 193 | if (argc <> 1) or (not vp.argv[0].isString) then 194 | begin 195 | raise Exception.Create(cScriptAddLogError); 196 | end; 197 | 198 | FLog.Add(vp.argv[0].asJSString.ToString(cx)); 199 | 200 | Result := True; 201 | except 202 | on E: Exception do 203 | begin 204 | Result := False; 205 | JSError(cx, E); 206 | end; 207 | end; 208 | end; 209 | 210 | constructor TJavaScriptJobLogProxy.Create(ALog: TStrings); 211 | begin 212 | inherited Create(); 213 | FLog := ALog; 214 | end; 215 | 216 | initialization 217 | InitJS(); 218 | 219 | finalization 220 | ShutDownJS(); 221 | 222 | end. 223 | -------------------------------------------------------------------------------- /src/ScriptJob/PascalScriptClassesProxy.pas: -------------------------------------------------------------------------------- 1 | unit PascalScriptClassesProxy; 2 | 3 | interface 4 | 5 | type 6 | TPascalScriptJobParamsProxy = class 7 | public 8 | procedure SetParam(const AName, AValue: string); virtual; 9 | function GetParam(const AName: string): string; virtual; 10 | end; 11 | 12 | implementation 13 | 14 | { TPascalScriptJobParamsProxy } 15 | 16 | function TPascalScriptJobParamsProxy.GetParam(const AName: string): string; 17 | begin 18 | Assert(False); 19 | end; 20 | 21 | procedure TPascalScriptJobParamsProxy.SetParam(const AName, AValue: string); 22 | begin 23 | Assert(False); 24 | end; 25 | 26 | end. 27 | -------------------------------------------------------------------------------- /src/ScriptJob/PascalScriptExecutor.pas: -------------------------------------------------------------------------------- 1 | unit PascalScriptExecutor; 2 | 3 | interface 4 | 5 | uses 6 | System.Classes, System.SysUtils, System.Variants, 7 | JobClasses, ScriptExecutor, JobConsts, OperationClasses, PascalScriptClassesProxy, 8 | uPSComponent, uPSComponent_Default, uPSC_classes, uPSI_PascalScriptClassesProxy; 9 | 10 | type 11 | TPascalScriptJobParamsProxyImpl = class(TPascalScriptJobParamsProxy) 12 | private 13 | FParams: TJobOperationParams; 14 | public 15 | constructor Create(AParams: TJobOperationParams); 16 | 17 | procedure SetParam(const AName, AValue: string); override; 18 | function GetParam(const AName: string): string; override; 19 | end; 20 | 21 | TPascalScriptExecutor = class(TScriptExecutor) 22 | private 23 | FLog: TStrings; 24 | FParamsProxy: TPascalScriptJobParamsProxy; 25 | 26 | procedure GetCompileErrors(AScript: TPSScript; AErrors: TStrings); 27 | procedure GetExecuteErrors(AScript: TPSScript; AErrors: TStrings); 28 | procedure ScriptCompile(AScript: TPSScript); 29 | procedure ScriptExecute(AScript: TPSScript); 30 | public 31 | function GetParseLexems: string; override; 32 | function GetWordDelimiters: string; override; 33 | procedure Execute(AVisitor: TJobVisitor); override; 34 | end; 35 | 36 | implementation 37 | 38 | { TPascalScriptExecutor } 39 | 40 | procedure TPascalScriptExecutor.Execute(AVisitor: TJobVisitor); 41 | procedure InitScripter(AScripter: TPSScript; ALog: TStrings); 42 | begin 43 | AScripter.Script := Script; 44 | FLog := ALog; 45 | end; 46 | 47 | var 48 | output: TStrings; 49 | classesPlugin: TPSImport_Classes; 50 | psScript: TPSScript; 51 | pluginItem: TPSPluginItem; 52 | paramsPlugin: TPSImport_PascalScriptJobParamsProxy; 53 | begin 54 | psScript := nil; 55 | classesPlugin := nil; 56 | paramsPlugin := nil; 57 | FParamsProxy := nil; 58 | FLog := nil; 59 | try 60 | psScript := TPSScript.Create(nil); 61 | psScript.OnCompile := ScriptCompile; 62 | psScript.OnExecute := ScriptExecute; 63 | 64 | paramsPlugin := TPSImport_PascalScriptJobParamsProxy.Create(nil); 65 | pluginItem := psScript.Plugins.Add() as TPSPluginItem; 66 | pluginItem.Plugin := paramsPlugin; 67 | 68 | classesPlugin := TPSImport_Classes.Create(nil); 69 | pluginItem := psScript.Plugins.Add() as TPSPluginItem; 70 | pluginItem.Plugin := classesPlugin; 71 | 72 | FParamsProxy := TPascalScriptJobParamsProxyImpl.Create(AVisitor.Params); 73 | 74 | output := TStringList.Create(); 75 | try 76 | if IsUseLogFile then 77 | begin 78 | InitScripter(psScript, output); 79 | AVisitor.Log.Add(Format(cJobLogInFile, [LogFile])); 80 | end else 81 | begin 82 | InitScripter(psScript, AVisitor.Log); 83 | end; 84 | 85 | if not psScript.Compile() then 86 | begin 87 | GetCompileErrors(psScript, AVisitor.Errors); 88 | raise Exception.Create(cScriptError); 89 | end; 90 | 91 | if not psScript.Execute() then 92 | begin 93 | GetExecuteErrors(psScript, AVisitor.Errors); 94 | raise Exception.Create(cScriptError); 95 | end; 96 | 97 | if (AVisitor.Errors.Count > 0) then 98 | begin 99 | raise Exception.Create(cScriptError); 100 | end; 101 | finally 102 | if IsUseLogFile then 103 | begin 104 | output.SaveToFile(LogFile); 105 | end; 106 | output.Free(); 107 | end; 108 | finally 109 | FLog := nil; 110 | FreeAndNil(FParamsProxy); 111 | paramsPlugin.Free(); 112 | classesPlugin.Free(); 113 | psScript.Free(); 114 | end; 115 | end; 116 | 117 | procedure TPascalScriptExecutor.GetCompileErrors(AScript: TPSScript; AErrors: TStrings); 118 | var 119 | i: Integer; 120 | begin 121 | for i := 0 to AScript.CompilerMessageCount - 1 do 122 | begin 123 | AErrors.Add(string(AScript.CompilerMessages[i].MessageToString())); 124 | end; 125 | end; 126 | 127 | procedure TPascalScriptExecutor.GetExecuteErrors(AScript: TPSScript; AErrors: TStrings); 128 | begin 129 | AErrors.Add(string(AScript.ExecErrorToString) + 130 | Format('(Line: %d, Pos: %d)', [AScript.ExecErrorRow, AScript.ExecErrorCol])); 131 | end; 132 | 133 | function TPascalScriptExecutor.GetParseLexems: string; 134 | begin 135 | Result := cPascalScriptParseLexems; 136 | end; 137 | 138 | function TPascalScriptExecutor.GetWordDelimiters: string; 139 | begin 140 | Result := cPascalScriptWordDelimiters; 141 | end; 142 | 143 | procedure TPascalScriptExecutor.ScriptCompile(AScript: TPSScript); 144 | begin 145 | AScript.AddRegisteredPTRVariable(cPascalScriptParams, 'TPascalScriptJobParamsProxy'); 146 | AScript.AddRegisteredPTRVariable(cPascalScriptJobLog, 'TStrings') 147 | end; 148 | 149 | procedure TPascalScriptExecutor.ScriptExecute(AScript: TPSScript); 150 | begin 151 | AScript.SetPointerToData(cPascalScriptParams, @FParamsProxy, 152 | AScript.FindNamedType('TPascalScriptJobParamsProxy')); 153 | 154 | AScript.SetPointerToData(cPascalScriptJobLog, @FLog, 155 | AScript.FindNamedType('TStrings')); 156 | end; 157 | 158 | { TPascalScriptJobParamsProxyImpl } 159 | 160 | constructor TPascalScriptJobParamsProxyImpl.Create(AParams: TJobOperationParams); 161 | begin 162 | inherited Create(); 163 | FParams := AParams; 164 | end; 165 | 166 | function TPascalScriptJobParamsProxyImpl.GetParam(const AName: string): string; 167 | var 168 | jobParam: TJobOperationParam; 169 | begin 170 | jobParam := FParams.ParamByName(AName); 171 | Result := VarToStr(jobParam.Value); 172 | end; 173 | 174 | procedure TPascalScriptJobParamsProxyImpl.SetParam(const AName, AValue: string); 175 | var 176 | jobParam: TJobOperationParam; 177 | begin 178 | jobParam := FParams.ParamByName(AName); 179 | jobParam.Value := AValue; 180 | end; 181 | 182 | end. 183 | -------------------------------------------------------------------------------- /src/ScriptJob/ScriptExecutor.pas: -------------------------------------------------------------------------------- 1 | unit ScriptExecutor; 2 | 3 | interface 4 | 5 | uses 6 | System.Classes, JobClasses; 7 | 8 | type 9 | TScriptExecutor = class 10 | private 11 | FScript: TStrings; 12 | FIsUseLogFile: Boolean; 13 | FLogFile: string; 14 | public 15 | constructor Create(AScript: TStrings; AIsUseLogFile: Boolean; const ALogFile: string); 16 | 17 | function GetParseLexems: string; virtual; abstract; 18 | function GetWordDelimiters: string; virtual; abstract; 19 | procedure Execute(AVisitor: TJobVisitor); virtual; abstract; 20 | 21 | property Script: TStrings read FScript; 22 | property IsUseLogFile: Boolean read FIsUseLogFile; 23 | property LogFile: string read FLogFile; 24 | end; 25 | 26 | implementation 27 | 28 | { TScriptExecutor } 29 | 30 | constructor TScriptExecutor.Create(AScript: TStrings; AIsUseLogFile: Boolean; 31 | const ALogFile: string); 32 | begin 33 | inherited Create(); 34 | 35 | FScript := AScript; 36 | FIsUseLogFile := AIsUseLogFile; 37 | FLogFile := ALogFile; 38 | end; 39 | 40 | end. 41 | -------------------------------------------------------------------------------- /src/ScriptJob/ScripterJobItem.pas: -------------------------------------------------------------------------------- 1 | unit ScripterJobItem; 2 | 3 | interface 4 | 5 | uses 6 | Classes, JobClasses, sysutils, CustomJobItems, ActiveX, 7 | OperationClasses, JobConsts, JobUtils, inifiles, Winapi.msxml, 8 | ScriptExecutor, PascalScriptExecutor, JavaScriptExecutor; 9 | 10 | type 11 | TScripterDataItem = class(TCustomScriptJobDataItem) 12 | private 13 | FLanguage: TScripterLanguage; 14 | 15 | procedure SetLanguage(const Value: TScripterLanguage); 16 | function CreateExecutor: TScriptExecutor; 17 | protected 18 | procedure RecoverParameters(); override; 19 | procedure ReplaceParameters(Params: TJobOperationParams); override; 20 | function GetParseLexems: String; override; 21 | function GetWordDelimiters: String; override; 22 | procedure InitData; override; 23 | public 24 | constructor Create(AOwner: TJobItem); override; 25 | 26 | function Load(AStream: TStream): Integer; overload; override; 27 | procedure Load(ANode: IXMLDOMNode); overload; override; 28 | procedure Store(ANode: IXMLDOMNode); override; 29 | procedure Assign(Source: TPersistent); override; 30 | 31 | procedure Perform(Visitor: TJobVisitor); override; 32 | 33 | property Language: TScripterLanguage read FLanguage write SetLanguage; 34 | end; 35 | 36 | implementation 37 | 38 | uses 39 | XMLUtils; 40 | 41 | { TScripterDataItem } 42 | 43 | procedure TScripterDataItem.Assign(Source: TPersistent); 44 | var 45 | Data: TScripterDataItem; 46 | begin 47 | inherited Assign(Source); 48 | BeginUpdate(); 49 | try 50 | if (Source is TScripterDataItem) then 51 | begin 52 | Data := TScripterDataItem(Source); 53 | FLanguage := Data.Language; 54 | end else 55 | begin 56 | InitData(); 57 | end; 58 | finally 59 | EndUpdate(); 60 | end; 61 | end; 62 | 63 | constructor TScripterDataItem.Create(AOwner: TJobItem); 64 | begin 65 | inherited Create(AOwner); 66 | FLanguage := Low(TScripterLanguage); 67 | end; 68 | 69 | function TScripterDataItem.CreateExecutor: TScriptExecutor; 70 | begin 71 | if (Language = slPascalScript) then 72 | begin 73 | Result := TPascalScriptExecutor.Create(Script, IsUseScriptFile, LogFile); 74 | end else 75 | if (Language = slJavaScript) then 76 | begin 77 | Result := TJavaScriptExecutor.Create(Script, IsUseScriptFile, LogFile); 78 | end else 79 | begin 80 | raise Exception.Create(cScriptError); 81 | end; 82 | end; 83 | 84 | function TScripterDataItem.GetParseLexems: String; 85 | var 86 | executor: TScriptExecutor; 87 | begin 88 | executor := CreateExecutor(); 89 | try 90 | Result := executor.GetParseLexems(); 91 | finally 92 | executor.Free(); 93 | end; 94 | end; 95 | 96 | function TScripterDataItem.GetWordDelimiters: String; 97 | var 98 | executor: TScriptExecutor; 99 | begin 100 | executor := CreateExecutor(); 101 | try 102 | Result := executor.GetWordDelimiters(); 103 | finally 104 | executor.Free(); 105 | end; 106 | end; 107 | 108 | function TScripterDataItem.Load(AStream: TStream): Integer; 109 | var 110 | R: TReader; 111 | begin 112 | Result := inherited Load(AStream); 113 | if (Result > 6) then 114 | begin 115 | BeginUpdate(); 116 | R := TReader.Create(AStream, 1024); 117 | try 118 | FLanguage := TScripterLanguage(R.ReadInteger()); 119 | finally 120 | R.Free(); 121 | EndUpdate(); 122 | end; 123 | end; 124 | end; 125 | 126 | procedure TScripterDataItem.Perform(Visitor: TJobVisitor); 127 | var 128 | executor: TScriptExecutor; 129 | begin 130 | inherited Perform(Visitor); 131 | 132 | executor := CreateExecutor(); 133 | try 134 | executor.Execute(Visitor); 135 | finally 136 | executor.Free(); 137 | end; 138 | end; 139 | 140 | procedure TScripterDataItem.RecoverParameters; 141 | begin 142 | end; 143 | 144 | procedure TScripterDataItem.ReplaceParameters(Params: TJobOperationParams); 145 | begin 146 | end; 147 | 148 | procedure TScripterDataItem.SetLanguage(const Value: TScripterLanguage); 149 | begin 150 | if (FLanguage <> Value) then 151 | begin 152 | FLanguage := Value; 153 | DoDataChanged(); 154 | end; 155 | end; 156 | 157 | procedure TScripterDataItem.Store(ANode: IXMLDOMNode); 158 | var 159 | ChildNode: IXMLDOMNode; 160 | begin 161 | inherited Store(ANode); 162 | ChildNode := ANode.ownerDocument.createElement('Language'); 163 | ANode.appendChild(ChildNode); 164 | ChildNode.text := cScripterLanguages[FLanguage]; 165 | end; 166 | 167 | procedure TScripterDataItem.InitData; 168 | begin 169 | inherited InitData(); 170 | FLanguage := Low(TScripterLanguage); 171 | end; 172 | 173 | procedure TScripterDataItem.Load(ANode: IXMLDOMNode); 174 | var 175 | ChildNode: IXMLDOMNode; 176 | ind: Integer; 177 | begin 178 | inherited Load(ANode); 179 | BeginUpdate(); 180 | try 181 | ChildNode := ANode.selectSingleNode('Language'); 182 | if ChildNode <> nil then 183 | begin 184 | ind := GetArrayIndexByName(ChildNode.text, cScripterLanguages); 185 | 186 | if (ind > -1) then 187 | begin 188 | FLanguage := TScripterLanguage(ind); 189 | end else 190 | if (CompareText(ChildNode.text, 'DELPHI SCRIPT') = 0) then 191 | begin 192 | FLanguage := slPascalScript; 193 | end; 194 | end; 195 | finally 196 | EndUpdate(); 197 | end; 198 | end; 199 | 200 | initialization 201 | RegisterClass(TScripterDataItem); 202 | 203 | end. 204 | -------------------------------------------------------------------------------- /src/ScriptJob/ScripterJobItemFrm.dfm: -------------------------------------------------------------------------------- 1 | inherited ScripterJobItemForm: TScripterJobItemForm 2 | inherited PageControl: TPageControl 3 | inherited tabDetails: TTabSheet 4 | ExplicitLeft = 4 5 | ExplicitTop = 4 6 | ExplicitWidth = 524 7 | inherited sbScript: TStatusBar 8 | Panels = < 9 | item 10 | Alignment = taRightJustify 11 | Text = 'Ln 1, Col 1' 12 | Width = 10 13 | end> 14 | end 15 | end 16 | inherited tabAddition: TTabSheet 17 | inherited pAddTop: TPanel 18 | object Label4: TLabel [3] 19 | Left = 258 20 | Top = 37 21 | Width = 48 22 | Height = 13 23 | Caption = 'Language' 24 | end 25 | inherited edtCanPerform: TEdit 26 | TabOrder = 7 27 | end 28 | inherited btnErrorWords: TButton 29 | Visible = False 30 | end 31 | object cmbLanguage: TComboBox 32 | Left = 328 33 | Top = 34 34 | Width = 145 35 | Height = 21 36 | Style = csDropDownList 37 | TabOrder = 6 38 | OnChange = cmbLanguageChange 39 | end 40 | end 41 | inherited sbDescription: TStatusBar 42 | ExplicitWidth = 506 43 | end 44 | end 45 | end 46 | end 47 | -------------------------------------------------------------------------------- /src/ScriptJob/ScripterJobItemFrm.pas: -------------------------------------------------------------------------------- 1 | unit ScripterJobItemFrm; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 | CustomScriptDialog, CustomDialog, StdCtrls, ComCtrls, ExtCtrls, JobClasses, 8 | JobCtrls; 9 | 10 | type 11 | TScripterJobItemForm = class(TCustomScriptJobItemForm) 12 | Label4: TLabel; 13 | cmbLanguage: TComboBox; 14 | procedure cmbLanguageChange(Sender: TObject); 15 | protected 16 | procedure UpdateControls; override; 17 | procedure AssignData(IsFromDataItem: Boolean = False); override; 18 | public 19 | constructor Create(AOwner: TComponent); override; 20 | end; 21 | 22 | TScripterJobEditorItem = class(TCustomJobEditorItem) 23 | protected 24 | function GetEditorFormClass: TCustomDialogFormClass; override; 25 | end; 26 | 27 | implementation 28 | 29 | {$R *.DFM} 30 | 31 | uses 32 | ScripterJobItem, JobConsts; 33 | 34 | { TVBScriptJobEditorItem } 35 | 36 | function TScripterJobEditorItem.GetEditorFormClass: TCustomDialogFormClass; 37 | begin 38 | Result := TScripterJobItemForm; 39 | end; 40 | 41 | { TScripterJobItemForm } 42 | 43 | procedure TScripterJobItemForm.AssignData(IsFromDataItem: Boolean); 44 | var 45 | Index: Integer; 46 | begin 47 | inherited AssignData(IsFromDataItem); 48 | 49 | if IsFromDataItem then 50 | begin 51 | cmbLanguage.ItemIndex := Integer(TScripterDataItem(Data).Language); 52 | end else 53 | begin 54 | Index := cmbLanguage.ItemIndex; 55 | if (Index < 0) then 56 | begin 57 | TScripterDataItem(Data).Language := Low(TScripterLanguage); 58 | end else 59 | begin 60 | TScripterDataItem(Data).Language := TScripterLanguage(Index); 61 | end; 62 | end; 63 | end; 64 | 65 | constructor TScripterJobItemForm.Create(AOwner: TComponent); 66 | var 67 | i: TScripterLanguage; 68 | begin 69 | inherited Create(AOwner); 70 | cmbLanguage.Items.Clear(); 71 | for i := Low(cScripterLanguages) to High(cScripterLanguages) do 72 | begin 73 | cmbLanguage.Items.Add(cScripterLanguages[i]); 74 | end; 75 | end; 76 | 77 | procedure TScripterJobItemForm.UpdateControls; 78 | begin 79 | inherited UpdateControls(); 80 | cmbLanguage.Enabled := not ReadOnly; 81 | end; 82 | 83 | procedure TScripterJobItemForm.cmbLanguageChange(Sender: TObject); 84 | begin 85 | if IsLoading then Exit; 86 | IsModified := True; 87 | UpdateControls(); 88 | end; 89 | 90 | initialization 91 | RegisterEditorItem(TScripterJobEditorItem, TScripterDataItem, 'Scripter'); 92 | 93 | end. 94 | -------------------------------------------------------------------------------- /src/ScriptJob/uPSI_PascalScriptClassesProxy.pas: -------------------------------------------------------------------------------- 1 | unit uPSI_PascalScriptClassesProxy; 2 | { 3 | This file has been generated by UnitParser v0.7, written by M. Knight 4 | and updated by NP. v/d Spek and George Birbilis. 5 | Source Code from Carlo Kok has been used to implement various sections of 6 | UnitParser. Components of ROPS are used in the construction of UnitParser, 7 | code implementing the class wrapper is taken from Carlo Kok's conv utility 8 | 9 | } 10 | interface 11 | 12 | 13 | 14 | uses 15 | SysUtils 16 | ,Classes 17 | ,uPSComponent 18 | ,uPSRuntime 19 | ,uPSCompiler 20 | ; 21 | 22 | type 23 | (*----------------------------------------------------------------------------*) 24 | TPSImport_PascalScriptJobParamsProxy = class(TPSPlugin) 25 | public 26 | procedure CompileImport1(CompExec: TPSScript); override; 27 | procedure ExecImport1(CompExec: TPSScript; const ri: TPSRuntimeClassImporter); override; 28 | end; 29 | 30 | 31 | { compile-time registration functions } 32 | procedure SIRegister_TPascalScriptJobParamsProxy(CL: TPSPascalCompiler); 33 | procedure SIRegister_PascalScriptJobParamsProxy(CL: TPSPascalCompiler); 34 | 35 | { run-time registration functions } 36 | procedure RIRegister_TPascalScriptJobParamsProxy(CL: TPSRuntimeClassImporter); 37 | procedure RIRegister_PascalScriptJobParamsProxy(CL: TPSRuntimeClassImporter); 38 | 39 | procedure Register; 40 | 41 | implementation 42 | 43 | 44 | uses 45 | PascalScriptClassesProxy 46 | ; 47 | 48 | 49 | procedure Register; 50 | begin 51 | RegisterComponents('Pascal Script', [TPSImport_PascalScriptJobParamsProxy]); 52 | end; 53 | 54 | (* === compile-time registration functions === *) 55 | (*----------------------------------------------------------------------------*) 56 | procedure SIRegister_TPascalScriptJobParamsProxy(CL: TPSPascalCompiler); 57 | begin 58 | with CL.AddClass(CL.FindClass('TOBJECT'),TPascalScriptJobParamsProxy) do 59 | begin 60 | RegisterPublishedProperties; 61 | RegisterMethod('Procedure SetParam( const AName, AValue : string)'); 62 | RegisterMethod('Function GetParam( const AName : string) : string'); 63 | end; 64 | end; 65 | 66 | (*----------------------------------------------------------------------------*) 67 | procedure SIRegister_PascalScriptJobParamsProxy(CL: TPSPascalCompiler); 68 | begin 69 | SIRegister_TPascalScriptJobParamsProxy(CL); 70 | end; 71 | 72 | (* === run-time registration functions === *) 73 | (*----------------------------------------------------------------------------*) 74 | procedure RIRegister_TPascalScriptJobParamsProxy(CL: TPSRuntimeClassImporter); 75 | begin 76 | with CL.Add(TPascalScriptJobParamsProxy) do 77 | begin 78 | RegisterVirtualMethod(@TPascalScriptJobParamsProxy.SetParam, 'SetParam'); 79 | RegisterVirtualMethod(@TPascalScriptJobParamsProxy.GetParam, 'GetParam'); 80 | end; 81 | end; 82 | 83 | (*----------------------------------------------------------------------------*) 84 | procedure RIRegister_PascalScriptJobParamsProxy(CL: TPSRuntimeClassImporter); 85 | begin 86 | RIRegister_TPascalScriptJobParamsProxy(CL); 87 | end; 88 | 89 | 90 | 91 | { TPSImport_PascalScriptJobParamsProxy } 92 | (*----------------------------------------------------------------------------*) 93 | procedure TPSImport_PascalScriptJobParamsProxy.CompileImport1(CompExec: TPSScript); 94 | begin 95 | SIRegister_PascalScriptJobParamsProxy(CompExec.Comp); 96 | end; 97 | (*----------------------------------------------------------------------------*) 98 | procedure TPSImport_PascalScriptJobParamsProxy.ExecImport1(CompExec: TPSScript; const ri: TPSRuntimeClassImporter); 99 | begin 100 | RIRegister_PascalScriptJobParamsProxy(ri); 101 | end; 102 | (*----------------------------------------------------------------------------*) 103 | 104 | 105 | end. 106 | -------------------------------------------------------------------------------- /src/SelectJob/SelectJobItem.dfm: -------------------------------------------------------------------------------- 1 | object SelectjobItemForm: TSelectjobItemForm 2 | Left = 262 3 | Top = 107 4 | BorderStyle = bsDialog 5 | Caption = 'New Job Item' 6 | ClientHeight = 93 7 | ClientWidth = 238 8 | Color = clBtnFace 9 | Font.Charset = DEFAULT_CHARSET 10 | Font.Color = clWindowText 11 | Font.Height = -11 12 | Font.Name = 'MS Sans Serif' 13 | Font.Style = [] 14 | OldCreateOrder = False 15 | Position = poOwnerFormCenter 16 | OnCreate = FormCreate 17 | PixelsPerInch = 96 18 | TextHeight = 13 19 | object Label1: TLabel 20 | Left = 6 21 | Top = 13 22 | Width = 28 23 | Height = 13 24 | Caption = 'Name' 25 | end 26 | object Label2: TLabel 27 | Left = 6 28 | Top = 35 29 | Width = 24 30 | Height = 13 31 | Caption = 'Type' 32 | end 33 | object edtName: TEdit 34 | Left = 48 35 | Top = 8 36 | Width = 184 37 | Height = 21 38 | TabOrder = 0 39 | OnChange = edtNameChange 40 | end 41 | object cmbItemType: TJobComboBox 42 | Left = 48 43 | Top = 30 44 | Width = 184 45 | Height = 21 46 | Style = csDropDownList 47 | TabOrder = 1 48 | OnCloseUp = cmbItemTypeCloseUp 49 | end 50 | object btnOK: TButton 51 | Left = 84 52 | Top = 62 53 | Width = 72 54 | Height = 22 55 | Caption = 'OK' 56 | Default = True 57 | TabOrder = 2 58 | OnClick = btnOKClick 59 | end 60 | object btnCancel: TButton 61 | Left = 160 62 | Top = 62 63 | Width = 72 64 | Height = 22 65 | Cancel = True 66 | Caption = 'Cancel' 67 | ModalResult = 2 68 | TabOrder = 3 69 | end 70 | end 71 | -------------------------------------------------------------------------------- /src/SelectJob/SelectJobItem.pas: -------------------------------------------------------------------------------- 1 | unit SelectJobItem; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 | StdCtrls, JobClasses, JobCtrls; 8 | 9 | type 10 | TSelectjobItemForm = class(TForm) 11 | edtName: TEdit; 12 | cmbItemType: TJobComboBox; 13 | Label1: TLabel; 14 | Label2: TLabel; 15 | btnOK: TButton; 16 | btnCancel: TButton; 17 | procedure btnOKClick(Sender: TObject); 18 | procedure edtNameChange(Sender: TObject); 19 | procedure FormCreate(Sender: TObject); 20 | procedure cmbItemTypeCloseUp(Sender: TObject); 21 | private 22 | FNameEdited: Boolean; 23 | procedure DoNewItemName(AName: String); 24 | end; 25 | 26 | function SelectJobItemDlg(var AName: String; var AType: TJobDataItemClass): Boolean; 27 | 28 | implementation 29 | 30 | uses 31 | JobConsts; 32 | 33 | {$R *.DFM} 34 | 35 | procedure FillItemsWithJobTypes(AList: TStrings); 36 | var 37 | i: Integer; 38 | Item: TJobEditorCategory; 39 | begin 40 | AList.Clear(); 41 | 42 | for i := 0 to TJobEditorManager.Instance.EditorCategoriesCount - 1 do 43 | begin 44 | Item := TJobEditorManager.Instance.EditorCategories[i]; 45 | AList.AddObject(Item.DataName, TObject(Item.DataClass)); 46 | end; 47 | end; 48 | 49 | function SelectJobItemDlg(var AName: String; var AType: TJobDataItemClass): Boolean; 50 | var 51 | Dlg: TSelectjobItemForm; 52 | begin 53 | Dlg := TSelectjobItemForm.Create(nil); 54 | try 55 | FillItemsWithJobTypes(Dlg.cmbItemType.Items); 56 | Result := (Dlg.cmbItemType.Items.Count > 0); 57 | 58 | if Result then 59 | begin 60 | Dlg.cmbItemType.ItemIndex := 0; 61 | Dlg.DoNewItemName(Dlg.cmbItemType.Text); 62 | Result := (Dlg.ShowModal() = mrOK); 63 | end; 64 | 65 | if Result then 66 | begin 67 | AName := Dlg.edtName.Text; 68 | AType := TJobDataItemClass(Dlg.cmbItemType.Items.Objects[Dlg.cmbItemType.ItemIndex]); 69 | end; 70 | finally 71 | Dlg.Free(); 72 | end; 73 | end; 74 | 75 | { TSelectjobItemForm } 76 | 77 | procedure TSelectjobItemForm.btnOKClick(Sender: TObject); 78 | begin 79 | if (Trim(edtName.Text) = '') or (cmbItemType.ItemIndex < 0) then Exit; 80 | ModalResult := mrOk; 81 | end; 82 | 83 | procedure TSelectjobItemForm.DoNewItemName(AName: String); 84 | begin 85 | edtName.Text := Format(cNewJobItemName, [AName]); 86 | FNameEdited := False; 87 | end; 88 | 89 | procedure TSelectjobItemForm.edtNameChange(Sender: TObject); 90 | begin 91 | FNameEdited := True; 92 | end; 93 | 94 | procedure TSelectjobItemForm.FormCreate(Sender: TObject); 95 | begin 96 | FNameEdited := False; 97 | end; 98 | 99 | procedure TSelectjobItemForm.cmbItemTypeCloseUp(Sender: TObject); 100 | begin 101 | if FNameEdited then Exit; 102 | DoNewItemName(cmbItemType.Text); 103 | end; 104 | 105 | end. 106 | -------------------------------------------------------------------------------- /src/Utils/BuildNo.inc: -------------------------------------------------------------------------------- 1 | '1.4.0.0' -------------------------------------------------------------------------------- /src/Utils/JobConverter.pas: -------------------------------------------------------------------------------- 1 | unit JobConverter; 2 | 3 | interface 4 | 5 | uses 6 | Classes, JobClasses; 7 | 8 | type 9 | TJobRemoteCallConverter = class 10 | private 11 | FJobManager: TJobManager; 12 | FJobLibManager: TJobManager; 13 | FDuplicateJobs: TStrings; 14 | FJobLibManagerName: String; 15 | function IsJobsEqual(Job1, Job2: TJobItem): Boolean; 16 | procedure RemoveDuplicateJobs; 17 | procedure DoConvertJob(AJob: TJobItem); 18 | public 19 | constructor Create(AJobManager: TJobManager; AJobLibManagerName: String); 20 | destructor Destroy; override; 21 | procedure DoConvert; 22 | end; 23 | 24 | implementation 25 | 26 | uses 27 | CallJobItem, Sysutils; 28 | 29 | { TJobRemoteCallConverter } 30 | 31 | constructor TJobRemoteCallConverter.Create(AJobManager: TJobManager; AJobLibManagerName: String); 32 | begin 33 | inherited Create(); 34 | FDuplicateJobs := TStringList.Create(); 35 | FJobLibManager := TJobManager.Create(); 36 | FJobManager := AJobManager; 37 | FJobLibManagerName := AJobLibManagerName; 38 | end; 39 | 40 | procedure TJobRemoteCallConverter.DoConvert; 41 | var 42 | i: Integer; 43 | Stream: TStream; 44 | AFileName: String; 45 | begin 46 | AFileName := FJobLibManagerName; 47 | if (ExtractFilePath(AFileName) = '') then 48 | begin 49 | AFileName := ExtractFilePath(ParamStr(0)) + AFileName; 50 | end; 51 | if not FileExists(AFileName) then Exit; 52 | Stream := TFileStream.Create(AFileName, fmOpenRead); 53 | try 54 | FJobLibManager.Load(Stream); 55 | finally 56 | Stream.Free(); 57 | end; 58 | RemoveDuplicateJobs(); 59 | for i := 0 to FJobManager.RootItemsCount - 1 do 60 | begin 61 | DoConvertJob(FJobManager.RootItems[i]); 62 | end; 63 | end; 64 | 65 | destructor TJobRemoteCallConverter.Destroy; 66 | begin 67 | FJobLibManager.Free(); 68 | FDuplicateJobs.Free(); 69 | inherited Destroy(); 70 | end; 71 | 72 | procedure TJobRemoteCallConverter.DoConvertJob(AJob: TJobItem); 73 | var 74 | i: Integer; 75 | ACallData: TCallJobDataItem; 76 | begin 77 | if (AJob.Data is TCallJobDataItem) then 78 | begin 79 | ACallData := AJob.Data as TCallJobDataItem; 80 | if (FDuplicateJobs.IndexOf(ACallData.CallJobName) > 0) then 81 | begin 82 | ACallData.CallMediaName := FJobLibManagerName; 83 | end; 84 | end; 85 | for i := 0 to AJob.ItemsCount - 1 do 86 | begin 87 | DoConvertJob(AJob.Items[i]); 88 | end; 89 | end; 90 | 91 | function TJobRemoteCallConverter.IsJobsEqual(Job1, Job2: TJobItem): Boolean; 92 | begin 93 | //TODO 94 | Result := (Job1.JobName = Job2.JobName) and (Job1.ItemsCount = Job2.ItemsCount); 95 | end; 96 | 97 | procedure TJobRemoteCallConverter.RemoveDuplicateJobs; 98 | function GetJob(AName: String): TJobItem; 99 | var 100 | i: Integer; 101 | Item: TJobItem; 102 | begin 103 | Result := nil; 104 | for i := 0 to FJobManager.RootItemsCount - 1 do 105 | begin 106 | Item := FJobManager.RootItems[i]; 107 | if (CompareText(Item.JobName, AName) = 0) then 108 | begin 109 | Result := Item; 110 | Break; 111 | end; 112 | end; 113 | end; 114 | 115 | var 116 | i: Integer; 117 | AJob, AJobLib: TJobItem; 118 | begin 119 | FDuplicateJobs.Clear(); 120 | for i := FJobLibManager.RootItemsCount - 1 downto 0 do 121 | begin 122 | AJobLib := FJobLibManager.RootItems[i]; 123 | AJob := GetJob(AJobLib.JobName); 124 | if (AJob <> nil) and IsJobsEqual(AJob, AJobLib) then 125 | begin 126 | FDuplicateJobs.Add(AJob.JobName); 127 | FJobManager.RemoveJobItem(AJob); 128 | end; 129 | end; 130 | end; 131 | 132 | end. 133 | -------------------------------------------------------------------------------- /src/Utils/XMLUtils.pas: -------------------------------------------------------------------------------- 1 | unit XMLUtils; 2 | 3 | interface 4 | 5 | uses 6 | System.Classes, Winapi.msxml; 7 | 8 | type 9 | TStoreFormStruct = record 10 | Width: Integer; 11 | Height: Integer; 12 | Left: Integer; 13 | Top: Integer; 14 | Maximized: Boolean; 15 | end; 16 | 17 | function GetArrayIndexByName(const AName: string; const Arr: array of string): Integer; 18 | procedure StringsToXML(AStrings: TStrings; ANode: IXMLDOMNode); 19 | procedure XMLToStrings(AStrings: TStrings; ANode: IXMLDOMNode); 20 | procedure FormToXML(const AStore: TStoreFormStruct; ANode: IXMLDOMNode); 21 | procedure XMLToForm(var AStore: TStoreFormStruct; ANode: IXMLDOMNode); 22 | procedure SaveXMLToFile(const AFileName: string; ADomDoc: IXMLDOMDocument); 23 | procedure AddCDataNodeName(const AName: string); 24 | 25 | implementation 26 | 27 | uses 28 | SysUtils, JobConsts, Windows; 29 | 30 | const 31 | CDataXMLFormat = ''; 32 | XMLFormat = '' + 33 | '' + 34 | ' %s ' + 35 | ' ' + 36 | ' ' + 37 | ' ' + 38 | ' ' + 39 | ' ' + 40 | ''; 41 | 42 | var 43 | CDataNodeNames: TStrings = nil; 44 | 45 | procedure AddCDataNodeName(const AName: string); 46 | begin 47 | if (CDataNodeNames = nil) then 48 | begin 49 | CDataNodeNames := TStringList.Create(); 50 | end; 51 | if (CDataNodeNames.IndexOf(AName) < 0) then 52 | begin 53 | CDataNodeNames.Add(AName); 54 | end; 55 | end; 56 | 57 | procedure SaveXMLToFile(const AFileName: string; ADomDoc: IXMLDOMDocument); 58 | function GetXMLFormat: string; 59 | var 60 | i: Integer; 61 | begin 62 | Result := ''; 63 | if (CDataNodeNames <> nil) then 64 | begin 65 | for i := 0 to CDataNodeNames.Count - 1 do 66 | begin 67 | Result := Result + #32 + Format(CDataXMLFormat, [CDataNodeNames[i]]); 68 | end; 69 | end; 70 | Result := Format(XMLFormat, [Result]); 71 | end; 72 | 73 | var 74 | b: Boolean; 75 | TransDoc, ResDoc: IXMLDOMDocument; 76 | begin 77 | TransDoc := CoDOMDocument.Create(); 78 | ResDoc := CoDOMDocument.Create(); 79 | TransDoc.loadXML(GetXMLFormat()); 80 | try 81 | ADomDoc.transformNodeToObject(TransDoc, ResDoc); 82 | b := (ResDoc.xml <> ''); 83 | except 84 | b := False; 85 | end; 86 | if b then 87 | begin 88 | ResDoc.save(AFileName); 89 | end else 90 | begin 91 | ADomDoc.save(AFileName); 92 | end; 93 | end; 94 | 95 | function GetArrayIndexByName(const AName: string; const Arr: array of string): Integer; 96 | begin 97 | for Result := Low(Arr) to High(Arr) do 98 | begin 99 | if (CompareText(Arr[Result], AName) = 0) then Exit; 100 | end; 101 | Result := -1; 102 | end; 103 | 104 | procedure StringsToXML(AStrings: TStrings; ANode: IXMLDOMNode); 105 | var 106 | ChildNode: IXMLDOMNode; 107 | begin 108 | ChildNode := ANode.ownerDocument.createCDATASection(AStrings.Text); 109 | ANode.appendChild(ChildNode); 110 | end; 111 | 112 | procedure XMLToStrings(AStrings: TStrings; ANode: IXMLDOMNode); 113 | begin 114 | AStrings.Text := ANode.text; 115 | end; 116 | 117 | procedure FormToXML(const AStore: TStoreFormStruct; ANode: IXMLDOMNode); 118 | var 119 | ChildNode: IXMLDOMNode; 120 | begin 121 | ChildNode := ANode.ownerDocument.createElement('Height'); 122 | ANode.appendChild(ChildNode); 123 | ChildNode.text := IntToStr(AStore.Height); 124 | 125 | ChildNode := ANode.ownerDocument.createElement('Width'); 126 | ANode.appendChild(ChildNode); 127 | ChildNode.text := IntToStr(AStore.Width); 128 | 129 | ChildNode := ANode.ownerDocument.createElement('Left'); 130 | ANode.appendChild(ChildNode); 131 | ChildNode.text := IntToStr(AStore.Left); 132 | 133 | ChildNode := ANode.ownerDocument.createElement('Top'); 134 | ANode.appendChild(ChildNode); 135 | ChildNode.text := IntToStr(AStore.Top); 136 | 137 | ChildNode := ANode.ownerDocument.createElement('Maximized'); 138 | ANode.appendChild(ChildNode); 139 | ChildNode.text := cStoreBoolean[AStore.Maximized]; 140 | end; 141 | 142 | procedure XMLToForm(var AStore: TStoreFormStruct; ANode: IXMLDOMNode); 143 | var 144 | v: Integer; 145 | ChildNode: IXMLDOMNode; 146 | begin 147 | ZeroMemory(@AStore, SizeOf(AStore)); 148 | 149 | ChildNode := ANode.selectSingleNode('Height'); 150 | if ChildNode <> nil then 151 | begin 152 | AStore.Height := StrToIntDef(ChildNode.text, 0); 153 | end; 154 | 155 | ChildNode := ANode.selectSingleNode('Width'); 156 | if ChildNode <> nil then 157 | begin 158 | AStore.Width := StrToIntDef(ChildNode.text, 0); 159 | end; 160 | 161 | ChildNode := ANode.selectSingleNode('Left'); 162 | if ChildNode <> nil then 163 | begin 164 | AStore.Left := StrToIntDef(ChildNode.text, 0); 165 | end; 166 | 167 | ChildNode := ANode.selectSingleNode('Top'); 168 | if ChildNode <> nil then 169 | begin 170 | AStore.Top := StrToIntDef(ChildNode.text, 0); 171 | end; 172 | 173 | ChildNode := ANode.selectSingleNode('Maximized'); 174 | if ChildNode <> nil then 175 | begin 176 | v := GetArrayIndexByName(ChildNode.text, cStoreBoolean); 177 | if (v > -1) then AStore.Maximized := Boolean(v); 178 | end; 179 | end; 180 | 181 | initialization 182 | 183 | finalization 184 | CDataNodeNames.Free(); 185 | 186 | end. 187 | -------------------------------------------------------------------------------- /src/Utils/clErrorHandling.pas: -------------------------------------------------------------------------------- 1 | { 2 | Copyright (C) 1999 - 2002 Clever Components 3 | www.CleverComponents.com 4 | } 5 | 6 | unit clErrorHandling; 7 | 8 | interface 9 | 10 | uses 11 | SysUtils, Forms; 12 | 13 | type 14 | TclLogger = class 15 | private 16 | FPrevOnAppException: TExceptionEvent; 17 | procedure HandleAppException(Sender: TObject; E: Exception); 18 | procedure HookExceptions; 19 | procedure UnhookExceptions; 20 | function GetModuleVersionInfo: string; 21 | constructor CreateInstance; 22 | class function AccessInstance(Request: Integer): TclLogger; 23 | procedure PutMessageToFile(const AMessage: string); 24 | public 25 | constructor Create; 26 | destructor Destroy; override; 27 | class function Instance: TclLogger; 28 | class procedure ReleaseInstance; 29 | procedure LogMessage(const AMessage: string); 30 | end; 31 | 32 | implementation 33 | 34 | uses 35 | Windows, VerInfo{, imagehlp}; 36 | 37 | const 38 | StoredCallStackDepth = 26; 39 | 40 | type 41 | TCallStack = Array[0..StoredCallStackDepth] of Pointer; 42 | 43 | var 44 | frame: TCallStack; 45 | fOldExceptObjProc: Pointer; 46 | 47 | procedure FillCallStack(var St : TCallStack; const ExcludeFirstLevel: Boolean); 48 | var 49 | i : integer; 50 | _EBP : Integer; 51 | _ESP : Integer; 52 | begin 53 | asm 54 | mov _ESP, esp 55 | mov _EBP, ebp 56 | end; 57 | if ExcludeFirstLevel then 58 | begin 59 | _ESP:= _EBP; 60 | _EBP:= PInteger(_EBP)^; 61 | end; 62 | FillChar(St, SizeOf(St), 0); 63 | if (_EBP<_ESP) or (_EBP-_ESP>30000) then Exit; 64 | for i:= 0 to StoredCallStackDepth do 65 | begin 66 | _ESP:= _EBP; 67 | _EBP:= PInteger(_EBP)^; 68 | if (_EBP<_ESP) or (_EBP-_ESP>30000) then Exit; 69 | St[i]:= Pointer(PInteger(_EBP+4)^-4); 70 | end; 71 | end; 72 | 73 | {procedure GetCallStack(var St : TCallStack); 74 | var 75 | i: Integer; 76 | stk: STACKFRAME; 77 | Cnt: _CONTEXT; 78 | begin 79 | FillChar(St, SizeOf(St), 0); 80 | Cnt.ContextFlags := CONTEXT_CONTROL; 81 | GetThreadContext(GetCurrentThread(), Cnt); 82 | ZeroMemory(@stk, SizeOf(STACKFRAME)); 83 | stk.AddrPC.Offset := Cnt.Eip; 84 | stk.AddrPC.Mode := AddrModeFlat; 85 | stk.AddrStack.Offset := Cnt.Esp; 86 | stk.AddrStack.Mode := AddrModeFlat; 87 | stk.AddrFrame.Offset := Cnt.Ebp; 88 | stk.AddrFrame.Mode := AddrModeFlat; 89 | for i := 0 to StoredCallStackDepth do 90 | begin 91 | if (not StackWalk(IMAGE_FILE_MACHINE_I386, GetCurrentProcess(), GetCurrentThread(), 92 | @stk, @Cnt, nil, 93 | SymFunctionTableAccess, SymGetModuleBase, nil)) then 94 | begin 95 | Break; 96 | end; 97 | St[i]:= Pointer(stk.AddrPC.Offset); 98 | end; 99 | end;} 100 | 101 | function CallStackTextualRepresentation(const S: TCallStack; const LineHeader: string): string; 102 | var 103 | i: integer; 104 | begin 105 | i:= 0; 106 | Result:= ''; 107 | while (i <= StoredCallStackDepth) and (S[i] <> Nil) do 108 | begin 109 | Result:= Result + LineHeader + 'call stack - ' + IntToStr(i) + ' : 0x' + IntToHex(Cardinal(S[i]), 8) + #13#10; 110 | i:= i + 1; 111 | end; 112 | end; 113 | 114 | procedure clUnwindStack(P: PExceptionRecord); stdcall; 115 | var 116 | s: string; 117 | begin 118 | s := Format('Exception Code: 0x%.8x', [P.ExceptionCode]); 119 | if (P.ExceptionCode = EXCEPTION_ACCESS_VIOLATION) then 120 | begin 121 | if (P.ExceptionInformation[0] = 1) then 122 | s := s + Format(#13#10 + 'AV at 0x%.8x, write at address 0x%.8x', [Integer(P.ExceptionAddress), Integer(P.ExceptionInformation[1])]) 123 | else 124 | s := s + Format(#13#10 + 'AV at 0x%.8x, read at address 0x%.8x', [Integer(P.ExceptionAddress), Integer(P.ExceptionInformation[1])]) 125 | end; 126 | FillCallStack(frame, True); 127 | // GetCallStack(frame); 128 | s := s + #13#10 + CallStackTextualRepresentation(frame, ''); 129 | TclLogger.Instance().LogMessage('Stack Trace: ' + s); 130 | end; 131 | 132 | function clGetExceptionObject(P: PExceptionRecord): Exception; 133 | asm 134 | pusha 135 | push p 136 | call clUnwindStack; 137 | popa 138 | mov edx, fOldExceptObjProc 139 | test edx, edx 140 | jz @@no_handler 141 | call edx 142 | @@no_handler: 143 | end; 144 | 145 | { TclLogger } 146 | 147 | class function TclLogger.AccessInstance(Request: Integer): TclLogger; 148 | const 149 | FInstance: TclLogger = nil; 150 | begin 151 | case Request of 152 | 0 : ; 153 | 1 : if not Assigned(FInstance) then FInstance := CreateInstance; 154 | 2 : FInstance := nil; 155 | else 156 | raise Exception.CreateFmt('Illegal request %d in AccessInstance', 157 | [Request]); 158 | end; 159 | Result := FInstance; 160 | end; 161 | 162 | constructor TclLogger.Create; 163 | begin 164 | inherited Create; 165 | raise Exception.CreateFmt('Access class %s through Instance only', 166 | [ClassName]); 167 | end; 168 | 169 | constructor TclLogger.CreateInstance; 170 | begin 171 | inherited Create(); 172 | end; 173 | 174 | destructor TclLogger.Destroy; 175 | begin 176 | if AccessInstance(0) = Self then AccessInstance(2); 177 | UnhookExceptions(); 178 | inherited Destroy(); 179 | end; 180 | 181 | function TclLogger.GetModuleVersionInfo: string; 182 | var 183 | Info: TVersionInfo; 184 | begin 185 | Info := TVersionInfo.Create(ParamStr(0)); 186 | try 187 | Result := Info.FileVersion; 188 | finally 189 | Info.Free(); 190 | end; 191 | end; 192 | 193 | procedure TclLogger.HandleAppException(Sender: TObject; E: Exception); 194 | begin 195 | if (E is EAccessViolation) then Exit; 196 | LogMessage(Format('Exception (%s): %s', [E.ClassName, E.Message])); 197 | end; 198 | 199 | procedure TclLogger.HookExceptions; 200 | begin 201 | FPrevOnAppException := Application.OnException; 202 | Application.OnException := HandleAppException; 203 | end; 204 | 205 | class function TclLogger.Instance: TclLogger; 206 | begin 207 | Result := AccessInstance(1); 208 | end; 209 | 210 | procedure TclLogger.LogMessage(const AMessage: string); 211 | var 212 | s: string; 213 | begin 214 | s := GetModuleVersionInfo(); 215 | if (s <> '') then 216 | begin 217 | s := 'File Version: ' + s + #13#10; 218 | end; 219 | s := DateTimeToStr(Now()) + ': ' + s + AMessage; 220 | PutMessageToFile(s + #13#10#13#10); 221 | end; 222 | 223 | procedure TclLogger.PutMessageToFile(const AMessage: string); 224 | var 225 | FileName: string; 226 | hFile: THandle; 227 | len, cnt: Cardinal; 228 | buf: PChar; 229 | begin 230 | FileName := ChangeFileExt(ParamStr(0), '.log'); 231 | hFile := CreateFile(PChar(FileName), GENERIC_WRITE, FILE_SHARE_READ or FILE_SHARE_WRITE, nil, 232 | OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0); 233 | if (hFile = INVALID_HANDLE_VALUE) then 234 | begin 235 | hFile := CreateFile(PChar(FileName), GENERIC_WRITE, FILE_SHARE_READ or FILE_SHARE_WRITE, nil, 236 | CREATE_NEW, FILE_ATTRIBUTE_NORMAL, 0); 237 | end; 238 | if (hFile <> INVALID_HANDLE_VALUE) then 239 | begin 240 | SetFilePointer(hFile, 0, nil, FILE_END); 241 | len := Length(AMessage) + 1; 242 | GetMem(buf, len); 243 | StrCopy(buf, PCHAR(AMessage)); 244 | WriteFile(hFile, buf[0], len - 1, cnt, nil); 245 | FreeMem(buf); 246 | CloseHandle(hFile); 247 | end; 248 | end; 249 | 250 | class procedure TclLogger.ReleaseInstance; 251 | begin 252 | AccessInstance(0).Free(); 253 | end; 254 | 255 | procedure TclLogger.UnhookExceptions; 256 | begin 257 | Application.OnException := FPrevOnAppException; 258 | end; 259 | 260 | initialization 261 | fOldExceptObjProc := ExceptObjProc; 262 | ExceptObjProc := @clGetExceptionObject; 263 | TclLogger.Instance().HookExceptions(); 264 | 265 | finalization 266 | TclLogger.ReleaseInstance(); 267 | 268 | end. 269 | --------------------------------------------------------------------------------