├── .gitignore ├── Demos ├── CBuilder │ ├── Project1.bpr │ ├── Project1.cpp │ ├── Project1.res │ ├── Unit1.cpp │ ├── Unit1.dfm │ └── Unit1.h ├── Delphi │ ├── Project1.dpr │ ├── Project1.res │ ├── Unit1.dfm │ └── Unit1.pas └── Test │ ├── Project1.dpr │ ├── Unit1.dfm │ └── Unit1.pas ├── LICENSE ├── README.md └── Sources ├── IBDataPump ├── IBEIntf.pas ├── IBPump.dpr ├── IBPump.res ├── IBPumpPlug.dpr ├── IBPumpPlug.res ├── ccGetVer.inc ├── ibmUpdWizard.dfm ├── ibmUpdWizard.pas ├── ibpDM.dfm ├── ibpDM.pas ├── ibpGenSql.dfm ├── ibpGenSql.pas ├── ibpHelp.dfm ├── ibpHelp.pas ├── ibpIncFields.dfm ├── ibpIncFields.pas ├── ibpMain.dfm ├── ibpMain.pas ├── ibpSQLEditor.dfm ├── ibpSQLEditor.pas ├── ibpUpdDefs.dfm └── ibpUpdDefs.pas ├── INSTALL.txt └── ccIBPumpVCL ├── ccButtonEdit.pas ├── ccGetVer.inc ├── ccIBPumpVCL.dcr ├── ccIBPumpVCL5.dpk ├── ccIBPumpVCL5.res ├── ccIBPumpVCL6.dpk ├── ccIBPumpVCL6.res ├── ccIBPumpVCL7.dpk ├── ccIBPumpVCL7.res ├── ccIBPumpVCLReg.pas ├── ccSpinEdit.pas ├── ccTreeView.pas ├── ccTreeViewEditor.pas ├── ccTreeViewItemsEditor.dfm └── ccTreeViewItemsEditor.pas /.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 | -------------------------------------------------------------------------------- /Demos/CBuilder/Project1.bpr: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | [Version Info] 51 | IncludeVerInfo=0 52 | AutoIncBuild=0 53 | MajorVer=1 54 | MinorVer=0 55 | Release=0 56 | Build=0 57 | Debug=0 58 | PreRelease=0 59 | Special=0 60 | Private=0 61 | DLL=0 62 | Locale=1033 63 | CodePage=1252 64 | 65 | [Version Info Keys] 66 | CompanyName= 67 | FileDescription= 68 | FileVersion=1.0.0.0 69 | InternalName= 70 | LegalCopyright= 71 | LegalTrademarks= 72 | OriginalFilename= 73 | ProductName= 74 | ProductVersion=1.0.0.0 75 | Comments= 76 | 77 | [Debugging] 78 | DebugSourceDirs=$(BCB)\source\vcl 79 | 80 | [Parameters] 81 | RunParams= 82 | HostApplication= 83 | RemoteHost= 84 | RemotePath= 85 | RemoteDebug=0 86 | 87 | [Compiler] 88 | ShowInfoMsgs=0 89 | LinkDebugVcl=0 90 | LinkCGLIB=0 91 | 92 | [CORBA] 93 | AddServerUnit=1 94 | AddClientUnit=1 95 | PrecompiledHeaders=1 96 | 97 | [Language] 98 | ActiveLang= 99 | ProjectLang= 100 | RootDir= 101 | 102 | -------------------------------------------------------------------------------- /Demos/CBuilder/Project1.cpp: -------------------------------------------------------------------------------- 1 | //--------------------------------------------------------------------------- 2 | 3 | #include 4 | #pragma hdrstop 5 | USERES("Project1.res"); 6 | USEFORM("Unit1.cpp", Form1); 7 | //--------------------------------------------------------------------------- 8 | WINAPI WinMain(HINSTANCE, HINSTANCE, LPSTR, int) 9 | { 10 | try 11 | { 12 | Application->Initialize(); 13 | Application->CreateForm(__classid(TForm1), &Form1); 14 | Application->Run(); 15 | } 16 | catch (Exception &exception) 17 | { 18 | Application->ShowException(&exception); 19 | } 20 | return 0; 21 | } 22 | //--------------------------------------------------------------------------- 23 | -------------------------------------------------------------------------------- /Demos/CBuilder/Project1.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CleverComponents/Interbase-DataPump/b1e455a7dc356dfc0c2ff329107fc2163875146b/Demos/CBuilder/Project1.res -------------------------------------------------------------------------------- /Demos/CBuilder/Unit1.cpp: -------------------------------------------------------------------------------- 1 | //--------------------------------------------------------------------------- 2 | 3 | #include 4 | #pragma hdrstop 5 | 6 | #include "Unit1.h" 7 | //--------------------------------------------------------------------------- 8 | #pragma package(smart_init) 9 | #pragma resource "*.dfm" 10 | TForm1 *Form1; 11 | //--------------------------------------------------------------------------- 12 | __fastcall TForm1::TForm1(TComponent* Owner) 13 | : TForm(Owner) 14 | { 15 | } 16 | //--------------------------------------------------------------------------- 17 | 18 | typedef void (__stdcall *LPIBDataPumpCallBack)(PChar ARepLine); 19 | 20 | typedef int (__stdcall *LPIBPumpExec)(PChar AProfile, PChar ASourceFile, PChar ADestFile, 21 | LPIBDataPumpCallBack ACallBack); 22 | 23 | typedef void (__stdcall *LPIBPumpShow)(void); 24 | 25 | void __stdcall ShowProgress(PChar ARepLine) 26 | { 27 | Form1->Memo1->Lines->Add(ARepLine); 28 | } 29 | 30 | //--------------------------------------------------------------------------- 31 | void __fastcall TForm1::ShowIBPumpClick(TObject *Sender) 32 | { 33 | if (!m_hDLL) return; 34 | void* DLLFunc; 35 | DLLFunc = GetProcAddress(m_hDLL, "IBPumpShow"); 36 | if (DLLFunc) 37 | { 38 | (*(LPIBPumpShow)DLLFunc)(); 39 | } 40 | } 41 | //--------------------------------------------------------------------------- 42 | void __fastcall TForm1::RunSilentClick(TObject *Sender) 43 | { 44 | if (!m_hDLL) return; 45 | void* DLLFunc; 46 | int Res; 47 | AnsiString AProfile, ASourceFile, ADestFile; 48 | Memo1->Lines->Clear(); 49 | AProfile = "E:\\Progs\\IBDataPump\\DbDemos1.ibp"; 50 | // path/connection string to source database if different from profile 51 | // ASourceFile = "d:\\ibdata\\bs.gdb"; 52 | // path to dest database if different from profile 53 | // ADestFile = "d:\\ibdata\\bstest.gdb"; 54 | ASourceFile = ""; 55 | ADestFile = ""; 56 | 57 | DLLFunc = GetProcAddress(m_hDLL, "IBPumpExec"); 58 | if (DLLFunc) 59 | { 60 | Res = (*(LPIBPumpExec)DLLFunc)(AProfile.c_str(), ASourceFile.c_str(), ADestFile.c_str(), ShowProgress); 61 | if (Res == 0) ShowMessage("All Fine."); 62 | if (Res == -1) ShowMessage("Error!"); 63 | if (Res > 0) ShowMessage("Errors during pumping - " + IntToStr(Res)); 64 | } 65 | } 66 | //--------------------------------------------------------------------------- 67 | void __fastcall TForm1::FormCreate(TObject *Sender) 68 | { 69 | m_hDLL = LoadLibrary("IBPumpPlug.dll"); 70 | } 71 | //--------------------------------------------------------------------------- 72 | void __fastcall TForm1::FormDestroy(TObject *Sender) 73 | { 74 | FreeLibrary(m_hDLL); 75 | } 76 | //--------------------------------------------------------------------------- 77 | -------------------------------------------------------------------------------- /Demos/CBuilder/Unit1.dfm: -------------------------------------------------------------------------------- 1 | object Form1: TForm1 2 | Left = 208 3 | Top = 152 4 | Width = 696 5 | Height = 480 6 | Caption = 'Form1' 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 | OnCreate = FormCreate 15 | OnDestroy = FormDestroy 16 | PixelsPerInch = 96 17 | TextHeight = 13 18 | object RunSilent: TButton 19 | Left = 606 20 | Top = 424 21 | Width = 75 22 | Height = 25 23 | Anchors = [akRight, akBottom] 24 | Caption = 'Run Silent' 25 | TabOrder = 0 26 | OnClick = RunSilentClick 27 | end 28 | object Memo1: TMemo 29 | Left = 2 30 | Top = 2 31 | Width = 683 32 | Height = 415 33 | Anchors = [akLeft, akTop, akRight, akBottom] 34 | TabOrder = 1 35 | end 36 | object ShowIBPump: TButton 37 | Left = 502 38 | Top = 424 39 | Width = 75 40 | Height = 25 41 | Anchors = [akRight, akBottom] 42 | Caption = 'Show IBPump' 43 | TabOrder = 2 44 | OnClick = ShowIBPumpClick 45 | end 46 | end 47 | -------------------------------------------------------------------------------- /Demos/CBuilder/Unit1.h: -------------------------------------------------------------------------------- 1 | //--------------------------------------------------------------------------- 2 | 3 | #ifndef Unit1H 4 | #define Unit1H 5 | //--------------------------------------------------------------------------- 6 | #include 7 | #include 8 | #include 9 | #include 10 | //--------------------------------------------------------------------------- 11 | class TForm1 : public TForm 12 | { 13 | __published: // IDE-managed Components 14 | TButton *RunSilent; 15 | TMemo *Memo1; 16 | TButton *ShowIBPump; 17 | void __fastcall ShowIBPumpClick(TObject *Sender); 18 | void __fastcall RunSilentClick(TObject *Sender); 19 | void __fastcall FormCreate(TObject *Sender); 20 | void __fastcall FormDestroy(TObject *Sender); 21 | private: // User declarations 22 | HMODULE m_hDLL; 23 | public: // User declarations 24 | __fastcall TForm1(TComponent* Owner); 25 | }; 26 | //--------------------------------------------------------------------------- 27 | extern PACKAGE TForm1 *Form1; 28 | //--------------------------------------------------------------------------- 29 | #endif 30 | -------------------------------------------------------------------------------- /Demos/Delphi/Project1.dpr: -------------------------------------------------------------------------------- 1 | program Project1; 2 | 3 | uses 4 | Forms, 5 | Unit1 in 'Unit1.pas' {Form1}; 6 | 7 | {$R *.RES} 8 | 9 | begin 10 | Application.Initialize; 11 | Application.CreateForm(TForm1, Form1); 12 | Application.Run; 13 | end. 14 | -------------------------------------------------------------------------------- /Demos/Delphi/Project1.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CleverComponents/Interbase-DataPump/b1e455a7dc356dfc0c2ff329107fc2163875146b/Demos/Delphi/Project1.res -------------------------------------------------------------------------------- /Demos/Delphi/Unit1.dfm: -------------------------------------------------------------------------------- 1 | object Form1: TForm1 2 | Left = 208 3 | Top = 152 4 | Width = 696 5 | Height = 480 6 | Caption = 'Form1' 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 | OnCloseQuery = FormCloseQuery 15 | OnCreate = FormCreate 16 | PixelsPerInch = 96 17 | TextHeight = 13 18 | object RunSilent: TButton 19 | Left = 606 20 | Top = 424 21 | Width = 75 22 | Height = 25 23 | Anchors = [akRight, akBottom] 24 | Caption = 'Run Silent' 25 | TabOrder = 0 26 | OnClick = RunSilentClick 27 | end 28 | object Memo1: TMemo 29 | Left = 2 30 | Top = 2 31 | Width = 683 32 | Height = 415 33 | Anchors = [akLeft, akTop, akRight, akBottom] 34 | TabOrder = 1 35 | end 36 | object ShowIBPump: TButton 37 | Left = 502 38 | Top = 424 39 | Width = 75 40 | Height = 25 41 | Anchors = [akRight, akBottom] 42 | Caption = 'Show IBPump' 43 | TabOrder = 2 44 | OnClick = ShowIBPumpClick 45 | end 46 | end 47 | -------------------------------------------------------------------------------- /Demos/Delphi/Unit1.pas: -------------------------------------------------------------------------------- 1 | unit Unit1; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 | StdCtrls; 8 | 9 | type 10 | 11 | TIBDataPumpCallBack = procedure(ARepLine: PChar); stdcall; 12 | 13 | TForm1 = class(TForm) 14 | RunSilent: TButton; 15 | Memo1: TMemo; 16 | ShowIBPump: TButton; 17 | procedure RunSilentClick(Sender: TObject); 18 | procedure ShowIBPumpClick(Sender: TObject); 19 | procedure FormCreate(Sender: TObject); 20 | procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); 21 | private 22 | ABusy: boolean; 23 | public 24 | { Public declarations } 25 | end; 26 | 27 | function IBPumpExec(AProfile, ASourceFile, ADestFile: PChar; ACallBack: TIBDataPumpCallBack): integer; 28 | stdcall; external 'IBPumpPlug.dll '; 29 | 30 | procedure IBPumpShow; 31 | stdcall; external 'IBPumpPlug.dll '; 32 | 33 | var 34 | Form1: TForm1; 35 | 36 | implementation 37 | 38 | {$R *.DFM} 39 | 40 | procedure ShowProgress(ARepLine: PChar); stdcall; 41 | begin 42 | Form1.Memo1.Lines.Add(ARepLine); 43 | end; 44 | 45 | procedure TForm1.FormCreate(Sender: TObject); 46 | begin 47 | ABusy := False; 48 | end; 49 | 50 | procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean); 51 | begin 52 | CanClose := not ABusy; 53 | end; 54 | 55 | procedure TForm1.RunSilentClick(Sender: TObject); 56 | var 57 | AProfile, ASourceFile, ADestFile:string; 58 | Res: integer; 59 | begin 60 | if not ABusy then 61 | begin 62 | ABusy := True; 63 | try 64 | Memo1.Lines.Clear; 65 | { IB DataPump profile } 66 | AProfile := 'E:\Progs\IBDataPump\MSSQL_Northwind.ibp'; 67 | { path/connection string to source database if different from profile } 68 | // ASourceFile := 'd:\ibdata\bs.gdb'; 69 | { path to dest database if different from profile } 70 | // ADestFile := 'd:\ibdata\bstest.gdb'; 71 | ASourceFile := ''; 72 | ADestFile := ''; 73 | Res := IBPumpExec(PChar(AProfile), PChar(ASourceFile), PChar(ADestFile), ShowProgress); 74 | if Res = 0 then ShowMessage('All Fine.'); 75 | if Res = -1 then ShowMessage('Error!'); 76 | if Res > 0 then ShowMessage('Errors during pumping - ' + IntToStr(Res)); 77 | finally 78 | ABusy := False; 79 | end; 80 | end; 81 | end; 82 | 83 | procedure TForm1.ShowIBPumpClick(Sender: TObject); 84 | begin 85 | if not ABusy then 86 | begin 87 | ABusy := True; 88 | try 89 | IBPumpShow; 90 | finally 91 | ABusy := False; 92 | end; 93 | end; 94 | end; 95 | 96 | end. 97 | -------------------------------------------------------------------------------- /Demos/Test/Project1.dpr: -------------------------------------------------------------------------------- 1 | program Project1; 2 | 3 | uses 4 | Forms, 5 | Unit1 in 'Unit1.pas' {Form1}; 6 | 7 | {$R *.RES} 8 | 9 | begin 10 | Application.Initialize; 11 | Application.CreateForm(TForm1, Form1); 12 | Application.Run; 13 | end. 14 | -------------------------------------------------------------------------------- /Demos/Test/Unit1.dfm: -------------------------------------------------------------------------------- 1 | object Form1: TForm1 2 | Left = 208 3 | Top = 152 4 | Width = 696 5 | Height = 480 6 | Caption = 'Form1' 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 | PixelsPerInch = 96 15 | TextHeight = 13 16 | object RunSilent: TButton 17 | Left = 606 18 | Top = 424 19 | Width = 75 20 | Height = 25 21 | Anchors = [akRight, akBottom] 22 | Caption = 'Run Silent' 23 | TabOrder = 0 24 | OnClick = RunSilentClick 25 | end 26 | object Memo1: TMemo 27 | Left = 2 28 | Top = 2 29 | Width = 683 30 | Height = 415 31 | Anchors = [akLeft, akTop, akRight, akBottom] 32 | TabOrder = 1 33 | end 34 | object ShowIBPump: TButton 35 | Left = 502 36 | Top = 424 37 | Width = 75 38 | Height = 25 39 | Anchors = [akRight, akBottom] 40 | Caption = 'Show IBPump' 41 | TabOrder = 2 42 | OnClick = ShowIBPumpClick 43 | end 44 | end 45 | -------------------------------------------------------------------------------- /Demos/Test/Unit1.pas: -------------------------------------------------------------------------------- 1 | unit Unit1; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 | StdCtrls; 8 | 9 | type 10 | 11 | TIBDataPumpCallBack = procedure(ARepLine: PChar); stdcall; 12 | 13 | TForm1 = class(TForm) 14 | RunSilent: TButton; 15 | Memo1: TMemo; 16 | ShowIBPump: TButton; 17 | procedure RunSilentClick(Sender: TObject); 18 | procedure ShowIBPumpClick(Sender: TObject); 19 | private 20 | { Private declarations } 21 | public 22 | { Public declarations } 23 | end; 24 | 25 | function IBPumpExec(AProfile, ASourceFile, ADestFile: PChar; ACallBack: TIBDataPumpCallBack): integer; 26 | stdcall; external 'IBPumpPlug.dll '; 27 | 28 | procedure IBPumpShow; 29 | stdcall; external 'IBPumpPlug.dll '; 30 | 31 | var 32 | Form1: TForm1; 33 | 34 | implementation 35 | 36 | {$R *.DFM} 37 | 38 | procedure ShowProgress(ARepLine: PChar); stdcall; 39 | begin 40 | Form1.Memo1.Lines.Add(ARepLine); 41 | end; 42 | 43 | procedure TForm1.RunSilentClick(Sender: TObject); 44 | var 45 | AProfile, ASourceFile, ADestFile:string; 46 | Res: integer; 47 | begin 48 | Memo1.Lines.Clear; 49 | AProfile := 'E:\Progs\IBDataPump\DbDemos1.ibp'; 50 | // ASourceFile := 'd:\ibdata\bs.gdb'; 51 | // ADestFile := 'd:\ibdata\bstest.gdb'; 52 | ASourceFile := ''; 53 | ADestFile := ''; 54 | Res := IBPumpExec(PChar(AProfile), PChar(ASourceFile), PChar(ADestFile), ShowProgress); 55 | if Res = 0 then ShowMessage('All Fine.'); 56 | if Res = -1 then ShowMessage('Error!'); 57 | if Res > 0 then ShowMessage('Errors during pumping - ' + IntToStr(Res)); 58 | end; 59 | 60 | procedure TForm1.ShowIBPumpClick(Sender: TObject); 61 | begin 62 | IBPumpShow; 63 | end; 64 | 65 | end. 66 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | GNU LESSER GENERAL PUBLIC LICENSE 2 | Version 3, 29 June 2007 3 | 4 | Copyright (C) 2007 Free Software Foundation, Inc. 5 | Everyone is permitted to copy and distribute verbatim copies 6 | of this license document, but changing it is not allowed. 7 | 8 | 9 | This version of the GNU Lesser General Public License incorporates 10 | the terms and conditions of version 3 of the GNU General Public 11 | License, supplemented by the additional permissions listed below. 12 | 13 | 0. Additional Definitions. 14 | 15 | As used herein, "this License" refers to version 3 of the GNU Lesser 16 | General Public License, and the "GNU GPL" refers to version 3 of the GNU 17 | General Public License. 18 | 19 | "The Library" refers to a covered work governed by this License, 20 | other than an Application or a Combined Work as defined below. 21 | 22 | An "Application" is any work that makes use of an interface provided 23 | by the Library, but which is not otherwise based on the Library. 24 | Defining a subclass of a class defined by the Library is deemed a mode 25 | of using an interface provided by the Library. 26 | 27 | A "Combined Work" is a work produced by combining or linking an 28 | Application with the Library. The particular version of the Library 29 | with which the Combined Work was made is also called the "Linked 30 | Version". 31 | 32 | The "Minimal Corresponding Source" for a Combined Work means the 33 | Corresponding Source for the Combined Work, excluding any source code 34 | for portions of the Combined Work that, considered in isolation, are 35 | based on the Application, and not on the Linked Version. 36 | 37 | The "Corresponding Application Code" for a Combined Work means the 38 | object code and/or source code for the Application, including any data 39 | and utility programs needed for reproducing the Combined Work from the 40 | Application, but excluding the System Libraries of the Combined Work. 41 | 42 | 1. Exception to Section 3 of the GNU GPL. 43 | 44 | You may convey a covered work under sections 3 and 4 of this License 45 | without being bound by section 3 of the GNU GPL. 46 | 47 | 2. Conveying Modified Versions. 48 | 49 | If you modify a copy of the Library, and, in your modifications, a 50 | facility refers to a function or data to be supplied by an Application 51 | that uses the facility (other than as an argument passed when the 52 | facility is invoked), then you may convey a copy of the modified 53 | version: 54 | 55 | a) under this License, provided that you make a good faith effort to 56 | ensure that, in the event an Application does not supply the 57 | function or data, the facility still operates, and performs 58 | whatever part of its purpose remains meaningful, or 59 | 60 | b) under the GNU GPL, with none of the additional permissions of 61 | this License applicable to that copy. 62 | 63 | 3. Object Code Incorporating Material from Library Header Files. 64 | 65 | The object code form of an Application may incorporate material from 66 | a header file that is part of the Library. You may convey such object 67 | code under terms of your choice, provided that, if the incorporated 68 | material is not limited to numerical parameters, data structure 69 | layouts and accessors, or small macros, inline functions and templates 70 | (ten or fewer lines in length), you do both of the following: 71 | 72 | a) Give prominent notice with each copy of the object code that the 73 | Library is used in it and that the Library and its use are 74 | covered by this License. 75 | 76 | b) Accompany the object code with a copy of the GNU GPL and this license 77 | document. 78 | 79 | 4. Combined Works. 80 | 81 | You may convey a Combined Work under terms of your choice that, 82 | taken together, effectively do not restrict modification of the 83 | portions of the Library contained in the Combined Work and reverse 84 | engineering for debugging such modifications, if you also do each of 85 | the following: 86 | 87 | a) Give prominent notice with each copy of the Combined Work that 88 | the Library is used in it and that the Library and its use are 89 | covered by this License. 90 | 91 | b) Accompany the Combined Work with a copy of the GNU GPL and this license 92 | document. 93 | 94 | c) For a Combined Work that displays copyright notices during 95 | execution, include the copyright notice for the Library among 96 | these notices, as well as a reference directing the user to the 97 | copies of the GNU GPL and this license document. 98 | 99 | d) Do one of the following: 100 | 101 | 0) Convey the Minimal Corresponding Source under the terms of this 102 | License, and the Corresponding Application Code in a form 103 | suitable for, and under terms that permit, the user to 104 | recombine or relink the Application with a modified version of 105 | the Linked Version to produce a modified Combined Work, in the 106 | manner specified by section 6 of the GNU GPL for conveying 107 | Corresponding Source. 108 | 109 | 1) Use a suitable shared library mechanism for linking with the 110 | Library. A suitable mechanism is one that (a) uses at run time 111 | a copy of the Library already present on the user's computer 112 | system, and (b) will operate properly with a modified version 113 | of the Library that is interface-compatible with the Linked 114 | Version. 115 | 116 | e) Provide Installation Information, but only if you would otherwise 117 | be required to provide such information under section 6 of the 118 | GNU GPL, and only to the extent that such information is 119 | necessary to install and execute a modified version of the 120 | Combined Work produced by recombining or relinking the 121 | Application with a modified version of the Linked Version. (If 122 | you use option 4d0, the Installation Information must accompany 123 | the Minimal Corresponding Source and Corresponding Application 124 | Code. If you use option 4d1, you must provide the Installation 125 | Information in the manner specified by section 6 of the GNU GPL 126 | for conveying Corresponding Source.) 127 | 128 | 5. Combined Libraries. 129 | 130 | You may place library facilities that are a work based on the 131 | Library side by side in a single library together with other library 132 | facilities that are not Applications and are not covered by this 133 | License, and convey such a combined library under terms of your 134 | choice, if you do both of the following: 135 | 136 | a) Accompany the combined library with a copy of the same work based 137 | on the Library, uncombined with any other library facilities, 138 | conveyed under the terms of this License. 139 | 140 | b) Give prominent notice with the combined library that part of it 141 | is a work based on the Library, and explaining where to find the 142 | accompanying uncombined form of the same work. 143 | 144 | 6. Revised Versions of the GNU Lesser General Public License. 145 | 146 | The Free Software Foundation may publish revised and/or new versions 147 | of the GNU Lesser General Public License from time to time. Such new 148 | versions will be similar in spirit to the present version, but may 149 | differ in detail to address new problems or concerns. 150 | 151 | Each version is given a distinguishing version number. If the 152 | Library as you received it specifies that a certain numbered version 153 | of the GNU Lesser General Public License "or any later version" 154 | applies to it, you have the option of following the terms and 155 | conditions either of that published version or of any later version 156 | published by the Free Software Foundation. If the Library as you 157 | received it does not specify a version number of the GNU Lesser 158 | General Public License, you may choose any version of the GNU Lesser 159 | General Public License ever published by the Free Software Foundation. 160 | 161 | If the Library as you received it specifies that a proxy can decide 162 | whether future versions of the GNU Lesser General Public License shall 163 | apply, that proxy's public statement of acceptance of any version is 164 | permanent authorization for you to choose that version for the 165 | Library. 166 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Interbase DataPump 2 | 3 | 4 | 5 | Interbase DataPump allows you to pump data and migrate from any ADO/BDE/ODBC sources (such as dBase, Paradox, Access, MSSQL, Sybase, Oracle, DB2 etc) and native Interbase/Firebird databases into Interbase/Firebird databases easy, fast and painless with total control over the whole process. 6 | 7 | You can generate SQL script to create Interbase/Firebird database based on your ADO/BDE/ODBC source. This tool will help you to migrate from Interbase 5.xx and older Interbase databases to the new Interbase 6.x/Firebird format. Easily can be used for generic update/replication. A "must have" utility for all Interbase/Firebird developers and administrators! 8 | 9 | ## What Interbase DataPump can do 10 | * The first and very unique and important option is calculating of proper tables' order and resolving all kinds of links between tables. This means that tables will be processed in the order in which they are dependant on each other. This is quite important, if you have a database with more than 50 tables, which have a lot of referential constraints. 11 | * The utility can generate complete SQL script to create Interbase database based on your ADO/BDE/ODBC source. This is not limited by tables and fields structures and types, but also include indexes, primary keys, AutoInc fields, Checks, Referral Integrity etc. and not to forget ability to select how to convert/map source database data types into native Interbase/Firebird data types (including all special cases such as boolean, string, blob and numeric fields). For AutoInc fields triggers can be created together with all necessary generators (with proper initial values!). Please take a tour to learn all Interbase DataPump possibilities. Detailed warnings will be created for every situation when original source can not be translated to Interbase/Firebird properly (means that original source feature not supported by Interbase/Firebird and can not be emulated). 12 | * Ability to pump data from any ADO/BDE/ODBC sources and native Interbase databases. Now you can master Interbase/Firebird databases from virtually any kind of data sources without loosing even a tiny piece of original functionality! 13 | * Options to switch on/off triggers, empty tables, control transactions frequency, string case and much more. 14 | * It has a very wide range of settings and gives full control over the conversion/pumping process. You can set your own relations between source and destination tables, fields and generators, which makes program very flexible. 15 | * You can define your own select statements for any ADO/BDE/ODBC sources using all power of your SQL server/engine and pump data from this user-defined sources in a very same way as from standard tables. Note that you can use joins, union, views etc. and all kind of special functions in such custom SQL statements. 16 | * You can define your own SQL statements for destination sources as well. By using this feature you can update your Interbase/Firebird database with data from other source or even setup replication. 17 | * This tool has unique "silent mode" which gives you ability to use this tool to update your clients databases in automatic mode. You can use it as a plug-in for your application and call Interbase DataPump services from your own application written on any language. 18 | * Produces complete and detailed report and progress indication. 19 | * Application is very fast with no overhead. By using only native access to all data sources it will provide unbeatable speed when you most need it. 20 | * Nice and very easy to use interface. You can save all settings, results or reports at any time and use them later! 21 | * This is free tool - you do not have to pay for using it. 22 | * Detailed online help, FAQ and support available from our website. 23 | * Sources available. 24 | 25 | [**Please take a tour to learn more about Interbase DataPump**](https://www.clevercomponents.com/products/datapump/dp-tour.asp) 26 | 27 | ## Important 28 | * This is "One Hour Solution" - in most cases it takes even less than an hour to pump data to your Interbase database. 29 | * Interbase DataPump is a freeware product: [**Download Interbase DataPump**](https://www.clevercomponents.com/downloads/datapump/) 30 | 31 | -------------------------------------------------------------------------------- /Sources/IBDataPump/IBEIntf.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CleverComponents/Interbase-DataPump/b1e455a7dc356dfc0c2ff329107fc2163875146b/Sources/IBDataPump/IBEIntf.pas -------------------------------------------------------------------------------- /Sources/IBDataPump/IBPump.dpr: -------------------------------------------------------------------------------- 1 | { 2 | Copyright (c) 2000-2005 CleverComponents.com 3 | Product: Interbase DataPump 4 | Author: Alexandre Poloziouk 5 | Unit: IBPump.dpr 6 | } 7 | 8 | program IBPump; 9 | 10 | {$INCLUDE ccGetVer.inc} 11 | 12 | uses 13 | Forms, 14 | Windows, 15 | adodb in 'adodb.pas', 16 | ibpDM in 'ibpDM.pas' {FibpDM: TDataModule}, 17 | ibpHelp in 'ibpHelp.pas' {FibpHelp}, 18 | ibpGenSql in 'ibpGenSql.pas' {FibpGenSql}, 19 | ibpIncFields in 'ibpIncFields.pas' {FibpIncDields}, 20 | ibpSQLEditor in 'ibpSQLEditor.pas' {FibpSQLEditor}, 21 | ibpUpdDefs in 'ibpUpdDefs.pas' {FibpUpdDefs}, 22 | ibpMain in 'ibpMain.pas' {FibpMain}, 23 | ibmUpdWizard in 'ibmUpdWizard.pas' {ibpUpdWizard}; 24 | 25 | {$R *.RES} 26 | 27 | var 28 | FibpMain: TibpMain; 29 | 30 | begin 31 | if ParamCount > 0 then 32 | begin 33 | ibpMain.DoCommandLine; 34 | end 35 | else 36 | begin 37 | Application.Initialize; 38 | 39 | Application.CreateForm(TibpMain, FibpMain); 40 | Application.CreateForm(TibpHelp, FibpHelp); 41 | 42 | FibpHelp.Show; 43 | FibpHelp.Update; 44 | 45 | Windows.Sleep(2000); 46 | 47 | FibpHelp.Free; 48 | Application.Run; 49 | end; 50 | end. 51 | -------------------------------------------------------------------------------- /Sources/IBDataPump/IBPump.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CleverComponents/Interbase-DataPump/b1e455a7dc356dfc0c2ff329107fc2163875146b/Sources/IBDataPump/IBPump.res -------------------------------------------------------------------------------- /Sources/IBDataPump/IBPumpPlug.dpr: -------------------------------------------------------------------------------- 1 | { 2 | Copyright (c) 2000-2005 CleverComponents.com 3 | Product: Interbase DataPump 4 | Author: Alexandre Poloziouk 5 | Unit: IBPumpPlug.dpr 6 | } 7 | 8 | library IBPumpPlug; 9 | 10 | {$INCLUDE ccGetVer.inc} 11 | 12 | uses 13 | SysUtils, 14 | Classes, 15 | IBEIntf, 16 | Forms, 17 | Windows, 18 | ActiveX, 19 | // Fixed Borland ADODB module 20 | ADODB in 'ADODB.pas', 21 | ibpDM in 'ibpDM.pas' {FibpDM: TDataModule}, 22 | ibpHelp in 'ibpHelp.pas' {FibpHelp}, 23 | ibpGenSql in 'ibpGenSql.pas' {FibpGenSql}, 24 | ibpIncFields in 'ibpIncFields.pas' {FibpIncDields}, 25 | ibpSQLEditor in 'ibpSQLEditor.pas' {FibpSQLEditor}, 26 | ibpUpdDefs in 'ibpUpdDefs.pas' {FibpUpdDefs}, 27 | ibpMain in 'ibpMain.pas' {FibpMain}; 28 | 29 | {$R *.RES} 30 | 31 | procedure plugin_execute(Intf: TIBEInterface); stdcall; 32 | var 33 | FibpMain: TibpMain; 34 | OldHandle: THandle; 35 | i, DBCount: integer; 36 | begin 37 | CoInitialize(nil); 38 | try 39 | ibpMain.IsParamMode := False; 40 | OldHandle := Application.Handle; 41 | Application.Handle := TApplication(Intf.MainApplication).Handle; 42 | FibpMain := TibpMain.Create(TApplication(Intf.MainApplication)); 43 | 44 | FibpHelp := TibpHelp.Create(TApplication(Intf.MainApplication)); 45 | FibpHelp.Show; 46 | FibpHelp.Update; 47 | Windows.Sleep(2000); 48 | FibpHelp.Free; 49 | 50 | try 51 | DBCount := Intf.DatabasesCount; 52 | for i := 0 to pred(DBCount) do 53 | if Intf.DatabaseActive(i) then 54 | begin 55 | FibpMain.eDestDatabase.Text:= string(Intf.DatabaseName(i)); 56 | break; 57 | end; 58 | FibpMain.ShowModal; 59 | finally 60 | FibpMain.Free; 61 | end; 62 | Application.Handle := OldHandle; 63 | finally 64 | CoUninitialize; 65 | end; 66 | end; 67 | 68 | procedure get_plugin_info(PluginInfo: pointer); stdcall; 69 | begin 70 | with PIBEPluginInfo(PluginInfo)^ do begin 71 | PluginName := ibpMain.AppTitle; 72 | Description := 73 | 'Interbase DataPump allow you to pump data from any ADO/BDE/ODBC sources (dBase, ' + 74 | 'Paradox, Access, MSSQL, Sybase, Oracle, DB2 etc) into Interbase/Firebird databases easy, fast and ' + 75 | 'painless.' + #13 + 76 | 'This programm will also help you to migrate from Interbase 5.xx and older Interbase '+ 77 | 'databases to the new Interbase 6.xx/Firebird format.' + #13 + 78 | 'You can also use it to pump data between Interbase/Firebird databases.'; 79 | MenuCaption := ibpMain.AppTitle + ' ...'; 80 | end; 81 | end; 82 | 83 | procedure IBPumpShow; stdcall; 84 | var 85 | FibpMain: TibpMain; 86 | begin 87 | CoInitialize(nil); 88 | try 89 | ibpMain.IsParamMode := False; 90 | FibpMain := TibpMain.Create(Application); 91 | 92 | FibpHelp := TibpHelp.Create(Application); 93 | FibpHelp.Show; 94 | FibpHelp.Update; 95 | Windows.Sleep(2000); 96 | FibpHelp.Free; 97 | 98 | try 99 | FibpMain.ShowModal; 100 | finally 101 | FibpMain.Free; 102 | end; 103 | finally 104 | CoUninitialize; 105 | end; 106 | end; 107 | 108 | function IBPumpRun(AProfile, ASourceFile, ADestFile: string; AParamRep: TStrings): integer; stdcall; 109 | begin 110 | raise Exception.Create('IBPumpPlug: Function IBPumpRun is not supported anymore. Use IBPumpExec instead.'); 111 | end; 112 | 113 | function IBPumpExec(AProfile, ASourceFile, ADestFile: PChar; ACallBack: TIBDataPumpCallBack): integer; stdcall; 114 | begin 115 | result := ibpMain.DoIBPumpExec(AProfile, ASourceFile, ADestFile, ACallBack); 116 | end; 117 | 118 | exports 119 | plugin_execute, 120 | get_plugin_info, 121 | IBPumpRun, 122 | IBPumpExec, 123 | IBPumpShow; 124 | 125 | end. 126 | -------------------------------------------------------------------------------- /Sources/IBDataPump/IBPumpPlug.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CleverComponents/Interbase-DataPump/b1e455a7dc356dfc0c2ff329107fc2163875146b/Sources/IBDataPump/IBPumpPlug.res -------------------------------------------------------------------------------- /Sources/IBDataPump/ccGetVer.inc: -------------------------------------------------------------------------------- 1 | { ccGetVer.inc } 2 | 3 | {$B-} { Complete Boolean Evaluation } 4 | {$R-} { Range-Checking } 5 | {$T-} { Typed @ operator } 6 | {$X+} { Extended syntax } 7 | {$P+} { Open string params } 8 | {$J+} { Writeable structured consts } 9 | {$H+} { Use long strings by default } 10 | {$Q-} { Overflow checking } 11 | 12 | {$IFDEF VER130} { Delphi 5.0 } 13 | {$DEFINE DELPHI5} 14 | {$ENDIF} 15 | 16 | {$IFDEF VER140} { Delphi 6.0 } 17 | {$DEFINE DELPHI5} 18 | {$DEFINE DELPHI6} 19 | {$ENDIF} 20 | 21 | {$IFDEF VER150} { Delphi 7.0 } 22 | {$DEFINE DELPHI5} 23 | {$DEFINE DELPHI6} 24 | {$DEFINE DELPHI7} 25 | {$ENDIF} 26 | 27 | {$DEFINE CCNEWS} -------------------------------------------------------------------------------- /Sources/IBDataPump/ibmUpdWizard.dfm: -------------------------------------------------------------------------------- 1 | object ibpUpdWizard: TibpUpdWizard 2 | Left = 385 3 | Top = 222 4 | Width = 663 5 | Height = 480 6 | Caption = 'Custom SQL Wizard' 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 = poScreenCenter 15 | Scaled = False 16 | OnCreate = FormCreate 17 | OnDestroy = FormDestroy 18 | PixelsPerInch = 96 19 | TextHeight = 13 20 | object Panel1: TPanel 21 | Left = 0 22 | Top = 400 23 | Width = 647 24 | Height = 41 25 | Align = alBottom 26 | BevelOuter = bvNone 27 | TabOrder = 0 28 | DesignSize = ( 29 | 647 30 | 41) 31 | object btnSave: TButton 32 | Left = 481 33 | Top = 8 34 | Width = 75 35 | Height = 25 36 | Anchors = [akTop, akRight, akBottom] 37 | Caption = '&Save' 38 | TabOrder = 0 39 | OnClick = btnSaveClick 40 | end 41 | object btnCancel: TButton 42 | Left = 569 43 | Top = 8 44 | Width = 75 45 | Height = 25 46 | Anchors = [akTop, akRight, akBottom] 47 | Caption = '&Cancel' 48 | ModalResult = 2 49 | TabOrder = 1 50 | end 51 | end 52 | object Panel2: TPanel 53 | Left = 0 54 | Top = 0 55 | Width = 647 56 | Height = 400 57 | Align = alClient 58 | BevelOuter = bvNone 59 | TabOrder = 1 60 | object Splitter2: TSplitter 61 | Left = 198 62 | Top = 0 63 | Height = 400 64 | Beveled = True 65 | end 66 | object Panel3: TPanel 67 | Left = 201 68 | Top = 0 69 | Width = 446 70 | Height = 400 71 | Align = alClient 72 | BevelOuter = bvNone 73 | TabOrder = 0 74 | object Splitter1: TSplitter 75 | Left = 0 76 | Top = 278 77 | Width = 446 78 | Height = 3 79 | Cursor = crVSplit 80 | Align = alBottom 81 | Beveled = True 82 | end 83 | object Panel5: TPanel 84 | Left = 0 85 | Top = 281 86 | Width = 446 87 | Height = 119 88 | Align = alBottom 89 | Anchors = [akBottom] 90 | BevelOuter = bvNone 91 | TabOrder = 1 92 | object memSQL: TMemo 93 | Left = 0 94 | Top = 21 95 | Width = 446 96 | Height = 98 97 | Align = alClient 98 | HideSelection = False 99 | ScrollBars = ssBoth 100 | TabOrder = 1 101 | WordWrap = False 102 | end 103 | object Panel7: TPanel 104 | Left = 0 105 | Top = 0 106 | Width = 446 107 | Height = 21 108 | Align = alTop 109 | BevelOuter = bvNone 110 | TabOrder = 0 111 | DesignSize = ( 112 | 446 113 | 21) 114 | object cbSQL: TCheckBox 115 | Left = 4 116 | Top = 2 117 | Width = 260 118 | Height = 17 119 | Anchors = [akLeft, akTop, akRight] 120 | Caption = 'Overwrite Generated SQL' 121 | Font.Charset = DEFAULT_CHARSET 122 | Font.Color = clWindowText 123 | Font.Height = -11 124 | Font.Name = 'MS Sans Serif' 125 | Font.Style = [fsUnderline] 126 | ParentFont = False 127 | TabOrder = 0 128 | OnClick = cbSQLClick 129 | end 130 | object btnTest: TButton 131 | Left = 373 132 | Top = 1 133 | Width = 75 134 | Height = 19 135 | Anchors = [akTop, akRight] 136 | Caption = 'Test' 137 | TabOrder = 1 138 | OnClick = btnTestClick 139 | end 140 | end 141 | end 142 | object Panel6: TPanel 143 | Left = 0 144 | Top = 0 145 | Width = 446 146 | Height = 278 147 | Align = alClient 148 | BevelOuter = bvNone 149 | TabOrder = 0 150 | object Panel8: TPanel 151 | Left = 0 152 | Top = 0 153 | Width = 446 154 | Height = 93 155 | Align = alTop 156 | BevelOuter = bvNone 157 | TabOrder = 0 158 | DesignSize = ( 159 | 446 160 | 93) 161 | object lInsertNameFormat: TLabel 162 | Left = 6 163 | Top = 47 164 | Width = 92 165 | Height = 13 166 | Caption = 'Insert Name Format' 167 | end 168 | object lUpdateNameFormat: TLabel 169 | Left = 6 170 | Top = 20 171 | Width = 101 172 | Height = 13 173 | Caption = 'Update Name Format' 174 | end 175 | object lDeleteNameFormat: TLabel 176 | Left = 6 177 | Top = 74 178 | Width = 97 179 | Height = 13 180 | Caption = 'Delete Name Format' 181 | end 182 | object Bevel2: TBevel 183 | Left = 0 184 | Top = 7 185 | Width = 454 186 | Height = 2 187 | Anchors = [akLeft, akTop, akRight] 188 | Shape = bsBottomLine 189 | end 190 | object Label1: TLabel 191 | Left = 0 192 | Top = 0 193 | Width = 75 194 | Height = 13 195 | Caption = 'Default Settings' 196 | Font.Charset = DEFAULT_CHARSET 197 | Font.Color = clWindowText 198 | Font.Height = -11 199 | Font.Name = 'MS Sans Serif' 200 | Font.Style = [fsUnderline] 201 | ParentFont = False 202 | end 203 | object lDefSQLStat: TLabel 204 | Left = 259 205 | Top = 47 206 | Width = 72 207 | Height = 13 208 | Anchors = [akTop, akRight] 209 | Caption = 'SQL Statement' 210 | end 211 | object lDefWhere: TLabel 212 | Left = 259 213 | Top = 74 214 | Width = 68 215 | Height = 13 216 | Anchors = [akTop, akRight] 217 | Caption = 'WHERE fields' 218 | end 219 | object eInsertNameFormat: TEdit 220 | Left = 112 221 | Top = 43 222 | Width = 133 223 | Height = 21 224 | Hint = 'INS_%s_SQL' 225 | Anchors = [akLeft, akTop, akRight] 226 | ParentShowHint = False 227 | ShowHint = True 228 | TabOrder = 1 229 | Text = 'INS_%s_SQL' 230 | OnChange = eUpdateNameFormatChange 231 | end 232 | object eUpdateNameFormat: TEdit 233 | Left = 112 234 | Top = 16 235 | Width = 250 236 | Height = 21 237 | Hint = 'UPD_%s_SQL' 238 | Anchors = [akLeft, akTop, akRight] 239 | ParentShowHint = False 240 | ShowHint = False 241 | TabOrder = 0 242 | Text = 'UPD_%s_SQL' 243 | OnChange = eUpdateNameFormatChange 244 | end 245 | object eDeleteNameFormat: TEdit 246 | Left = 112 247 | Top = 70 248 | Width = 133 249 | Height = 21 250 | Hint = 'DEL_%s_SQL' 251 | Anchors = [akLeft, akTop, akRight] 252 | ParentShowHint = False 253 | ShowHint = False 254 | TabOrder = 2 255 | Text = 'DEL_%s_SQL' 256 | OnChange = eUpdateNameFormatChange 257 | end 258 | object btnDefaults: TButton 259 | Left = 373 260 | Top = 13 261 | Width = 75 262 | Height = 25 263 | Anchors = [akTop, akRight] 264 | Caption = 'Set Default' 265 | TabOrder = 3 266 | OnClick = btnDefaultsClick 267 | end 268 | object cbDefSQL: TComboBox 269 | Left = 340 270 | Top = 43 271 | Width = 110 272 | Height = 21 273 | Style = csDropDownList 274 | Anchors = [akTop, akRight] 275 | ItemHeight = 13 276 | TabOrder = 4 277 | OnChange = cbDefSQLChange 278 | Items.Strings = ( 279 | 'Update' 280 | 'Insert' 281 | 'Delete') 282 | end 283 | object cbDefWhere: TComboBox 284 | Left = 340 285 | Top = 70 286 | Width = 110 287 | Height = 21 288 | Style = csDropDownList 289 | Anchors = [akTop, akRight] 290 | ItemHeight = 13 291 | TabOrder = 5 292 | Items.Strings = ( 293 | 'Key Fields' 294 | 'All Fields' 295 | 'Not Null Fields' 296 | 'Custom Fields') 297 | end 298 | end 299 | object Panel9: TPanel 300 | Left = 0 301 | Top = 93 302 | Width = 446 303 | Height = 185 304 | Align = alClient 305 | BevelOuter = bvNone 306 | TabOrder = 1 307 | object Panel10: TPanel 308 | Left = 0 309 | Top = 0 310 | Width = 446 311 | Height = 93 312 | Align = alTop 313 | BevelOuter = bvNone 314 | TabOrder = 0 315 | DesignSize = ( 316 | 446 317 | 93) 318 | object Bevel1: TBevel 319 | Left = 0 320 | Top = 7 321 | Width = 454 322 | Height = 2 323 | Anchors = [akLeft, akTop, akRight] 324 | Shape = bsBottomLine 325 | end 326 | object Label2: TLabel 327 | Left = 0 328 | Top = 0 329 | Width = 113 330 | Height = 13 331 | Caption = 'Selected Table Settings' 332 | Font.Charset = DEFAULT_CHARSET 333 | Font.Color = clWindowText 334 | Font.Height = -11 335 | Font.Name = 'MS Sans Serif' 336 | Font.Style = [fsUnderline] 337 | ParentFont = False 338 | end 339 | object lSQLStatement: TLabel 340 | Left = 6 341 | Top = 46 342 | Width = 72 343 | Height = 13 344 | Caption = 'SQL Statement' 345 | end 346 | object lWhere: TLabel 347 | Left = 6 348 | Top = 72 349 | Width = 68 350 | Height = 13 351 | Caption = 'WHERE fields' 352 | end 353 | object cbSQLStatement: TComboBox 354 | Left = 112 355 | Top = 42 356 | Width = 250 357 | Height = 21 358 | Style = csDropDownList 359 | Anchors = [akLeft, akTop, akRight] 360 | ItemHeight = 13 361 | TabOrder = 2 362 | OnChange = cbSQLStatementChange 363 | Items.Strings = ( 364 | 'Update' 365 | 'Insert' 366 | 'Delete') 367 | end 368 | object eName: TEdit 369 | Left = 112 370 | Top = 16 371 | Width = 250 372 | Height = 21 373 | Anchors = [akLeft, akTop, akRight] 374 | ParentShowHint = False 375 | ShowHint = False 376 | TabOrder = 1 377 | end 378 | object cbName: TCheckBox 379 | Left = 4 380 | Top = 19 381 | Width = 106 382 | Height = 17 383 | Caption = 'Overwrite Name' 384 | TabOrder = 0 385 | OnClick = cbNameClick 386 | end 387 | object cbWhere: TComboBox 388 | Left = 112 389 | Top = 68 390 | Width = 250 391 | Height = 21 392 | Style = csDropDownList 393 | Anchors = [akLeft, akTop, akRight] 394 | ItemHeight = 13 395 | TabOrder = 3 396 | OnChange = cbWhereChange 397 | Items.Strings = ( 398 | 'Key Fields' 399 | 'All Fields' 400 | 'Not Null Fields' 401 | 'Custom Fields') 402 | end 403 | end 404 | object Panel11: TPanel 405 | Left = 0 406 | Top = 93 407 | Width = 446 408 | Height = 92 409 | Align = alClient 410 | BevelOuter = bvNone 411 | TabOrder = 1 412 | object Splitter3: TSplitter 413 | Left = 235 414 | Top = 0 415 | Height = 92 416 | Align = alRight 417 | Beveled = True 418 | end 419 | object pWhere: TPanel 420 | Left = 0 421 | Top = 0 422 | Width = 235 423 | Height = 92 424 | Align = alClient 425 | BevelOuter = bvNone 426 | TabOrder = 1 427 | object Panel15: TPanel 428 | Left = 0 429 | Top = 0 430 | Width = 235 431 | Height = 21 432 | Align = alTop 433 | BevelOuter = bvNone 434 | TabOrder = 0 435 | DesignSize = ( 436 | 235 437 | 21) 438 | object cbOverWhere: TCheckBox 439 | Left = 4 440 | Top = 2 441 | Width = 232 442 | Height = 17 443 | Anchors = [akLeft, akTop, akRight] 444 | Caption = 'Overwrite Where Fields' 445 | TabOrder = 0 446 | OnClick = cbOverWhereClick 447 | end 448 | end 449 | end 450 | object pValueSet: TPanel 451 | Left = 238 452 | Top = 0 453 | Width = 208 454 | Height = 92 455 | Align = alRight 456 | BevelOuter = bvNone 457 | TabOrder = 0 458 | object Panel14: TPanel 459 | Left = 0 460 | Top = 0 461 | Width = 208 462 | Height = 21 463 | Align = alTop 464 | BevelOuter = bvNone 465 | TabOrder = 0 466 | DesignSize = ( 467 | 208 468 | 21) 469 | object cbOverValueSet: TCheckBox 470 | Left = 4 471 | Top = 2 472 | Width = 202 473 | Height = 17 474 | Anchors = [akLeft, akTop, akRight] 475 | Caption = 'Overwrite Value(Set ) Fields' 476 | TabOrder = 0 477 | OnClick = cbOverValueSetClick 478 | end 479 | end 480 | end 481 | end 482 | end 483 | end 484 | end 485 | object Panel4: TPanel 486 | Left = 0 487 | Top = 0 488 | Width = 198 489 | Height = 400 490 | Align = alLeft 491 | BevelOuter = bvNone 492 | TabOrder = 1 493 | end 494 | end 495 | end 496 | -------------------------------------------------------------------------------- /Sources/IBDataPump/ibmUpdWizard.pas: -------------------------------------------------------------------------------- 1 | { 2 | Copyright (c) 2000-2005 CleverComponents.com 3 | Product: Interbase DataPump 4 | Author: Alexandre Poloziouk 5 | Unit: ibmUpdWizard.pas 6 | } 7 | 8 | unit ibmUpdWizard; 9 | 10 | interface 11 | 12 | uses 13 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 14 | ComCtrls, ExtCtrls, StdCtrls, Mask, IBQuery, Db, IBCustomDataSet, IBUpdateSQL, 15 | Menus, IBDatabase, IBSQL, ImgList, IBHeader, IBDatabaseInfo, ShellApi, 16 | Dbtables, IBExtract, ADODB, Buttons, ActiveX, IBTable, 17 | {$IFDEF DELPHI6} 18 | Variants, 19 | {$ENDIF} 20 | ibpMain, ibpDM, ibpHelp, ccTreeView, ccSpinEdit, ccButtonEdit; 21 | 22 | type 23 | 24 | { TUpdWizardCollectionItem } 25 | 26 | TUpdWizardCollectionItem = class(TCollectionItem) 27 | private 28 | FTableName: string; 29 | FOverName: boolean; 30 | FName: string; 31 | FSQLStatement: integer; 32 | FWhereOption: integer; 33 | FOverValueSet: boolean; 34 | FOverWhere: boolean; 35 | FValueSetFields: TStringList; 36 | FWhereFields: TStringList; 37 | FKeyFields: TStringList; 38 | FNotNullFields: TStringList; 39 | FOverSQL: boolean; 40 | FSQL: TStringList; 41 | public 42 | constructor Create(Collection: TCollection); override; 43 | destructor Destroy; override; 44 | published 45 | property TableName: string read FTableName write FTableName; 46 | property OverName: boolean read FOverName write FOverName; 47 | property Name: string read FName write FName; 48 | property SQLStatement: integer read FSQLStatement write FSQLStatement; 49 | property WhereOption: integer read FWhereOption write FWhereOption; 50 | property OverValueSet: boolean read FOverValueSet write FOverValueSet; 51 | property OverWhere: boolean read FOverWhere write FOverWhere; 52 | property ValueSetFields: TStringList read FValueSetFields write FValueSetFields; 53 | property WhereFields: TStringList read FWhereFields write FWhereFields; 54 | property KeyFields: TStringList read FKeyFields write FKeyFields; 55 | property NotNullFields: TStringList read FNotNullFields write FNotNullFields; 56 | property OverSQL: boolean read FOverSQL write FOverSQL; 57 | property SQL: TStringList read FSQL write FSQL; 58 | end; 59 | 60 | { TUpdWizardCollection } 61 | 62 | TUpdWizardCollection = class(TCollection) 63 | protected 64 | function GetItem(Index: Integer): TUpdWizardCollectionItem; 65 | procedure SetItem(Index: Integer; Value: TUpdWizardCollectionItem); 66 | public 67 | function Add: TUpdWizardCollectionItem; 68 | function FindByName(const AName: string): TUpdWizardCollectionItem; 69 | 70 | property Items[Index: Integer]: TUpdWizardCollectionItem read GetItem write SetItem; 71 | end; 72 | 73 | { TibpUpdWizard } 74 | 75 | TibpUpdWizard = class(TForm) 76 | Panel1: TPanel; 77 | btnSave: TButton; 78 | btnCancel: TButton; 79 | Panel2: TPanel; 80 | Splitter2: TSplitter; 81 | Panel3: TPanel; 82 | Splitter1: TSplitter; 83 | Panel5: TPanel; 84 | Panel6: TPanel; 85 | Panel4: TPanel; 86 | memSQL: TMemo; 87 | Panel8: TPanel; 88 | lInsertNameFormat: TLabel; 89 | lUpdateNameFormat: TLabel; 90 | lDeleteNameFormat: TLabel; 91 | eInsertNameFormat: TEdit; 92 | eUpdateNameFormat: TEdit; 93 | eDeleteNameFormat: TEdit; 94 | btnDefaults: TButton; 95 | Label1: TLabel; 96 | Panel9: TPanel; 97 | Panel10: TPanel; 98 | Panel11: TPanel; 99 | pWhere: TPanel; 100 | pValueSet: TPanel; 101 | Splitter3: TSplitter; 102 | Label2: TLabel; 103 | cbSQLStatement: TComboBox; 104 | lSQLStatement: TLabel; 105 | Panel14: TPanel; 106 | cbOverValueSet: TCheckBox; 107 | Panel15: TPanel; 108 | cbOverWhere: TCheckBox; 109 | Bevel1: TBevel; 110 | Bevel2: TBevel; 111 | eName: TEdit; 112 | cbName: TCheckBox; 113 | Panel7: TPanel; 114 | cbSQL: TCheckBox; 115 | cbWhere: TComboBox; 116 | lWhere: TLabel; 117 | btnTest: TButton; 118 | lDefSQLStat: TLabel; 119 | lDefWhere: TLabel; 120 | cbDefSQL: TComboBox; 121 | cbDefWhere: TComboBox; 122 | procedure btnDefaultsClick(Sender: TObject); 123 | procedure tvChange(Sender: TObject; Node: TccTreeNode); 124 | procedure tvChanging(Sender: TObject; Node: TccTreeNode; 125 | var AllowChange: Boolean); 126 | procedure cbNameClick(Sender: TObject); 127 | procedure cbSQLStatementChange(Sender: TObject); 128 | procedure cbOverValueSetClick(Sender: TObject); 129 | procedure cbOverWhereClick(Sender: TObject); 130 | procedure eUpdateNameFormatChange(Sender: TObject); 131 | procedure cbSQLClick(Sender: TObject); 132 | procedure tvWhereKeyPress(Sender: TObject; var Key: Char); 133 | procedure cbWhereChange(Sender: TObject); 134 | procedure btnTestClick(Sender: TObject); 135 | procedure btnSaveClick(Sender: TObject); 136 | procedure cbDefSQLChange(Sender: TObject); 137 | procedure tvCustomDraw(Sender: TObject; TreeNode: TccTreeNode; 138 | AFont: TFont; var AColor, ABkColor: TColor); 139 | procedure FormCreate(Sender: TObject); 140 | procedure FormDestroy(Sender: TObject); 141 | private 142 | IsInSetup: boolean; 143 | FMain: TibpMain; 144 | FSets: TUpdWizardCollection; 145 | FNotNullFields: TStringList; 146 | FKeyFields: TStringList; 147 | FTablesList: TStringList; 148 | 149 | // ccCompos 150 | tvWhere: TccTreeView; 151 | tvValueSet: TccTreeView; 152 | tv: TccTreeView; 153 | 154 | procedure Init; 155 | function BuildName(const AStr: string): string; 156 | procedure FillInKeyNotNullFields(const ATableName: string; AKey, ANotNull: TStrings); 157 | function CheckName(const ANewName, AOldName: string): boolean; 158 | public 159 | constructor Create(AOwner: TComponent); override; 160 | destructor Destroy; override; 161 | end; 162 | 163 | function DoUpdWizard(AMain: TibpMain; ATV: TccTreeView): boolean; 164 | procedure ApplyChecked(ATree: TccTreeView; AList: TStrings; lSelectAll: boolean = False); 165 | function SaveChecked(ATree: TccTreeView): string; 166 | function BuldSQL(ASQLDialect, ASQLStatement: integer; ATable, AValueSetFields, AWhereFirlds: string): string; 167 | 168 | implementation 169 | 170 | {$R *.DFM} 171 | 172 | function DoUpdWizard(AMain: TibpMain; ATV: TccTreeView): boolean; 173 | var 174 | FibpUpdWizard: TibpUpdWizard; 175 | begin 176 | FibpUpdWizard := TibpUpdWizard.Create(Application); 177 | try 178 | with FibpUpdWizard do 179 | begin 180 | try AMain.DM.DBDest.Open except end; 181 | try 182 | if not AMain.DM.DBDest.Connected 183 | then Caption := Format('%s - Not Connected!', [Caption]) 184 | else Caption := Format('%s %s', [Caption, AMain.DM.DBDest.DatabaseName]); 185 | FMain := AMain; 186 | AssignTree(ATV, tv, ATV = FMain.tvDest); 187 | Init; 188 | result := ShowModal = mrOk; 189 | finally 190 | AMain.DM.DBDest.Close; 191 | end; 192 | end; 193 | finally 194 | FibpUpdWizard.Free; 195 | end; 196 | end; 197 | 198 | procedure ApplyChecked(ATree: TccTreeView; AList: TStrings; lSelectAll: boolean = False); 199 | var 200 | ANode: TccTreeNode; 201 | begin 202 | ANode := ATree.Items.GetFirstNode; 203 | while ANode <> nil do 204 | begin 205 | ANode.Checked := lSelectAll or (AList.IndexOf(ANode.TheText) <> -1); 206 | ANode := ANode.GetNext; 207 | end; 208 | end; 209 | 210 | function SaveChecked(ATree: TccTreeView): string; 211 | var 212 | AList: TStringList; 213 | ANode: TccTreeNode; 214 | begin 215 | AList := TStringList.Create; 216 | try 217 | ANode := ATree.Items.GetFirstNode; 218 | while ANode <> nil do 219 | begin 220 | if ANode.Checked 221 | then AList.Add(ANode.TheText); 222 | ANode := ANode.GetNext; 223 | end; 224 | result := AList.Text; 225 | finally 226 | AList.Free; 227 | end; 228 | end; 229 | 230 | function BuldSQL(ASQLDialect, ASQLStatement: integer; ATable, AValueSetFields, AWhereFirlds: string): string; 231 | var 232 | str, strFields, strPars, strWheres: string; 233 | lstValueSetFields, lstWhereFields: TStringList; 234 | 235 | function RunList(AStringList: TStringList; AFormatStr, AFormatStrLast : string): string; 236 | var 237 | tmpInd: integer; 238 | tmpStr: string; 239 | begin 240 | SetLength(result, 0); 241 | for tmpInd := 0 to AStringList.Count-2 do 242 | begin 243 | tmpStr := GetSQLName(AStringList[tmpInd], pdtIB, ASQLDialect); 244 | result := result + Format(AFormatStr, [tmpStr, tmpStr]); 245 | end; 246 | 247 | if AStringList.Count > 0 then 248 | begin 249 | tmpStr := GetSQLName(AStringList[AStringList.Count-1], pdtIB, ASQLDialect); 250 | result := result + Format(AFormatStrLast, [tmpStr, tmpStr]); 251 | end; 252 | end; 253 | 254 | begin 255 | SetLength(result, 0); 256 | SetLength(strFields, 0); 257 | SetLength(strPars, 0); 258 | SetLength(strWheres, 0); 259 | 260 | lstValueSetFields := TStringList.Create; 261 | lstWhereFields := TStringList.Create; 262 | try 263 | lstValueSetFields.Text := AValueSetFields; 264 | lstWhereFields.Text := AWhereFirlds; 265 | case ASQLStatement of 266 | //update 267 | 0: 268 | begin 269 | strFields := RunList(lstValueSetFields, ' %s=:%s,', ' %s=:%s'); 270 | strWheres := RunList(lstWhereFields, ' %s=:%s and', ' %s=:%s'); 271 | 272 | str := GetSQLName(ATable, pdtIB, ASQLDialect); 273 | result := Format('UPDATE %s '+#13#10+'SET %s '+#13#10+'WHERE %s', [str, strFields, strWheres]); 274 | end; 275 | // insert 276 | 1: 277 | begin 278 | strFields := RunList(lstValueSetFields, ' %s,', ' %s'); 279 | strWheres := RunList(lstWhereFields, ' :%s,', ' :%s'); 280 | 281 | str := GetSQLName(ATable, pdtIB, ASQLDialect); 282 | result := Format('INSERT INTO %s '+#13#10+'(%s) '+#13#10+'VALUES(%s)', [str, strFields, strWheres]); 283 | end; 284 | // delete 285 | 2: 286 | begin 287 | strWheres := RunList(lstWhereFields, ' %s=:%s and', ' %s=:%s'); 288 | 289 | str := GetSQLName(ATable, pdtIB, ASQLDialect); 290 | result := Format('DELETE FROM %s '+#13#10+'WHERE %s', [str, strWheres]); 291 | end; 292 | end; 293 | finally 294 | lstValueSetFields.Free; 295 | lstWhereFields.Free; 296 | end; 297 | end; 298 | 299 | { TUpdWizardCollectionItem } 300 | 301 | constructor TUpdWizardCollectionItem.Create(Collection: TCollection); 302 | begin 303 | inherited Create(Collection); 304 | SetLength(FTableName, 0); 305 | FOverName := False; 306 | SetLength(FName, 0); 307 | FSQLStatement := 0; 308 | FOverValueSet := False; 309 | FOverWhere := False; 310 | FValueSetFields := TStringList.Create; 311 | FWhereFields := TStringList.Create; 312 | FKeyFields := TStringList.Create; 313 | FNotNullFields := TStringList.Create; 314 | FOverSQL := False; 315 | FSQL := TStringList.Create; 316 | end; 317 | 318 | destructor TUpdWizardCollectionItem.Destroy; 319 | begin 320 | SetLength(FTableName, 0); 321 | FOverName := False; 322 | SetLength(FName, 0); 323 | FSQLStatement := 0; 324 | FOverValueSet := False; 325 | FOverWhere := False; 326 | FValueSetFields := TStringList.Create; 327 | FWhereFields := TStringList.Create; 328 | FSQL := TStringList.Create; 329 | inherited; 330 | end; 331 | 332 | { TUpdWizardCollection } 333 | 334 | function TUpdWizardCollection.GetItem(Index: Integer): TUpdWizardCollectionItem; 335 | begin 336 | result := TUpdWizardCollectionItem(inherited Items[Index]); 337 | end; 338 | 339 | procedure TUpdWizardCollection.SetItem(Index: Integer; Value: TUpdWizardCollectionItem); 340 | begin 341 | Items[Index].Assign(Value); 342 | end; 343 | 344 | function TUpdWizardCollection.Add: TUpdWizardCollectionItem; 345 | begin 346 | result := TUpdWizardCollectionItem(inherited Add); 347 | end; 348 | 349 | function TUpdWizardCollection.FindByName(const AName: string): TUpdWizardCollectionItem; 350 | var 351 | i: integer; 352 | begin 353 | result := nil; 354 | for i := 0 to Count-1 do 355 | if Items[i].TableName = AName then 356 | begin 357 | result := Items[i]; 358 | break; 359 | end; 360 | end; 361 | 362 | { TibpUpdWizard } 363 | 364 | constructor TibpUpdWizard.Create(AOwner: TComponent); 365 | begin 366 | inherited Create(AOwner); 367 | 368 | // create ccCompos (avoid package) 369 | tvWhere:= TccTreeView.Create(Self); 370 | with tvWhere do 371 | begin 372 | Parent:= pWhere; 373 | Align:= alClient; 374 | ShowLines:= False; 375 | ReadOnly:= True; 376 | HideSelection:= False; 377 | Indent:= 19; 378 | TabOrder:= 1; 379 | OnClick:= cbSQLStatementChange; 380 | OnKeyPress:= tvWhereKeyPress; 381 | ShowCheckBoxes:= True; 382 | end; 383 | tvValueSet:= TccTreeView.Create(Self); 384 | with tvValueSet do 385 | begin 386 | Parent:= pValueSet; 387 | Align:= alClient; 388 | ShowLines:= False; 389 | ReadOnly:= True; 390 | HideSelection:= False; 391 | Indent:= 19; 392 | TabOrder:= 1; 393 | OnClick:= cbSQLStatementChange; 394 | OnKeyPress:= tvWhereKeyPress; 395 | ShowCheckBoxes:= True; 396 | end; 397 | tv:= TccTreeView.Create(Self); 398 | with tv do 399 | begin 400 | Parent:= Panel4; 401 | Align:= alClient; 402 | ShowLines:= False; 403 | ShowCheckBoxes:= True; 404 | ReadOnly:= True; 405 | HideSelection:= False; 406 | Indent:= 19; 407 | TabOrder:= 0; 408 | OnChanging:= tvChanging; 409 | OnChange:= tvChange; 410 | OnCustomDraw:= tvCustomDraw; 411 | end; 412 | 413 | FSets := TUpdWizardCollection.Create(TUpdWizardCollectionItem); 414 | FNotNullFields := TStringList.Create; 415 | FKeyFields := TStringList.Create; 416 | FTablesList := TStringList.Create; 417 | FTablesList.Sorted := True; 418 | FTablesList.Duplicates := dupIgnore; 419 | end; 420 | 421 | destructor TibpUpdWizard.Destroy; 422 | begin 423 | FNotNullFields.Free; 424 | FKeyFields.Free; 425 | FSets.Free; 426 | FTablesList.Free; 427 | inherited Destroy; 428 | end; 429 | 430 | procedure TibpUpdWizard.Init; 431 | var 432 | nd: TccTreeNode; 433 | begin 434 | IsInSetup := False; 435 | tv.Selected := nil; 436 | btnDefaults.Click; 437 | 438 | tvChange(tv, nil); 439 | 440 | tvValueSet.Images := tv.Images; 441 | tvWhere.Images := tv.Images; 442 | 443 | FTablesList.Clear; 444 | nd := tv.Items.GetFirstNode; 445 | while nd <> nil do 446 | begin 447 | FTablesList.Add(nd.TheText); 448 | nd := nd.GetNextSibling; 449 | end; 450 | 451 | cbDefWhere.ItemIndex := 1; 452 | cbDefSQL.ItemIndex := 1; 453 | 454 | cbDefSQLChange(nil); 455 | end; 456 | 457 | procedure TibpUpdWizard.btnDefaultsClick(Sender: TObject); 458 | begin 459 | eUpdateNameFormat.Text := eUpdateNameFormat.Hint; 460 | eInsertNameFormat.Text := eInsertNameFormat.Hint; 461 | eDeleteNameFormat.Text := eDeleteNameFormat.Hint; 462 | end; 463 | 464 | procedure TibpUpdWizard.tvChange(Sender: TObject; Node: TccTreeNode); 465 | var 466 | uItem: TUpdWizardCollectionItem; 467 | nd, tmp: TccTreeNode; 468 | begin 469 | IsInSetup := True; 470 | try 471 | if (Node <> nil) and 472 | (Node.ImageIndex > Integer(picTableLoop)) 473 | then Node := Node.Parent; 474 | 475 | if Node <> nil 476 | then uItem := FSets.FindByName(Node.TheText) 477 | else uItem := nil; 478 | 479 | tvValueSet.Items.BeginUpdate; 480 | tvWhere.Items.BeginUpdate; 481 | memSQL.Lines.BeginUpdate; 482 | try 483 | tvValueSet.Items.Clear; 484 | tvWhere.Items.Clear; 485 | memSQL.Lines.Clear; 486 | if Node <> nil then 487 | begin 488 | nd := Node.GetFirstChild; 489 | while nd <> nil do 490 | begin 491 | tmp := tvValueSet.Items.Add(nil, nd.TheText); 492 | tmp.Assign(nd); 493 | tmp.Checked := True; 494 | nd := Node.GetNextChild(nd); 495 | end; 496 | tvWhere.Items.Assign(tvValueSet.Items) 497 | end; 498 | 499 | if (uItem = nil) or (Node = nil) or (not Node.Checked) then 500 | begin 501 | cbName.Checked := False; 502 | cbOverValueSet.Checked := False; 503 | cbSQLStatement.ItemIndex := cbDefSQL.ItemIndex; 504 | cbWhere.ItemIndex := cbDefWhere.ItemIndex; 505 | cbOverWhere.Checked := cbWhere.ItemIndex = Pred(cbWhere.Items.Count); 506 | cbSQL.Checked := False; 507 | if Node <> nil 508 | then FillInKeyNotNullFields(Node.TheText, FKeyFields, FNotNullFields); 509 | end 510 | else 511 | begin 512 | cbOverValueSet.Checked := uItem.OverValueSet; 513 | cbOverWhere.Checked := uItem.OverWhere; 514 | cbSQLStatement.ItemIndex := uItem.SQLStatement; 515 | cbWhere.ItemIndex := uItem.WhereOption; 516 | FKeyFields.Assign(uItem.KeyFields); 517 | FNotNullFields.Assign(uItem.NotNullFields); 518 | 519 | cbName.Checked := uItem.OverName; 520 | if cbName.Checked 521 | then eName.Text := uItem.Name 522 | else eName.Text := BuildName(Node.TheText); 523 | 524 | if cbOverValueSet.Checked 525 | then ApplyChecked(tvValueSet, uItem.ValueSetFields); 526 | 527 | if cbOverWhere.Checked 528 | then ApplyChecked(tvWhere, uItem.WhereFields); 529 | 530 | cbSQL.Checked := uItem.OverSQL; 531 | if cbSQL.Checked 532 | then memSQL.Lines.Text := uItem.SQL.Text 533 | else memSQL.Lines.Text := BuldSQL(FMain.DestDialect, cbSQLStatement.ItemIndex, uItem.TableName, SaveChecked(tvValueSet), SaveChecked(tvWhere)); 534 | end; 535 | finally 536 | tvValueSet.Items.EndUpdate; 537 | tvWhere.Items.EndUpdate; 538 | memSQL.Lines.EndUpdate; 539 | end; 540 | finally 541 | IsInSetup := False; 542 | end; 543 | cbNameClick(cbName); 544 | cbOverValueSetClick(cbOverValueSet); 545 | cbOverWhereClick(cbOverWhere); 546 | cbSQLClick(cbSQL); 547 | end; 548 | 549 | procedure TibpUpdWizard.tvChanging(Sender: TObject; Node: TccTreeNode; 550 | var AllowChange: Boolean); 551 | var 552 | uItem: TUpdWizardCollectionItem; 553 | ANode: TccTreeNode; 554 | begin 555 | IsInSetup := True; 556 | try 557 | ANode := tv.Selected; 558 | if ANode <> nil then 559 | begin 560 | if ANode.ImageIndex > Integer(picTableLoop) 561 | then ANode := ANode.Parent; 562 | 563 | uItem := FSets.FindByName(ANode.TheText); 564 | 565 | if uItem = nil 566 | then uItem := FSets.Add; 567 | 568 | if ANode.Checked and (not CheckName(eName.Text, uItem.Name)) then 569 | begin 570 | if eName.CanFocus 571 | then eName.SetFocus; 572 | if Length(Trim(eName.Text)) = 0 573 | then ShowMessage('Name can not be empty!') 574 | else ShowMessage(Format('Name %s is duplicated - please correct.', [eName.Text])); 575 | AllowChange := False; 576 | exit; 577 | end; 578 | 579 | uItem.KeyFields.Assign(FKeyFields); 580 | uItem.NotNullFields.Assign(FNotNullFields); 581 | uItem.TableName := ANode.TheText; 582 | uItem.SQLStatement := cbSQLStatement.ItemIndex; 583 | uItem.WhereOption := cbWhere.ItemIndex; 584 | uItem.OverValueSet := cbOverValueSet.Checked; 585 | uItem.OverWhere := cbOverWhere.Checked; 586 | uItem.OverName := cbName.Checked and (Length(Trim(eName.Text)) > 0); 587 | uItem.Name := eName.Text; 588 | 589 | uItem.OverSQL := cbSQL.Checked; 590 | uItem.SQL.Text := memSQL.Lines.Text; 591 | 592 | uItem.ValueSetFields.Clear; 593 | uItem.WhereFields.Clear; 594 | 595 | if cbOverValueSet.Checked 596 | then uItem.ValueSetFields.Text := SaveChecked(tvValueSet); 597 | 598 | if cbOverWhere.Checked 599 | then uItem.WhereFields.Text := SaveChecked(tvWhere); 600 | end; 601 | finally 602 | IsInSetup := False; 603 | end; 604 | end; 605 | 606 | function TibpUpdWizard.BuildName(const AStr: string): string; 607 | var 608 | aEdit: TEdit; 609 | begin 610 | case cbSQLStatement.ItemIndex of 611 | 0: aEdit := eUpdateNameFormat; 612 | 1: aEdit := eInsertNameFormat; 613 | 2: aEdit := eDeleteNameFormat; 614 | else 615 | aEdit := eUpdateNameFormat; 616 | end; 617 | result := Format(aEdit.Text, [AStr]); 618 | if Length(Trim(result)) = 0 619 | then result := Format(aEdit.Hint, [AStr]); 620 | end; 621 | 622 | procedure TibpUpdWizard.FillInKeyNotNullFields(const ATableName: string; AKey, ANotNull: TStrings); 623 | var 624 | i: integer; 625 | ibTable: TIBTable; 626 | begin 627 | AKey.Clear; 628 | ANotNull.Clear; 629 | ibTable := TIBTable.Create(nil); 630 | try 631 | ibTable.Database := FMain.DM.DBDest; 632 | ibTable.Transaction := ibTable.Database.DefaultTransaction; 633 | try 634 | ibTable.TableName := ATableName; 635 | 636 | ibTable.FieldDefs.Update; 637 | for i := 0 to ibTable.FieldDefs.Count-1 do 638 | if faRequired in ibTable.FieldDefs[i].Attributes 639 | then ANotNull.Add(ibTable.FieldDefs[i].Name); 640 | 641 | ibTable.IndexDefs.Update; 642 | for i := 0 to ibTable.IndexDefs.Count-1 do 643 | begin 644 | if ixPrimary in ibTable.IndexDefs[i].Options then 645 | begin 646 | AKey.Text := StringReplace(ibTable.IndexDefs[i].Fields, ';', #13#10, [rfReplaceAll]); 647 | break; 648 | end 649 | end; 650 | except 651 | end; 652 | finally 653 | ibTable.Free; 654 | end; 655 | end; 656 | 657 | function TibpUpdWizard.CheckName(const ANewName, AOldName: string): boolean; 658 | var 659 | i, j: integer; 660 | begin 661 | result := False; 662 | 663 | if Length(Trim(ANewName)) = 0 664 | then exit; 665 | 666 | if ANewName <> AOldName then 667 | begin 668 | i := FTablesList.IndexOf(AOldName); 669 | if (i <> -1) and (FTablesList.Objects[i] = nil) 670 | then exit; 671 | 672 | j := FTablesList.IndexOf(ANewName); 673 | if j <> -1 674 | then exit; 675 | 676 | FTablesList.Sorted := False; 677 | try 678 | if i <> -1 679 | then FTablesList[i] := ANewName 680 | else FTablesList.AddObject(ANewName, Pointer(1)); 681 | finally 682 | FTablesList.Sorted := True; 683 | end; 684 | end; 685 | result := True; 686 | end; 687 | 688 | procedure TibpUpdWizard.cbNameClick(Sender: TObject); 689 | begin 690 | eName.Enabled := TCheckBox(Sender).Checked; 691 | end; 692 | 693 | procedure TibpUpdWizard.cbOverValueSetClick(Sender: TObject); 694 | begin 695 | tvValueSet.Enabled := TCheckBox(Sender).Checked; 696 | cbSQLStatementChange(nil); 697 | end; 698 | 699 | procedure TibpUpdWizard.cbOverWhereClick(Sender: TObject); 700 | begin 701 | tvWhere.Enabled := cbOverWhere.Checked; 702 | 703 | if (not IsInSetup) then 704 | begin 705 | if cbOverWhere.Checked and 706 | (cbWhere.ItemIndex <> Pred(cbWhere.Items.Count)) 707 | then cbWhere.ItemIndex := Pred(cbWhere.Items.Count); 708 | 709 | if (not cbOverWhere.Checked) and 710 | (cbWhere.ItemIndex = Pred(cbWhere.Items.Count)) 711 | then cbWhere.ItemIndex := 0; 712 | end; 713 | 714 | cbSQLStatementChange(nil); 715 | end; 716 | 717 | procedure TibpUpdWizard.cbSQLClick(Sender: TObject); 718 | begin 719 | memSQL.ReadOnly := not TCheckBox(Sender).Checked; 720 | if memSQL.ReadOnly 721 | then memSQL.Color := clBtnFace 722 | else memSQL.Color := clWindow; 723 | 724 | if (not IsInSetup) 725 | then cbSQLStatementChange(nil); 726 | end; 727 | 728 | procedure TibpUpdWizard.eUpdateNameFormatChange(Sender: TObject); 729 | var 730 | tmp: TccTreeNode; 731 | begin 732 | if (not IsInSetup) then 733 | begin 734 | tmp := tv.Selected; 735 | if (tmp <> nil) and (tmp.ImageIndex > Integer(picTableLoop)) 736 | then tmp := tmp.Parent; 737 | 738 | if (tmp <> nil) and (not cbName.Checked) 739 | then eName.Text := BuildName(tmp.TheText); 740 | end; 741 | end; 742 | 743 | procedure TibpUpdWizard.cbSQLStatementChange(Sender: TObject); 744 | var 745 | tmp: TccTreeNode; 746 | begin 747 | if (not IsInSetup) then 748 | begin 749 | tmp := tv.Selected; 750 | if (tmp <> nil) and (tmp.ImageIndex > Integer(picTableLoop)) 751 | then tmp := tmp.Parent; 752 | 753 | if (tmp <> nil) and (not cbName.Checked) 754 | then eName.Text := BuildName(tmp.TheText); 755 | 756 | case cbSQLStatement.ItemIndex of 757 | 0: // update 758 | begin 759 | cbOverValueSet.Caption := 'Overwrite SET Clause Fields'; 760 | cbOverWhere.Caption := 'Overwrite WHERE Clause Fields'; 761 | pValueSet.Visible := True; 762 | pWhere.Visible := True; 763 | if not cbOverValueSet.Checked 764 | then ApplyChecked(tvValueSet, nil, True); 765 | end; 766 | 1: // insert 767 | begin 768 | cbOverValueSet.Caption := 'Overwrite FIELDS Clause Fields'; 769 | cbOverWhere.Caption := 'Overwrite VALUES Clause Fields'; 770 | pValueSet.Visible := True; 771 | pWhere.Visible := True; 772 | cbWhere.ItemIndex := 1; 773 | if not cbOverWhere.Checked 774 | then ApplyChecked(tvWhere, nil, True); 775 | if not cbOverValueSet.Checked 776 | then ApplyChecked(tvValueSet, nil, True); 777 | end; 778 | 2: // delete 779 | begin 780 | cbOverWhere.Caption := 'Overwrite WHERE Clause Fields'; 781 | pValueSet.Visible := False; 782 | pWhere.Visible := True; 783 | end; 784 | end; 785 | Splitter3.Visible := pValueSet.Visible; 786 | 787 | cbWhere.Enabled := (cbSQLStatement.ItemIndex in [0,2]); 788 | if cbWhere.Enabled then 789 | begin 790 | case cbWhere.ItemIndex of 791 | 0: // Key Fields 792 | begin 793 | ApplyChecked(tvWhere, FKeyFields); 794 | end; 795 | 1: // All Fields 796 | begin 797 | ApplyChecked(tvWhere, nil, True); 798 | end; 799 | 2: // Not Null Fields 800 | begin 801 | ApplyChecked(tvWhere, FNotNullFields); 802 | end; 803 | 3: // Custom Fields 804 | begin 805 | end; 806 | end; 807 | end; 808 | 809 | if (tmp <> nil) and (not cbSQL.Checked) 810 | then memSQL.Lines.Text := BuldSQL(FMain.DestDialect, cbSQLStatement.ItemIndex, tmp.TheText, SaveChecked(tvValueSet), SaveChecked(tvWhere)); 811 | end; 812 | end; 813 | 814 | procedure TibpUpdWizard.tvWhereKeyPress(Sender: TObject; var Key: Char); 815 | begin 816 | cbSQLStatementChange(nil); 817 | end; 818 | 819 | procedure TibpUpdWizard.cbWhereChange(Sender: TObject); 820 | begin 821 | if (not IsInSetup) and cbWhere.Enabled then 822 | begin 823 | cbOverWhere.Checked := cbWhere.ItemIndex = Pred(cbWhere.Items.Count); 824 | cbSQLStatementChange(nil); 825 | end; 826 | end; 827 | 828 | procedure TibpUpdWizard.btnTestClick(Sender: TObject); 829 | var 830 | ibQuery: TIBQuery; 831 | begin 832 | ibQuery := TIBQuery.Create(nil); 833 | try 834 | ibQuery.Database := FMain.DM.DBDest; 835 | ibQuery.Transaction := ibQuery.Database.DefaultTransaction; 836 | ibQuery.SQL.Assign(memSQL.Lines); 837 | ibQuery.Prepare; 838 | try 839 | ibQuery.GenerateParamNames := True; 840 | ShowMessage(Format('Passed!' + #13 + 'Found %d Params.', [ibQuery.Params.Count])); 841 | except 842 | on E: Exception do 843 | begin 844 | ShowMessage(Format('Failed!' + #13 + '%s', [E.Message])); 845 | end; 846 | end; 847 | finally 848 | ibQuery.Free; 849 | end; 850 | end; 851 | 852 | procedure TibpUpdWizard.btnSaveClick(Sender: TObject); 853 | var 854 | nd: TccTreeNode; 855 | uItem: TUpdWizardCollectionItem; 856 | 857 | procedure SelNode(ANode: TccTreeNode); 858 | begin 859 | if ANode <> nil then 860 | begin 861 | tv.Selected := ANode; 862 | ANode.MakeVisible; 863 | end; 864 | end; 865 | 866 | begin 867 | nd := tv.Items.GetFirstNode; 868 | while nd <> nil do 869 | begin 870 | if nd.Checked then 871 | begin 872 | SelNode(nd); 873 | tv.Selected := nil; 874 | if tv.Selected <> nil 875 | then exit; 876 | end; 877 | nd := nd.GetNextSibling; 878 | end; 879 | 880 | nd := tv.Items.GetFirstNode; 881 | while nd <> nil do 882 | begin 883 | if nd.Checked then 884 | begin 885 | uItem := FSets.FindByName(nd.TheText); 886 | FMain.AddCustomSQLParams(uItem.Name + #0 + uItem.SQL.Text, nil); 887 | end; 888 | nd := nd.GetNextSibling; 889 | end; 890 | 891 | ModalResult := mrOk; 892 | end; 893 | 894 | procedure TibpUpdWizard.cbDefSQLChange(Sender: TObject); 895 | begin 896 | cbDefWhere.Enabled := (cbDefSQL.ItemIndex in [0,2]); 897 | 898 | if not cbDefWhere.Enabled 899 | then cbWhere.ItemIndex := 1; 900 | end; 901 | 902 | procedure TibpUpdWizard.tvCustomDraw(Sender: TObject; 903 | TreeNode: TccTreeNode; AFont: TFont; var AColor, ABkColor: TColor); 904 | begin 905 | if Pos(#0, TreeNode.Text) > 0 then 906 | begin 907 | AFont.Style := AFont.Style + [fsBold]; 908 | end; 909 | end; 910 | 911 | procedure TibpUpdWizard.FormCreate(Sender: TObject); 912 | begin 913 | GetWindStat(Self); 914 | end; 915 | 916 | procedure TibpUpdWizard.FormDestroy(Sender: TObject); 917 | begin 918 | SetWindStat(Self); 919 | end; 920 | 921 | end. 922 | -------------------------------------------------------------------------------- /Sources/IBDataPump/ibpDM.dfm: -------------------------------------------------------------------------------- 1 | object ibpDM: TibpDM 2 | OldCreateOrder = False 3 | OnCreate = DataModuleCreate 4 | OnDestroy = DataModuleDestroy 5 | Left = 285 6 | Top = 161 7 | Height = 479 8 | Width = 741 9 | object DBSource: TIBDatabase 10 | Params.Strings = ( 11 | 'user_name=sysdba' 12 | 'password=masterkey') 13 | LoginPrompt = False 14 | DefaultTransaction = trSource 15 | IdleTimer = 0 16 | SQLDialect = 1 17 | TraceFlags = [] 18 | AllowStreamedConnected = False 19 | Left = 44 20 | Top = 8 21 | end 22 | object DBDest: TIBDatabase 23 | Params.Strings = ( 24 | 'user_name=sysdba' 25 | 'password=masterkey') 26 | LoginPrompt = False 27 | DefaultTransaction = trDest 28 | IdleTimer = 0 29 | SQLDialect = 1 30 | TraceFlags = [] 31 | AllowStreamedConnected = False 32 | Left = 44 33 | Top = 64 34 | end 35 | object trSource: TIBTransaction 36 | Active = False 37 | DefaultDatabase = DBSource 38 | AutoStopAction = saNone 39 | Left = 116 40 | Top = 8 41 | end 42 | object trDest: TIBTransaction 43 | Active = False 44 | DefaultDatabase = DBDest 45 | AutoStopAction = saNone 46 | Left = 120 47 | Top = 64 48 | end 49 | object bdeDb: TDatabase 50 | DatabaseName = 'bdeDb' 51 | ReadOnly = True 52 | SessionName = 'Default' 53 | OnLogin = bdeDbLogin 54 | Left = 40 55 | Top = 124 56 | end 57 | object ibeDest: TIBExtract 58 | Database = DBDest 59 | Transaction = trDest 60 | ShowSystem = False 61 | Left = 192 62 | Top = 64 63 | end 64 | object ibeSource: TIBExtract 65 | Database = DBSource 66 | Transaction = trSource 67 | ShowSystem = False 68 | Left = 192 69 | Top = 8 70 | end 71 | object adoDb: TADOConnection 72 | CursorLocation = clUseServer 73 | LoginPrompt = False 74 | Mode = cmRead 75 | OnWillConnect = adoDbWillConnect 76 | Left = 40 77 | Top = 184 78 | end 79 | end 80 | -------------------------------------------------------------------------------- /Sources/IBDataPump/ibpDM.pas: -------------------------------------------------------------------------------- 1 | { 2 | Copyright (c) 2000-2005 CleverComponents.com 3 | Product: Interbase DataPump 4 | Author: Alexandre Poloziouk 5 | Unit: ibpDM.pas 6 | } 7 | 8 | unit ibpDM; 9 | 10 | {$INCLUDE ccGetVer.inc} 11 | 12 | interface 13 | 14 | uses 15 | Windows, Messages, SysUtils, Classes, Controls, Forms, 16 | IBDatabase, IBQuery, IBSQL, Db, DBTables, IBDatabaseInfo, IBExtract, ADODB; 17 | 18 | type 19 | 20 | { TibpDM } 21 | 22 | TOnGetUserInfo = procedure (Sender: TObject; var AUserName, APassword: string) of object; 23 | 24 | TibpDM = class(TDataModule) 25 | DBSource: TIBDatabase; 26 | DBDest: TIBDatabase; 27 | trSource: TIBTransaction; 28 | trDest: TIBTransaction; 29 | bdeDb: TDatabase; 30 | ibeDest: TIBExtract; 31 | ibeSource: TIBExtract; 32 | adoDb: TADOConnection; 33 | procedure bdeDbLogin(Database: TDatabase; LoginParams: TStrings); 34 | procedure adoDbWillConnect(Connection: TADOConnection; 35 | var ConnectionString, UserID, Password: WideString; 36 | var ConnectOptions: TConnectOption; var EventStatus: TEventStatus); 37 | procedure OnGetParadoxPassBDE(Sender: TObject; var Continue: Boolean); 38 | procedure DataModuleCreate(Sender: TObject); 39 | procedure DataModuleDestroy(Sender: TObject); 40 | private 41 | FOnGetUserInfo: TOnGetUserInfo; 42 | FOldPasswordEvent: TPasswordEvent; 43 | public 44 | property OnGetUserInfo: TOnGetUserInfo read FOnGetUserInfo write FOnGetUserInfo; 45 | 46 | function GetIBQuery(ADatabase: TIBDatabase; ASQL: string): TIBQuery; 47 | end; 48 | 49 | implementation 50 | 51 | {$R *.DFM} 52 | 53 | { TibpDM } 54 | 55 | procedure TibpDM.bdeDbLogin(Database: TDatabase; LoginParams: TStrings); 56 | var 57 | AUserName, APassword: string; 58 | begin 59 | SetLength(AUserName, 0); 60 | SetLength(APassword, 0); 61 | 62 | if Assigned(FOnGetUserInfo) 63 | then FOnGetUserInfo(Self, AUserName, APassword); 64 | 65 | LoginParams.Values['USERNAME'] := AUserName; 66 | LoginParams.Values['USER NAME'] := AUserName; 67 | LoginParams.Values['PASSWORD'] := APassword; 68 | end; 69 | 70 | procedure TibpDM.adoDbWillConnect(Connection: TADOConnection; 71 | var ConnectionString, UserID, Password: WideString; 72 | var ConnectOptions: TConnectOption; var EventStatus: TEventStatus); 73 | var 74 | AUserName, APassword: string; 75 | begin 76 | SetLength(AUserName, 0); 77 | SetLength(APassword, 0); 78 | 79 | if Assigned(FOnGetUserInfo) 80 | then FOnGetUserInfo(Self, AUserName, APassword); 81 | 82 | UserID := AUserName; 83 | Password := APassword; 84 | end; 85 | 86 | procedure TibpDM.OnGetParadoxPassBDE(Sender: TObject; var Continue: Boolean); 87 | var 88 | AUserName, APassword: string; 89 | begin 90 | SetLength(AUserName, 0); 91 | SetLength(APassword, 0); 92 | 93 | if Assigned(FOnGetUserInfo) 94 | then FOnGetUserInfo(Self, AUserName, APassword); 95 | 96 | Session.RemoveAllPasswords; 97 | if Length(APassword) > 0 98 | then Session.AddPassword(APassword); 99 | 100 | Continue := True; 101 | end; 102 | 103 | procedure TibpDM.DataModuleCreate(Sender: TObject); 104 | begin 105 | FOldPasswordEvent := Session.OnPassword; 106 | Session.OnPassword := OnGetParadoxPassBDE; 107 | end; 108 | 109 | procedure TibpDM.DataModuleDestroy(Sender: TObject); 110 | begin 111 | Session.OnPassword := FOldPasswordEvent; 112 | end; 113 | 114 | function TibpDM.GetIBQuery(ADatabase: TIBDatabase; ASQL: string): TIBQuery; 115 | begin 116 | Result := TIBQuery.Create(Self); 117 | Result.Database := ADatabase; 118 | Result.Transaction := ADatabase.DefaultTransaction; 119 | Result.SQL.Text := ASQL 120 | end; 121 | 122 | end. 123 | -------------------------------------------------------------------------------- /Sources/IBDataPump/ibpGenSql.dfm: -------------------------------------------------------------------------------- 1 | object ibpGenSql: TibpGenSql 2 | Left = 393 3 | Top = 174 4 | BorderStyle = bsDialog 5 | Caption = 'Generate SQL Script' 6 | ClientHeight = 453 7 | ClientWidth = 632 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 = poScreenCenter 16 | Scaled = False 17 | OnCreate = FormCreate 18 | OnDestroy = FormDestroy 19 | DesignSize = ( 20 | 632 21 | 453) 22 | PixelsPerInch = 96 23 | TextHeight = 13 24 | object Label1: TLabel 25 | Left = 8 26 | Top = 123 27 | Width = 116 28 | Height = 13 29 | Caption = 'Duplicated Index Names' 30 | WordWrap = True 31 | end 32 | object lTGraphicField: TLabel 33 | Left = 242 34 | Top = 403 35 | Width = 59 36 | Height = 13 37 | Caption = 'GraphicField' 38 | end 39 | object lTTimeField: TLabel 40 | Left = 242 41 | Top = 378 42 | Width = 45 43 | Height = 13 44 | Caption = 'TimeField' 45 | end 46 | object lSaveTo: TLabel 47 | Left = 8 48 | Top = 17 49 | Width = 81 50 | Height = 13 51 | Caption = 'Save script to file' 52 | end 53 | object lDialect: TLabel 54 | Left = 8 55 | Top = 70 56 | Width = 33 57 | Height = 13 58 | Caption = 'Dialect' 59 | end 60 | object lCase: TLabel 61 | Left = 8 62 | Top = 150 63 | Width = 120 64 | Height = 13 65 | Caption = 'Case of field/table names' 66 | end 67 | object lSpaces: TLabel 68 | Left = 8 69 | Top = 176 70 | Width = 121 71 | Height = 13 72 | Caption = 'Convert field/table names' 73 | WordWrap = True 74 | end 75 | object lOptions: TLabel 76 | Left = 4 77 | Top = 197 78 | Width = 291 79 | Height = 13 80 | Caption = 'Convert Field Options (from given field class to SQL data type)' 81 | Font.Charset = DEFAULT_CHARSET 82 | Font.Color = clWindowText 83 | Font.Height = -11 84 | Font.Name = 'MS Sans Serif' 85 | Font.Style = [fsUnderline] 86 | ParentFont = False 87 | end 88 | object bvlOptions: TBevel 89 | Left = 297 90 | Top = 204 91 | Width = 328 92 | Height = 9 93 | Anchors = [akLeft, akTop, akRight] 94 | Shape = bsTopLine 95 | end 96 | object lTStringField: TLabel 97 | Left = 8 98 | Top = 219 99 | Width = 49 100 | Height = 13 101 | Caption = 'StringField' 102 | end 103 | object lTIntegerField: TLabel 104 | Left = 8 105 | Top = 272 106 | Width = 55 107 | Height = 13 108 | Caption = 'IntegerField' 109 | end 110 | object lTFloatField: TLabel 111 | Left = 8 112 | Top = 299 113 | Width = 45 114 | Height = 13 115 | Caption = 'FloatField' 116 | end 117 | object lTBCDField: TLabel 118 | Left = 8 119 | Top = 325 120 | Width = 44 121 | Height = 13 122 | Caption = 'BCDField' 123 | end 124 | object lTLargeintField: TLabel 125 | Left = 8 126 | Top = 351 127 | Width = 60 128 | Height = 13 129 | Caption = 'LargeintField' 130 | end 131 | object lTSmallintField: TLabel 132 | Left = 8 133 | Top = 378 134 | Width = 58 135 | Height = 13 136 | Caption = 'SmallintField' 137 | end 138 | object lTAutoIncField: TLabel 139 | Left = 242 140 | Top = 298 141 | Width = 59 142 | Height = 13 143 | Caption = 'AutoIncField' 144 | end 145 | object lTCurrencyField: TLabel 146 | Left = 242 147 | Top = 272 148 | Width = 64 149 | Height = 13 150 | Caption = 'CurrencyField' 151 | end 152 | object lTBooleanField: TLabel 153 | Left = 242 154 | Top = 221 155 | Width = 61 156 | Height = 13 157 | Caption = 'BooleanField' 158 | end 159 | object lTDateTimeField: TLabel 160 | Left = 242 161 | Top = 325 162 | Width = 68 163 | Height = 13 164 | Caption = 'DateTimeField' 165 | end 166 | object lTDateField: TLabel 167 | Left = 242 168 | Top = 352 169 | Width = 45 170 | Height = 13 171 | Caption = 'DateField' 172 | end 173 | object lLength: TLabel 174 | Left = 23 175 | Top = 235 176 | Width = 46 177 | Height = 13 178 | Caption = 'if length <' 179 | Font.Charset = DEFAULT_CHARSET 180 | Font.Color = clNavy 181 | Font.Height = -11 182 | Font.Name = 'MS Sans Serif' 183 | Font.Style = [] 184 | ParentFont = False 185 | end 186 | object lThen: TLabel 187 | Left = 119 188 | Top = 221 189 | Width = 21 190 | Height = 13 191 | Caption = 'then' 192 | Font.Charset = DEFAULT_CHARSET 193 | Font.Color = clNavy 194 | Font.Height = -11 195 | Font.Name = 'MS Sans Serif' 196 | Font.Style = [] 197 | ParentFont = False 198 | end 199 | object lElse: TLabel 200 | Left = 121 201 | Top = 247 202 | Width = 19 203 | Height = 13 204 | Caption = 'else' 205 | Font.Charset = DEFAULT_CHARSET 206 | Font.Color = clNavy 207 | Font.Height = -11 208 | Font.Name = 'MS Sans Serif' 209 | Font.Style = [] 210 | ParentFont = False 211 | end 212 | object lMainOptions: TLabel 213 | Left = 4 214 | Top = 0 215 | Width = 62 216 | Height = 13 217 | Caption = 'Main Options' 218 | Font.Charset = DEFAULT_CHARSET 219 | Font.Color = clWindowText 220 | Font.Height = -11 221 | Font.Name = 'MS Sans Serif' 222 | Font.Style = [fsUnderline] 223 | ParentFont = False 224 | end 225 | object bvlMainOptions: TBevel 226 | Left = 68 227 | Top = 7 228 | Width = 558 229 | Height = 9 230 | Shape = bsTopLine 231 | end 232 | object lDefCharSet: TLabel 233 | Left = 8 234 | Top = 97 235 | Width = 81 236 | Height = 13 237 | Caption = 'Default Char. Set' 238 | end 239 | object lDatabase: TLabel 240 | Left = 8 241 | Top = 44 242 | Width = 91 243 | Height = 13 244 | Caption = 'Database file name' 245 | end 246 | object lBooleanOption: TLabel 247 | Left = 430 248 | Top = 221 249 | Width = 60 250 | Height = 13 251 | Caption = 'select option' 252 | Font.Charset = DEFAULT_CHARSET 253 | Font.Color = clNavy 254 | Font.Height = -11 255 | Font.Name = 'MS Sans Serif' 256 | Font.Style = [] 257 | ParentFont = False 258 | end 259 | object lTBinaryField: TLabel 260 | Left = 8 261 | Top = 404 262 | Width = 51 263 | Height = 13 264 | Caption = 'BinaryField' 265 | end 266 | object lTBlobField: TLabel 267 | Left = 450 268 | Top = 298 269 | Width = 43 270 | Height = 13 271 | Caption = 'BlobField' 272 | end 273 | object lTMemoField: TLabel 274 | Left = 450 275 | Top = 272 276 | Width = 51 277 | Height = 13 278 | Caption = 'MemoField' 279 | end 280 | object cbDupInd: TComboBox 281 | Left = 140 282 | Top = 119 283 | Width = 200 284 | Height = 21 285 | Style = csDropDownList 286 | ItemHeight = 13 287 | TabOrder = 1 288 | Items.Strings = ( 289 | 'add number INDEX3' 290 | 'add table name TABLE_INDEX' 291 | 'table+index fields TABLE_ID_NAME') 292 | end 293 | object cbTGraphicField: TComboBox 294 | Left = 315 295 | Top = 399 296 | Width = 120 297 | Height = 21 298 | ItemHeight = 13 299 | TabOrder = 26 300 | Text = 'BLOB' 301 | Items.Strings = ( 302 | 'BLOB') 303 | end 304 | object cbTTimeField: TComboBox 305 | Left = 315 306 | Top = 373 307 | Width = 120 308 | Height = 21 309 | ItemHeight = 13 310 | TabOrder = 25 311 | Text = 'TIME' 312 | Items.Strings = ( 313 | 'TIME' 314 | 'DATE') 315 | end 316 | object cbCase: TComboBox 317 | Left = 140 318 | Top = 146 319 | Width = 200 320 | Height = 21 321 | Style = csDropDownList 322 | ItemHeight = 13 323 | TabOrder = 2 324 | Items.Strings = ( 325 | 'convert to upper case ' 326 | 'convert to lower case' 327 | 'leave it as it is') 328 | end 329 | object btnStart: TButton 330 | Left = 472 331 | Top = 425 332 | Width = 75 333 | Height = 25 334 | Anchors = [akRight, akBottom] 335 | Caption = 'Start!' 336 | TabOrder = 30 337 | OnClick = btnStartClick 338 | end 339 | object btnCancel: TButton 340 | Left = 553 341 | Top = 425 342 | Width = 75 343 | Height = 25 344 | Anchors = [akRight, akBottom] 345 | Caption = 'Close' 346 | ModalResult = 2 347 | TabOrder = 32 348 | end 349 | object cbTAutoIncField: TComboBox 350 | Left = 315 351 | Top = 295 352 | Width = 120 353 | Height = 21 354 | ItemHeight = 13 355 | TabOrder = 21 356 | Text = 'INTEGER' 357 | Items.Strings = ( 358 | 'INTEGER') 359 | end 360 | object cbTCurrencyField: TComboBox 361 | Left = 315 362 | Top = 269 363 | Width = 120 364 | Height = 21 365 | ItemHeight = 13 366 | TabOrder = 20 367 | Text = 'NUMERIC(15,2)' 368 | Items.Strings = ( 369 | 'NUMERIC(15,4)' 370 | 'NUMERIC(15,2)') 371 | end 372 | object cbBool: TComboBox 373 | Left = 496 374 | Top = 217 375 | Width = 131 376 | Height = 21 377 | Style = csDropDownList 378 | ItemHeight = 13 379 | TabOrder = 18 380 | OnChange = cbBoolChange 381 | Items.Strings = ( 382 | 'Create Domain' 383 | 'Use Plain Datatype') 384 | end 385 | object cbTDateTimeField: TComboBox 386 | Left = 315 387 | Top = 321 388 | Width = 120 389 | Height = 21 390 | ItemHeight = 13 391 | TabOrder = 22 392 | Text = 'TIMESTAMP' 393 | Items.Strings = ( 394 | 'TIMESTAMP' 395 | 'DATE') 396 | end 397 | object cbTDateField: TComboBox 398 | Left = 315 399 | Top = 347 400 | Width = 120 401 | Height = 21 402 | ItemHeight = 13 403 | TabOrder = 23 404 | Text = 'DATE' 405 | Items.Strings = ( 406 | 'DATE') 407 | end 408 | object cbTStringFieldL: TComboBox 409 | Left = 143 410 | Top = 243 411 | Width = 83 412 | Height = 21 413 | ItemHeight = 13 414 | TabOrder = 11 415 | Text = 'VARCHAR' 416 | Items.Strings = ( 417 | 'VARCHAR' 418 | 'CHAR') 419 | end 420 | object cbTIntegerField: TComboBox 421 | Left = 77 422 | Top = 269 423 | Width = 150 424 | Height = 21 425 | ItemHeight = 13 426 | TabOrder = 12 427 | Text = 'INTEGER' 428 | Items.Strings = ( 429 | 'INTEGER') 430 | end 431 | object cbTFloatField: TComboBox 432 | Left = 77 433 | Top = 295 434 | Width = 150 435 | Height = 21 436 | ItemHeight = 13 437 | TabOrder = 13 438 | Text = 'FLOAT' 439 | Items.Strings = ( 440 | 'FLOAT' 441 | 'NUMERIC(15,2)') 442 | end 443 | object cbTBCDField: TComboBox 444 | Left = 77 445 | Top = 321 446 | Width = 150 447 | Height = 21 448 | ItemHeight = 13 449 | TabOrder = 14 450 | Text = 'NUMERIC(15,2)' 451 | Items.Strings = ( 452 | 'NUMERIC(15,Decimals)' 453 | 'NUMERIC(15,2)' 454 | 'NUMERIC(Precision,Decimals)') 455 | end 456 | object cbTLargeintField: TComboBox 457 | Left = 77 458 | Top = 347 459 | Width = 150 460 | Height = 21 461 | ItemHeight = 13 462 | TabOrder = 15 463 | Text = 'NUMERIC(18)' 464 | Items.Strings = ( 465 | 'NUMERIC(18)' 466 | 'INTEGER') 467 | end 468 | object cbTSmallintField: TComboBox 469 | Left = 77 470 | Top = 373 471 | Width = 150 472 | Height = 21 473 | ItemHeight = 13 474 | TabOrder = 16 475 | Text = 'SMALLINT' 476 | Items.Strings = ( 477 | 'SMALLINT') 478 | end 479 | object cbTStringFieldS: TComboBox 480 | Left = 143 481 | Top = 217 482 | Width = 83 483 | Height = 21 484 | ItemHeight = 13 485 | TabOrder = 10 486 | Text = 'CHAR' 487 | Items.Strings = ( 488 | 'CHAR' 489 | 'VARCHAR') 490 | end 491 | object cbCharSet: TComboBox 492 | Left = 140 493 | Top = 93 494 | Width = 200 495 | Height = 21 496 | Style = csDropDownList 497 | ItemHeight = 13 498 | TabOrder = 0 499 | Items.Strings = ( 500 | 'None' 501 | 'OCTETS' 502 | 'ASCII' 503 | 'UNICODE_FSS' 504 | 'SJIS_0208' 505 | 'EUCJ_0208' 506 | 'DOS437' 507 | 'DOS850' 508 | 'DOS865' 509 | 'ISO8859_1' 510 | 'DOS852' 511 | 'DOS857' 512 | 'DOS860' 513 | 'DOS861' 514 | 'DOS863' 515 | 'CYRL' 516 | 'WIN1250' 517 | 'WIN1251' 518 | 'WIN1252' 519 | 'WIN1253' 520 | 'WIN1254' 521 | 'NEXT' 522 | 'KSC_5601' 523 | 'BIG_5' 524 | 'GB_2312' 525 | 'DOS737' 526 | 'DOS775' 527 | 'DOS858' 528 | 'DOS862' 529 | 'DOS864' 530 | 'DOS866' 531 | 'DOS869' 532 | 'WIN1255' 533 | 'WIN1256' 534 | 'WIN1257' 535 | 'ISO8859_2' 536 | 'ISO8859_3' 537 | 'ISO8859_4' 538 | 'ISO8859_5' 539 | 'ISO8859_6' 540 | 'ISO8859_7' 541 | 'ISO8859_8' 542 | 'ISO8859_9' 543 | 'ISO8859_13' 544 | 'KOI8-R' 545 | 'KOI8-U') 546 | end 547 | object cbConvNames: TComboBox 548 | Left = 140 549 | Top = 172 550 | Width = 300 551 | Height = 21 552 | Style = csDropDownList 553 | ItemHeight = 13 554 | TabOrder = 3 555 | Items.Strings = ( 556 | 557 | 'to classic format (remove all symbols except '#39'A'#39'..'#39'Z'#39', '#39'a'#39'..'#39'z'#39',' + 558 | ' '#39'0'#39'..'#39'9'#39', '#39'$'#39', '#39'_'#39')' 559 | 'leave it as it is') 560 | end 561 | object mInfo: TMemo 562 | Left = 478 563 | Top = 344 564 | Width = 115 565 | Height = 65 566 | TabStop = False 567 | Lines.Strings = ( 568 | 569 | 'Please visit IB DataPump home/support page at http://www.cleverc' + 570 | 'omponents.com' 571 | '' 572 | 'To execute this script:' 573 | 574 | '1. Run IBConsole (or simular Interbase/Firebird tool which can e' + 575 | 'xecute srcipts)' 576 | '2. Go to menu Tools->Interactive SQL ' 577 | 578 | '3. Now in Interactive SQL window menu Query->Load Script select ' + 579 | 'script created by IB DataPump' 580 | '4. Once script loaded go to menu Query->Execute.') 581 | TabOrder = 24 582 | Visible = False 583 | WantReturns = False 584 | WordWrap = False 585 | end 586 | object cbTBooleanField: TComboBox 587 | Tag = 1 588 | Left = 314 589 | Top = 244 590 | Width = 313 591 | Height = 21 592 | ItemHeight = 13 593 | TabOrder = 19 594 | end 595 | object cbIndexes: TCheckBox 596 | Left = 355 597 | Top = 97 598 | Width = 270 599 | Height = 17 600 | Alignment = taLeftJustify 601 | Caption = 'Copy Indexes and Primary Constraints' 602 | Checked = True 603 | State = cbChecked 604 | TabOrder = 6 605 | end 606 | object cbGen: TCheckBox 607 | Left = 355 608 | Top = 70 609 | Width = 206 610 | Height = 17 611 | Alignment = taLeftJustify 612 | Caption = 'Create Generators For AutoInc Fields' 613 | Checked = True 614 | State = cbChecked 615 | TabOrder = 4 616 | end 617 | object btnAutoIncDefine: TButton 618 | Left = 570 619 | Top = 64 620 | Width = 56 621 | Height = 25 622 | Caption = 'Define...' 623 | TabOrder = 5 624 | OnClick = btnAutoIncDefineClick 625 | end 626 | object btnSaveProfile: TButton 627 | Left = 4 628 | Top = 425 629 | Width = 75 630 | Height = 25 631 | Caption = 'Save Profile...' 632 | TabOrder = 34 633 | OnClick = btnSaveProfileClick 634 | end 635 | object btnLoadProfile: TButton 636 | Left = 86 637 | Top = 425 638 | Width = 75 639 | Height = 25 640 | Caption = 'Load Profile...' 641 | TabOrder = 29 642 | OnClick = btnLoadProfileClick 643 | end 644 | object btnHelp: TButton 645 | Left = 355 646 | Top = 425 647 | Width = 75 648 | Height = 25 649 | Anchors = [akTop, akRight] 650 | Caption = 'Help?' 651 | Font.Charset = DEFAULT_CHARSET 652 | Font.Color = clNavy 653 | Font.Height = -11 654 | Font.Name = 'MS Sans Serif' 655 | Font.Style = [] 656 | ParentFont = False 657 | TabOrder = 31 658 | OnClick = btnHelpClick 659 | end 660 | object btnNewProfile: TButton 661 | Left = 170 662 | Top = 425 663 | Width = 75 664 | Height = 25 665 | Caption = 'New Profile' 666 | TabOrder = 33 667 | OnClick = btnNewProfileClick 668 | end 669 | object cbTBinaryField: TComboBox 670 | Left = 77 671 | Top = 399 672 | Width = 150 673 | Height = 21 674 | ItemHeight = 13 675 | TabOrder = 17 676 | Text = 'BLOB' 677 | Items.Strings = ( 678 | 'BLOB' 679 | 'INTEGER') 680 | end 681 | object cbDefaults: TCheckBox 682 | Left = 355 683 | Top = 123 684 | Width = 270 685 | Height = 17 686 | Alignment = taLeftJustify 687 | Caption = 'Copy Defaults and Validity Checks (Paradox, dBase)' 688 | Checked = True 689 | State = cbChecked 690 | TabOrder = 7 691 | end 692 | object cbRefs: TCheckBox 693 | Left = 355 694 | Top = 150 695 | Width = 270 696 | Height = 17 697 | Alignment = taLeftJustify 698 | Caption = 'Copy Referential Integrity (Paradox, dBase only)' 699 | Checked = True 700 | State = cbChecked 701 | TabOrder = 8 702 | end 703 | object cbTBlobField: TComboBox 704 | Left = 508 705 | Top = 295 706 | Width = 120 707 | Height = 21 708 | ItemHeight = 13 709 | TabOrder = 28 710 | Text = 'BLOB' 711 | Items.Strings = ( 712 | 'BLOB') 713 | end 714 | object cbTMemoField: TComboBox 715 | Left = 508 716 | Top = 269 717 | Width = 120 718 | Height = 21 719 | ItemHeight = 13 720 | TabOrder = 27 721 | Text = 'BLOB SUB_TYPE 1' 722 | Items.Strings = ( 723 | 'BLOB SUB_TYPE 1') 724 | end 725 | object cbLang: TCheckBox 726 | Left = 454 727 | Top = 175 728 | Width = 171 729 | Height = 17 730 | Alignment = taLeftJustify 731 | Caption = 'Get Language Information' 732 | Checked = True 733 | State = cbChecked 734 | TabOrder = 9 735 | end 736 | object sd: TSaveDialog 737 | DefaultExt = 'sql' 738 | Filter = 'SQL script files (*.sql)|*.sql' 739 | Options = [ofOverwritePrompt, ofHideReadOnly, ofEnableSizing] 740 | Left = 552 741 | Top = 318 742 | end 743 | object sdProfile: TSaveDialog 744 | DefaultExt = 'ssp' 745 | Filter = 'SQL Script Profile (*.ssp)|*.ssp' 746 | Options = [ofOverwritePrompt, ofHideReadOnly, ofEnableSizing] 747 | Title = 'Save Profile' 748 | Left = 504 749 | Top = 320 750 | end 751 | object odProfile: TOpenDialog 752 | DefaultExt = 'ssp' 753 | Filter = 'SQL Script Profile (*.ssp)|*.ssp' 754 | Title = 'Load Profile' 755 | Left = 452 756 | Top = 320 757 | end 758 | end 759 | -------------------------------------------------------------------------------- /Sources/IBDataPump/ibpHelp.pas: -------------------------------------------------------------------------------- 1 | { 2 | Copyright (c) 2000-2005 CleverComponents.com 3 | Product: Interbase DataPump 4 | Author: Alexandre Poloziouk 5 | Unit: ibpHelp.pas 6 | } 7 | 8 | unit ibpHelp; 9 | 10 | {$INCLUDE ccGetVer.inc} 11 | 12 | interface 13 | 14 | uses 15 | Windows, Classes, Controls, Forms, ShellApi, ExtCtrls, jpeg; 16 | 17 | type 18 | 19 | { TibpHelp } 20 | 21 | TibpHelp = class(TForm) 22 | Logo: TImage; 23 | Image1: TImage; 24 | Image2: TImage; 25 | procedure Image1Click(Sender: TObject); 26 | procedure LogoClick(Sender: TObject); 27 | procedure Image2Click(Sender: TObject); 28 | procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); 29 | end; 30 | 31 | var 32 | FibpHelp: TibpHelp; 33 | 34 | implementation 35 | 36 | uses ibpMain; 37 | 38 | {$R *.DFM} 39 | 40 | { TibpHelp } 41 | 42 | procedure TibpHelp.Image1Click(Sender: TObject); 43 | begin 44 | ShellExecute( 0, PChar('open'), PChar(AppHome), nil, nil, SW_RESTORE); 45 | end; 46 | 47 | procedure TibpHelp.Image2Click(Sender: TObject); 48 | begin 49 | ShellExecute( 0, PChar('open'), PChar('mailto:' + AppEmail), nil, nil, SW_RESTORE); 50 | end; 51 | 52 | procedure TibpHelp.LogoClick(Sender: TObject); 53 | begin 54 | Close; 55 | end; 56 | 57 | procedure TibpHelp.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); 58 | begin 59 | if Key = 27 60 | then Close; 61 | end; 62 | 63 | end. 64 | -------------------------------------------------------------------------------- /Sources/IBDataPump/ibpIncFields.dfm: -------------------------------------------------------------------------------- 1 | object ibpIncFields: TibpIncFields 2 | Left = 390 3 | Top = 157 4 | Width = 434 5 | Height = 387 6 | Caption = 'Define Auto Increment Fields' 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 = poScreenCenter 15 | Scaled = False 16 | OnCreate = FormCreate 17 | OnDestroy = FormDestroy 18 | OnShow = FormShow 19 | PixelsPerInch = 96 20 | TextHeight = 13 21 | object Panel2: TPanel 22 | Left = 0 23 | Top = 0 24 | Width = 426 25 | Height = 321 26 | Align = alClient 27 | BevelOuter = bvNone 28 | TabOrder = 1 29 | object lTable: TLabel 30 | Left = 3 31 | Top = 297 32 | Width = 27 33 | Height = 13 34 | Anchors = [akLeft, akBottom] 35 | Caption = 'Table' 36 | end 37 | object lField: TLabel 38 | Left = 220 39 | Top = 297 40 | Width = 22 41 | Height = 13 42 | Anchors = [akLeft, akBottom] 43 | Caption = 'Field' 44 | end 45 | object lvFields: TListView 46 | Left = 0 47 | Top = 26 48 | Width = 426 49 | Height = 261 50 | Anchors = [akLeft, akTop, akRight, akBottom] 51 | Columns = < 52 | item 53 | Caption = 'Table' 54 | Width = 202 55 | end 56 | item 57 | Caption = 'Field' 58 | Width = 200 59 | end> 60 | ColumnClick = False 61 | HideSelection = False 62 | IconOptions.Arrangement = iaLeft 63 | IconOptions.WrapText = False 64 | ReadOnly = True 65 | RowSelect = True 66 | SmallImages = imgFields 67 | TabOrder = 1 68 | ViewStyle = vsReport 69 | OnSelectItem = lvFieldsSelectItem 70 | end 71 | object cbInt: TCheckBox 72 | Left = 4 73 | Top = 4 74 | Width = 222 75 | Height = 17 76 | Caption = 'Show Only TIntegerField Descendants' 77 | Checked = True 78 | State = cbChecked 79 | TabOrder = 0 80 | OnClick = cbIntClick 81 | end 82 | object cbTables: TComboBox 83 | Left = 34 84 | Top = 293 85 | Width = 180 86 | Height = 21 87 | Style = csDropDownList 88 | Anchors = [akLeft, akBottom] 89 | DropDownCount = 20 90 | ItemHeight = 13 91 | TabOrder = 2 92 | OnChange = cbTablesChange 93 | end 94 | object cbFields: TComboBox 95 | Left = 246 96 | Top = 293 97 | Width = 180 98 | Height = 21 99 | Style = csDropDownList 100 | Anchors = [akLeft, akBottom] 101 | DropDownCount = 20 102 | ItemHeight = 13 103 | TabOrder = 3 104 | OnChange = cbFieldsChange 105 | end 106 | end 107 | object Panel1: TPanel 108 | Left = 0 109 | Top = 321 110 | Width = 426 111 | Height = 39 112 | Align = alBottom 113 | BevelOuter = bvNone 114 | TabOrder = 0 115 | object bvlBottom: TBevel 116 | Left = 0 117 | Top = 0 118 | Width = 426 119 | Height = 10 120 | Align = alTop 121 | Shape = bsTopLine 122 | end 123 | object btnAdd: TButton 124 | Left = 4 125 | Top = 9 126 | Width = 75 127 | Height = 25 128 | Anchors = [akLeft, akBottom] 129 | Caption = 'Add' 130 | TabOrder = 0 131 | OnClick = btnAddClick 132 | end 133 | object btnDelete: TButton 134 | Left = 86 135 | Top = 9 136 | Width = 75 137 | Height = 25 138 | Anchors = [akLeft, akBottom] 139 | Caption = 'Delete' 140 | TabOrder = 1 141 | OnClick = btnDeleteClick 142 | end 143 | object btnClearAll: TButton 144 | Left = 176 145 | Top = 9 146 | Width = 75 147 | Height = 25 148 | Anchors = [akLeft, akBottom] 149 | Caption = 'Clear All' 150 | TabOrder = 2 151 | OnClick = btnClearAllClick 152 | end 153 | object btnOk: TButton 154 | Left = 348 155 | Top = 9 156 | Width = 75 157 | Height = 25 158 | Anchors = [akRight, akBottom] 159 | Caption = 'Close' 160 | ModalResult = 1 161 | TabOrder = 3 162 | end 163 | end 164 | object imgFields: TImageList 165 | Left = 264 166 | Top = 112 167 | Bitmap = { 168 | 494C010101000400040010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 169 | 0000000000003600000028000000400000001000000001002000000000000010 170 | 0000000000000000000000000000000000000000000000000000000000000000 171 | 0000000000000000000000000000000000000000000000000000000000000000 172 | 0000000000000000000000000000000000000000000000000000000000000000 173 | 0000000000000000000000000000000000000000000000000000000000000000 174 | 0000000000000000000000000000000000000000000000000000000000000000 175 | 0000000000000000000000000000000000000000000000000000000000000000 176 | 0000000000000000000000000000000000000000000000000000000000000000 177 | 0000000000000000000000000000000000000000000000000000000000000000 178 | 0000000000000000000000000000000000000000000000000000000000000000 179 | 0000000000000000000000000000000000000000000000000000000000000000 180 | 0000000000000000000000000000000000000000000000000000000000000000 181 | 0000000000000000000000000000000000000000000000000000000000000000 182 | 0000000000000000000000000000000000000000000000000000000000000000 183 | 0000000000000000000000000000000000000000000000000000000000000000 184 | 0000000000000000000000000000000000000000000000000000000000000000 185 | 0000000000000000000000000000000000000000000000000000000000000000 186 | 0000000000000000000000000000000000000000000000000000000000000000 187 | 0000000000000000000000000000000000000000000000000000000000000000 188 | 0000000000000000000000000000000000000000000000000000000000000000 189 | 0000000000000000000000000000000000000000000000000000000000000000 190 | 0000000000000000000000000000000000000000000000000000000000000000 191 | 0000000000000000000000000000000000000000000000000000000000000000 192 | 0000000000000000000000000000000000000000000000000000000000000000 193 | 0000000000000000000000000000000000000000000000000000000000000000 194 | 0000000000000000000000000000000000000000000000000000000000000000 195 | 0000000000000000000000000000000000000000000000000000000000000000 196 | 0000000000000000000000000000000000000000000000000000000000000000 197 | 0000000000000000000000000000000000000000000000000000000000000000 198 | 0000000000000000000000000000000000000000000000000000000000000000 199 | 0000000000000000000000000000000000000000000000000000000000000000 200 | 0000000000000000000000000000000000000000000000000000000000000000 201 | 0000000000000000000000000000000000000000000000000000000000000000 202 | 0000000000000000000000000000000000000000000000000000000000000000 203 | 0000000000000000000000000000800000000000000000000000000000000000 204 | 0000000000000000000000000000000000000000000000000000000000000000 205 | 0000000000000000000000000000000000000000000000000000000000000000 206 | 0000000000000000000000000000000000000000000000000000000000000000 207 | 0000000000000000000000000000000000000000000000000000000000000000 208 | 0000000000000000000000000000000000000000000000000000000000000000 209 | 0000000000000000000000000000000000000000000000000000000000000000 210 | 0000000000000000000000000000000000000000000000000000000000000000 211 | 0000000000000000000000000000000000000000000000000000000000000000 212 | 0000000000000000000000000000000000000000000000000000000000000000 213 | 0000000000000000000000000000000000000000000000000000000000000000 214 | 0000000000000000000000000000000000000000000000000000000000000000 215 | 0000000000000000000000000000000000000000000000000000000000000000 216 | 0000000000000000000000000000000000000000000000000000000000000000 217 | 0000000000000000000000000000000000000000000000000000000000000000 218 | 0000000000000000000000000000000000000000000000000000000000000000 219 | 0000000000000000000000000000800000000000000000000000000000000000 220 | 0000000000000000000000000000000000000000000000000000000000000000 221 | 0000000000000000000000000000000000000000000000000000000000000000 222 | 0000000000000000000000000000000000000000000000000000000000000000 223 | 0000000000000000000000000000000000000000000000000000000000000000 224 | 0000000000000000000000000000000000000000000000000000000000000000 225 | 0000000000000000000000000000000000000000000000000000000000000000 226 | 0000000000000000000000000000000000000000000000000000000000000000 227 | 0000000000000000000000000000000000000000000000000000000000000000 228 | 0000000000000000000000000000000000000000000000000000000000000000 229 | 0000000000000000000000000000000000000000000000000000000000000000 230 | 0000000000000000000000000000000000000000000000000000000000000000 231 | 0000000000000000000000000000000000000000000000000000000000000000 232 | 0000000000000000000000000000000000000000000000000000000000000000 233 | 0000000000000000000000000000000000000000000000000000000000000000 234 | 0000000000000000000000000000000000000000000000000000000000000000 235 | 0000000000000000000000000000800000000000000000000000000000000000 236 | 0000000000000000000000000000000000000000000000000000000000000000 237 | 0000000000000000000000000000000000000000000000000000000000000000 238 | 0000000000000000000000000000000000000000000000000000000000000000 239 | 0000000000000000000000000000000000000000000000000000000000000000 240 | 0000000000000000000000000000000000000000000000000000000000000000 241 | 0000000000000000000000000000000000000000000000000000000000000000 242 | 0000000000000000000000000000000000000000000000000000000000000000 243 | 0000000000000000000000000000000000000000000000000000000000000000 244 | 0000000000000000000000000000000000000000000000000000000000000000 245 | 0000000000000000000000000000000000000000000000000000000000000000 246 | 0000000000000000000000000000000000000000000000000000000000000000 247 | 0000000000000000000000000000000000000000000000000000000000000000 248 | 0000000000000000000000000000000000000000000000000000000000000000 249 | 0000000000000000000000000000000000000000000000000000000000000000 250 | 0000000000000000000000000000000000000000000000000000000000008000 251 | 0000800000008000000080000000800000008000000080000000800000008000 252 | 0000800000000000000000000000000000000000000000000000000000000000 253 | 0000000000000000000000000000000000000000000000000000000000000000 254 | 0000000000000000000000000000000000000000000000000000000000000000 255 | 0000000000000000000000000000000000000000000000000000000000000000 256 | 0000000000000000000000000000000000000000000000000000000000000000 257 | 0000000000000000000000000000000000000000000000000000000000000000 258 | 000000000000000000000000000000000000000000000000000000000000FFFF 259 | 0000FF000000FFFF0000FF000000FFFF0000FF000000FFFF0000FF000000FFFF 260 | 0000FF0000000000000000000000000000000000000000000000000000000000 261 | 0000000000000000000000000000000000000000000000000000000000000000 262 | 0000000000000000000000000000000000000000000000000000000000000000 263 | 0000000000000000000000000000000000000000000000000000000000000000 264 | 0000000000000000000000000000000000000000000000000000000000000000 265 | 0000000000000000000000000000000000000000000000000000000000000000 266 | 000000000000000000000000000000000000000000000000000000000000FF00 267 | 0000FFFF0000FF000000FFFF0000FF000000FFFF0000FF000000FFFF0000FF00 268 | 0000FFFF00000000000000000000000000000000000000000000000000000000 269 | 0000000000000000000000000000000000000000000000000000000000000000 270 | 0000000000000000000000000000000000000000000000000000000000000000 271 | 0000000000000000000000000000000000000000000000000000000000000000 272 | 0000000000000000000000000000000000000000000000000000000000000000 273 | 0000000000000000000000000000000000000000000000000000000000000000 274 | 0000000000000000000000000000000000000000000000000000000000000000 275 | 0000000000000000000000000000000000000000000000000000000000000000 276 | 0000000000000000000000000000000000000000000000000000000000000000 277 | 0000000000000000000000000000000000000000000000000000000000000000 278 | 0000000000000000000000000000000000000000000000000000000000000000 279 | 0000000000000000000000000000000000000000000000000000000000000000 280 | 0000000000000000000000000000000000000000000000000000000000000000 281 | 0000000000000000000000000000000000000000000000000000000000000000 282 | 0000000000000000000000000000000000000000000000000000000000000000 283 | 0000000000000000000000000000000000000000000000000000000000000000 284 | 0000000000000000000000000000000000000000000000000000000000000000 285 | 0000000000000000000000000000000000000000000000000000000000000000 286 | 0000000000000000000000000000000000000000000000000000000000000000 287 | 0000000000000000000000000000000000000000000000000000000000000000 288 | 0000000000000000000000000000000000000000000000000000000000000000 289 | 0000000000000000000000000000000000000000000000000000000000000000 290 | 0000000000000000000000000000000000000000000000000000000000000000 291 | 0000000000000000000000000000000000000000000000000000000000000000 292 | 0000000000000000000000000000000000000000000000000000000000000000 293 | 0000000000000000000000000000000000000000000000000000000000000000 294 | 0000000000000000000000000000000000000000000000000000000000000000 295 | 0000000000000000000000000000000000000000000000000000000000000000 296 | 0000000000000000000000000000000000000000000000000000000000000000 297 | 0000000000000000000000000000000000000000000000000000000000000000 298 | 000000000000000000000000000000000000424D3E000000000000003E000000 299 | 2800000040000000100000000100010000000000800000000000000000000000 300 | 000000000000000000000000FFFFFF00FFFF000000000000FFFF000000000000 301 | C003000000000000DBDB000000000000DA5B000000000000DBDB000000000000 302 | DA5B000000000000DBDB000000000000DA5B000000000000DBDB000000000000 303 | C003000000000000C003000000000000C003000000000000C003000000000000 304 | FFFF000000000000FFFF00000000000000000000000000000000000000000000 305 | 000000000000} 306 | end 307 | end 308 | -------------------------------------------------------------------------------- /Sources/IBDataPump/ibpIncFields.pas: -------------------------------------------------------------------------------- 1 | { 2 | Copyright (c) 2000-2005 CleverComponents.com 3 | Product: Interbase DataPump 4 | Author: Alexandre Poloziouk 5 | Unit: ibpIncFields.pas 6 | } 7 | 8 | unit ibpIncFields; 9 | 10 | {$INCLUDE ccGetVer.inc} 11 | 12 | interface 13 | 14 | uses 15 | Windows, Messages, SysUtils, Classes, Controls, Forms, Dialogs, 16 | Db, DBTables, DBGrids, Grids, StdCtrls, DbiTypes , ComCtrls, ExtCtrls, ImgList, 17 | ibpMain, ibpDM; 18 | 19 | type 20 | 21 | { TibpIncFields } 22 | 23 | TibpIncFields = class(TForm) 24 | imgFields: TImageList; 25 | Panel1: TPanel; 26 | bvlBottom: TBevel; 27 | btnAdd: TButton; 28 | btnDelete: TButton; 29 | btnClearAll: TButton; 30 | btnOk: TButton; 31 | Panel2: TPanel; 32 | lTable: TLabel; 33 | lField: TLabel; 34 | lvFields: TListView; 35 | cbInt: TCheckBox; 36 | cbTables: TComboBox; 37 | cbFields: TComboBox; 38 | procedure FormShow(Sender: TObject); 39 | procedure btnClearAllClick(Sender: TObject); 40 | procedure FormCreate(Sender: TObject); 41 | procedure FormDestroy(Sender: TObject); 42 | procedure cbIntClick(Sender: TObject); 43 | procedure cbTablesChange(Sender: TObject); 44 | procedure btnAddClick(Sender: TObject); 45 | procedure cbFieldsChange(Sender: TObject); 46 | procedure btnDeleteClick(Sender: TObject); 47 | procedure lvFieldsSelectItem(Sender: TObject; Item: TListItem; 48 | Selected: Boolean); 49 | private 50 | FMain: TibpMain; 51 | FFieldsCash: TStringList; 52 | 53 | procedure ClearFieldsCash; 54 | procedure GetFields(const ATableName: string; AList: TStrings); 55 | public 56 | constructor Create(AOwner: TComponent); override; 57 | function Find(const ATable, AField: string): boolean; 58 | end; 59 | 60 | implementation 61 | 62 | {$R *.DFM} 63 | 64 | { TibpIncFields } 65 | 66 | constructor TibpIncFields.Create(AOwner: TComponent); 67 | begin 68 | inherited; 69 | FMain := AOwner as TibpMain; 70 | end; 71 | 72 | procedure TibpIncFields.FormCreate(Sender: TObject); 73 | begin 74 | FFieldsCash := TStringList.Create; 75 | GetWindStat(Self); 76 | end; 77 | 78 | procedure TibpIncFields.FormDestroy(Sender: TObject); 79 | begin 80 | ClearFieldsCash; 81 | FFieldsCash.Free; 82 | SetWindStat(Self); 83 | end; 84 | 85 | procedure TibpIncFields.ClearFieldsCash; 86 | var 87 | i: integer; 88 | begin 89 | for i := 0 to FFieldsCash.Count-1 90 | do TStringList(FFieldsCash.Objects[i]).Free; 91 | FFieldsCash.Clear; 92 | end; 93 | 94 | procedure TibpIncFields.FormShow(Sender: TObject); 95 | var 96 | lst: TStringList; 97 | begin 98 | ClearFieldsCash; 99 | lst := TStringList.Create; 100 | try 101 | try 102 | case FMain.SrcType of 103 | pdtBDE: Session.GetTableNames(FMain.DM.bdeDb.DatabaseName, '', not FMain.DM.bdeDb.IsSQLBased, False, lst); 104 | pdtADO: FMain.DM.adoDb.GetTableNames(lst, False); 105 | else 106 | raise Exception.Create(ErrSrc); 107 | end; 108 | cbTables.Items.Assign(lst); 109 | except 110 | on E: Exception do 111 | begin 112 | ShowMessage(Format('Can not get list of tables for Source DB: Error - %s', [E.Message])); 113 | end; 114 | end; 115 | finally 116 | lst.Free; 117 | end; 118 | 119 | lvFieldsSelectItem(lvFields, lvFields.Selected, True); 120 | end; 121 | 122 | procedure TibpIncFields.GetFields(const ATableName: string; AList: TStrings); 123 | var 124 | i, j: integer; 125 | lst: TStringList; 126 | ds: TDataset; 127 | FTableName: string; 128 | begin 129 | AList.Clear; 130 | if Length(Trim(ATableName)) > 0 then 131 | begin 132 | i := FFieldsCash.IndexOf(ATableName); 133 | if i = -1 then 134 | begin 135 | lst := TStringList.Create; 136 | try 137 | case FMain.SrcType of 138 | pdtBDE: 139 | begin 140 | if FMain.DM.bdeDb.IsSQLBased and FMain.SrcQuoteFields 141 | then FTableName := GetSQLName(ATableName, FMain.SrcType, FMain.SrcSelect) 142 | else FTableName := ATableName; 143 | FMain.bdeTable.TableName := FTableName; 144 | ds := FMain.bdeTable; 145 | end; 146 | pdtADO: 147 | begin 148 | if FMain.SrcQuoteFields 149 | then FTableName := GetSQLName(ATableName, FMain.SrcType, FMain.SrcSelect) 150 | else FTableName := ATableName; 151 | FMain.adoTable.TableName := FTableName; 152 | ds := FMain.adoTable; 153 | end; 154 | else 155 | raise Exception.Create(ErrSrc); 156 | end; 157 | 158 | with ds do 159 | begin 160 | Close; 161 | FieldDefs.Update; 162 | for j := 0 to FieldDefs.Count-1 do 163 | begin 164 | if (not cbInt.Checked) or 165 | (FieldDefs[j].FieldClass.InheritsFrom(TIntegerField)) 166 | then lst.Add(FieldDefs[j].Name); 167 | end; 168 | FFieldsCash.AddObject(ATableName, lst); 169 | end; 170 | except 171 | lst.Free; 172 | lst := nil; 173 | end; 174 | end 175 | else 176 | begin 177 | lst := TStringList(FFieldsCash.Objects[i]); 178 | end; 179 | if lst <> nil 180 | then AList.Assign(lst); 181 | end; 182 | end; 183 | 184 | procedure TibpIncFields.cbIntClick(Sender: TObject); 185 | begin 186 | ClearFieldsCash; 187 | lvFields.Selected := nil; 188 | end; 189 | 190 | procedure TibpIncFields.btnClearAllClick(Sender: TObject); 191 | begin 192 | lvFields.Items.Clear; 193 | end; 194 | 195 | procedure TibpIncFields.btnAddClick(Sender: TObject); 196 | var 197 | li: TListItem; 198 | begin 199 | li := lvFields.Items.Add; 200 | li.SubItems.Add(''); 201 | lvFields.Selected := li; 202 | lvFields.Selected.MakeVisible(False); 203 | end; 204 | 205 | procedure TibpIncFields.btnDeleteClick(Sender: TObject); 206 | begin 207 | if lvFields.Selected <> nil then 208 | begin 209 | lvFields.Selected.Delete; 210 | if lvFields.Items.Count > 0 then 211 | begin 212 | lvFields.Selected :=lvFields.Items[0]; 213 | lvFields.Selected.MakeVisible(False); 214 | end; 215 | end; 216 | end; 217 | 218 | procedure TibpIncFields.cbTablesChange(Sender: TObject); 219 | var 220 | oldVal: string; 221 | begin 222 | if Self.Visible then 223 | begin 224 | oldVal := cbFields.Text; 225 | GetFields(TComboBox(Sender).Text, cbFields.Items); 226 | cbFields.ItemIndex := cbFields.Items.IndexOf(oldVal); 227 | if lvFields.Selected <> nil then 228 | begin 229 | lvFields.Selected.Caption := TComboBox(Sender).Text; 230 | lvFields.Selected.SubItems[0] := ''; 231 | end; 232 | end; 233 | end; 234 | 235 | procedure TibpIncFields.cbFieldsChange(Sender: TObject); 236 | begin 237 | if Self.Visible and (lvFields.Selected <> nil) 238 | then lvFields.Selected.SubItems[0] := TComboBox(Sender).Text; 239 | end; 240 | 241 | procedure TibpIncFields.lvFieldsSelectItem(Sender: TObject; 242 | Item: TListItem; Selected: Boolean); 243 | begin 244 | if Self.Visible then 245 | begin 246 | if Selected and (Item <> nil) then 247 | begin 248 | cbTables.Enabled := True; 249 | cbFields.Enabled := True; 250 | 251 | cbTables.ItemIndex := cbTables.Items.IndexOf(Item.Caption); 252 | if cbTables.ItemIndex = -1 253 | then cbFields.Items.Clear 254 | else GetFields(cbTables.Text, cbFields.Items); 255 | cbFields.ItemIndex := cbFields.Items.IndexOf(Item.SubItems[0]); 256 | end 257 | else 258 | begin 259 | cbTables.Enabled := False; 260 | cbFields.Enabled := False; 261 | 262 | cbTables.ItemIndex := -1; 263 | cbFields.ItemIndex := -1; 264 | end; 265 | end; 266 | end; 267 | 268 | function TibpIncFields.Find(const ATable, AField: string): boolean; 269 | var 270 | i: integer; 271 | begin 272 | result := False; 273 | for i := 0 to lvFields.Items.Count-1 do 274 | begin 275 | result := ((lvFields.Items[i].Caption = ATable) and (Length(AField) = 0)) or 276 | ((lvFields.Items[i].Caption = ATable) and (lvFields.Items[i].SubItems[0] = AField)); 277 | if result 278 | then Break; 279 | end; 280 | end; 281 | 282 | end. 283 | -------------------------------------------------------------------------------- /Sources/IBDataPump/ibpSQLEditor.dfm: -------------------------------------------------------------------------------- 1 | object ibpSQLEditor: TibpSQLEditor 2 | Left = 352 3 | Top = 208 4 | Width = 598 5 | Height = 466 6 | Caption = 'SQL Editor ' 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 | Scaled = False 16 | OnCloseQuery = FormCloseQuery 17 | OnCreate = FormCreate 18 | OnDestroy = FormDestroy 19 | PixelsPerInch = 96 20 | TextHeight = 13 21 | object Panel1: TPanel 22 | Left = 0 23 | Top = 386 24 | Width = 582 25 | Height = 41 26 | Align = alBottom 27 | BevelOuter = bvNone 28 | TabOrder = 1 29 | DesignSize = ( 30 | 582 31 | 41) 32 | object btnSave: TButton 33 | Left = 416 34 | Top = 8 35 | Width = 75 36 | Height = 25 37 | Anchors = [akTop, akRight, akBottom] 38 | Caption = '&Save' 39 | ModalResult = 1 40 | TabOrder = 0 41 | end 42 | object btnCancel: TButton 43 | Left = 504 44 | Top = 8 45 | Width = 75 46 | Height = 25 47 | Anchors = [akTop, akRight, akBottom] 48 | Caption = '&Cancel' 49 | ModalResult = 2 50 | TabOrder = 1 51 | end 52 | end 53 | object Panel2: TPanel 54 | Left = 0 55 | Top = 0 56 | Width = 582 57 | Height = 386 58 | Align = alClient 59 | BevelOuter = bvNone 60 | TabOrder = 0 61 | object Splitter2: TSplitter 62 | Left = 156 63 | Top = 0 64 | Height = 386 65 | Beveled = True 66 | end 67 | object Panel3: TPanel 68 | Left = 159 69 | Top = 0 70 | Width = 423 71 | Height = 386 72 | Align = alClient 73 | BevelOuter = bvNone 74 | TabOrder = 0 75 | object Splitter1: TSplitter 76 | Left = 0 77 | Top = 185 78 | Width = 423 79 | Height = 3 80 | Cursor = crVSplit 81 | Align = alBottom 82 | Beveled = True 83 | end 84 | object Panel5: TPanel 85 | Left = 0 86 | Top = 188 87 | Width = 423 88 | Height = 198 89 | Align = alBottom 90 | Anchors = [akBottom] 91 | BevelOuter = bvNone 92 | TabOrder = 1 93 | DesignSize = ( 94 | 423 95 | 198) 96 | object DBGrid: TDBGrid 97 | Left = 0 98 | Top = 44 99 | Width = 431 100 | Height = 153 101 | TabStop = False 102 | Anchors = [akLeft, akTop, akRight, akBottom] 103 | DataSource = DS 104 | Options = [dgTitles, dgIndicator, dgColumnResize, dgColLines, dgRowLines, dgConfirmDelete, dgCancelOnExit] 105 | ReadOnly = True 106 | TabOrder = 2 107 | TitleFont.Charset = DEFAULT_CHARSET 108 | TitleFont.Color = clWindowText 109 | TitleFont.Height = -11 110 | TitleFont.Name = 'MS Sans Serif' 111 | TitleFont.Style = [] 112 | end 113 | object btnExecute: TButton 114 | Left = 347 115 | Top = 8 116 | Width = 75 117 | Height = 25 118 | Anchors = [akTop, akRight] 119 | Caption = 'Execute' 120 | TabOrder = 0 121 | OnClick = btnExecuteClick 122 | end 123 | object btnParams: TButton 124 | Left = 347 125 | Top = 8 126 | Width = 75 127 | Height = 25 128 | Anchors = [akTop, akRight] 129 | Caption = 'Get Params' 130 | TabOrder = 1 131 | OnClick = btnParamsClick 132 | end 133 | end 134 | object Panel6: TPanel 135 | Left = 0 136 | Top = 0 137 | Width = 423 138 | Height = 185 139 | Align = alClient 140 | BevelOuter = bvNone 141 | TabOrder = 0 142 | DesignSize = ( 143 | 423 144 | 185) 145 | object lName: TLabel 146 | Left = 11 147 | Top = 10 148 | Width = 28 149 | Height = 13 150 | Caption = 'Name' 151 | end 152 | object eName: TEdit 153 | Left = 50 154 | Top = 8 155 | Width = 161 156 | Height = 21 157 | TabOrder = 0 158 | Text = 'eName' 159 | end 160 | object memSQL: TMemo 161 | Left = 0 162 | Top = 38 163 | Width = 431 164 | Height = 158 165 | Anchors = [akLeft, akTop, akRight, akBottom] 166 | HideSelection = False 167 | ScrollBars = ssBoth 168 | TabOrder = 1 169 | WordWrap = False 170 | end 171 | end 172 | end 173 | object Panel4: TPanel 174 | Left = 0 175 | Top = 0 176 | Width = 156 177 | Height = 386 178 | Align = alLeft 179 | BevelOuter = bvNone 180 | TabOrder = 1 181 | end 182 | end 183 | object DS: TDataSource 184 | AutoEdit = False 185 | Left = 384 186 | Top = 104 187 | end 188 | object qryBDE: TQuery 189 | Left = 316 190 | Top = 48 191 | end 192 | object qryIB: TIBQuery 193 | BufferChunks = 1000 194 | CachedUpdates = False 195 | Left = 316 196 | Top = 96 197 | end 198 | object popMenu: TPopupMenu 199 | OnPopup = popMenuPopup 200 | Left = 88 201 | Top = 32 202 | object AddTableName1: TMenuItem 203 | Caption = 'Add Table Name' 204 | OnClick = AddTableName1Click 205 | end 206 | object AddFieldName1: TMenuItem 207 | Caption = 'Add Field Name' 208 | OnClick = AddTableName1Click 209 | end 210 | object AddAllFields1: TMenuItem 211 | Caption = 'Add All Field Names' 212 | OnClick = AddAllFields1Click 213 | end 214 | end 215 | object qryADO: TADOQuery 216 | AutoCalcFields = False 217 | LockType = ltReadOnly 218 | Parameters = <> 219 | Left = 319 220 | Top = 144 221 | end 222 | end 223 | -------------------------------------------------------------------------------- /Sources/IBDataPump/ibpSQLEditor.pas: -------------------------------------------------------------------------------- 1 | { 2 | Copyright (c) 2000-2005 CleverComponents.com 3 | Product: Interbase DataPump 4 | Author: Alexandre Poloziouk 5 | Unit: ibpSQLEditor.pas 6 | } 7 | 8 | unit ibpSQLEditor; 9 | 10 | {$INCLUDE ccGetVer.inc} 11 | 12 | interface 13 | 14 | uses 15 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 16 | ExtCtrls, StdCtrls, Grids, DBGrids, Db, DBTables, IBCustomDataSet, 17 | IBQuery, IBDataBase, Menus, ADODB, 18 | ibpMain, ccTreeView; 19 | 20 | type 21 | 22 | { TibpSQLEditor } 23 | 24 | TibpSQLEditor = class(TForm) 25 | Panel1: TPanel; 26 | Panel2: TPanel; 27 | btnSave: TButton; 28 | btnCancel: TButton; 29 | Panel3: TPanel; 30 | Panel4: TPanel; 31 | Panel5: TPanel; 32 | Splitter1: TSplitter; 33 | btnExecute: TButton; 34 | DBGrid: TDBGrid; 35 | DS: TDataSource; 36 | Panel6: TPanel; 37 | lName: TLabel; 38 | eName: TEdit; 39 | memSQL: TMemo; 40 | qryBDE: TQuery; 41 | qryIB: TIBQuery; 42 | popMenu: TPopupMenu; 43 | AddTableName1: TMenuItem; 44 | AddAllFields1: TMenuItem; 45 | AddFieldName1: TMenuItem; 46 | Splitter2: TSplitter; 47 | qryADO: TADOQuery; 48 | btnParams: TButton; 49 | procedure btnExecuteClick(Sender: TObject); 50 | procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); 51 | procedure popMenuPopup(Sender: TObject); 52 | procedure AddTableName1Click(Sender: TObject); 53 | procedure AddAllFields1Click(Sender: TObject); 54 | procedure tvDblClick(Sender: TObject); 55 | procedure tvMouseDown(Sender: TObject; Button: TMouseButton; 56 | Shift: TShiftState; X, Y: Integer); 57 | procedure btnParamsClick(Sender: TObject); 58 | procedure tvCustomDraw(Sender: TObject; TreeNode: TccTreeNode; 59 | AFont: TFont; var AColor, ABkColor: TColor); 60 | procedure FormCreate(Sender: TObject); 61 | procedure FormDestroy(Sender: TObject); 62 | private 63 | FConnection: TCustomConnection; 64 | FSQL: TStrings; 65 | FTV: TccTreeView; 66 | FTable: string; 67 | FSQLDialect: integer; 68 | FQuoteFields: integer; 69 | FConnectionType: TPumpDatabaseType; 70 | FMain: TibpMain; 71 | 72 | 73 | // ccCompos 74 | tv: TccTreeView; 75 | tvParams: TccTreeView; 76 | 77 | function Init: boolean; 78 | function CheckName: boolean; 79 | procedure DeInit; 80 | procedure OnSQLChanged(Sender: TObject); 81 | public 82 | constructor Create(AOwner: TComponent); override; 83 | end; 84 | 85 | { Common } 86 | 87 | function DoSQLEditor(AMain: TibpMain; AConnection: TCustomConnection; var ASQL: string; ATV: TccTreeView): boolean; 88 | 89 | implementation 90 | 91 | {$R *.DFM} 92 | 93 | { Common } 94 | 95 | function DoSQLEditor(AMain: TibpMain; AConnection: TCustomConnection; var ASQL: string; ATV: TccTreeView): boolean; 96 | var 97 | FSQLEditor: TibpSQLEditor; 98 | i: integer; 99 | begin 100 | result := False; 101 | FSQLEditor := TibpSQLEditor.Create(AMain); 102 | try 103 | try 104 | with FSQLEditor do 105 | begin 106 | FConnection := AConnection; 107 | FTV := ATV; 108 | i := Pos(#0, ASQL); 109 | FTable := Trim(Copy(ASQL, 1, Pred(i))); 110 | eName.Text := FTable; 111 | memSQL.Lines.Text := Copy(ASQL, Succ(i), Length(ASQL)); 112 | 113 | if ATV = FMain.tvDest then 114 | begin 115 | FConnectionType := pdtIB; 116 | FSQLDialect := FMain.DestDialect; 117 | FQuoteFields := FSQLDialect; 118 | end 119 | else 120 | begin 121 | if (ATV = FMain.tvSource) or (ATV = FMain.tvSourceTr) then 122 | begin 123 | if FMain.SrcQuoteFields 124 | then FQuoteFields := FMain.SrcSelect 125 | else FQuoteFields := 0; 126 | 127 | FConnectionType := FMain.SrcType; 128 | case FConnectionType of 129 | pdtIB: 130 | begin 131 | FSQLDialect := FMain.SrcDialect; 132 | end; 133 | pdtBDE, pdtADO: 134 | begin 135 | FSQLDialect := FMain.SrcSelect; 136 | end; 137 | else 138 | raise Exception.Create(ErrSrc); 139 | end; 140 | end 141 | else 142 | begin 143 | raise Exception.Create(ErrSrc); 144 | end; 145 | end; 146 | 147 | result := Init and (ShowModal = mrOK); 148 | if result 149 | then ASQL := Trim(eName.Text) + #0 + memSQL.Lines.Text; 150 | end; 151 | finally 152 | FSQLEditor.DeInit; 153 | end; 154 | finally 155 | FSQLEditor.Free; 156 | end; 157 | end; 158 | 159 | { TibpSQLEditor } 160 | 161 | constructor TibpSQLEditor.Create(AOwner: TComponent); 162 | begin 163 | inherited; 164 | FMain := AOwner as TibpMain; 165 | 166 | // create ccCompos (avoid package) 167 | tvParams:= TccTreeView.Create(Self); 168 | with tvParams do 169 | begin 170 | Parent:= Panel5; 171 | Left:= 0; 172 | Top:= 44; 173 | Width:= 431; 174 | Height:= 153; 175 | ReadOnly:= True; 176 | HideSelection:= False; 177 | Indent:= 19; 178 | // Items.Data:= { 179 | // 0100000000010000000000000000FFFFFFFFFFFFFFFF00000000000000000600 180 | // 000000000000506172616D73}; 181 | TabOrder:= 2; 182 | TabStop:= False; 183 | Anchors:= [akLeft, akTop, akRight, akBottom]; 184 | end; 185 | tv:= TccTreeView.Create(Self); 186 | with tv do 187 | begin 188 | Parent:= Panel4; 189 | Left:= 0; 190 | Top:= 0; 191 | Width:= 156; 192 | Height:= 398; 193 | ReadOnly:= True; 194 | HideSelection:= False; 195 | Indent:= 19; 196 | Align:= alClient; 197 | TabOrder:= 0; 198 | OnMouseDown:= tvMouseDown; 199 | OnDblClick:= tvDblClick; 200 | PopupMenu:= popMenu; 201 | OnCustomDraw:= tvCustomDraw; 202 | end; 203 | end; 204 | 205 | function TibpSQLEditor.Init: boolean; 206 | var 207 | l: boolean; 208 | begin 209 | result := False; 210 | 211 | btnSave.Enabled := False; 212 | 213 | try FConnection.Open except end; 214 | 215 | if not FConnection.Connected then 216 | begin 217 | Caption := Format('%s - Not Connected!', [Caption]); 218 | if Length(Trim(eName.Text)) = 0 then 219 | begin 220 | FMain.PumpDlg('Can not create new SQL because can not connect to database!', mtError, [mbOk], 0); 221 | exit; 222 | end; 223 | end; 224 | 225 | memSQL.OnChange := OnSQLChanged; 226 | eName.OnChange := OnSQLChanged; 227 | 228 | memSQL.ReadOnly := not FConnection.Connected; 229 | btnExecute.Enabled := FConnection.Connected; 230 | eName.Enabled := FConnection.Connected; 231 | 232 | l := False; 233 | 234 | if FConnection is TIBDatabase then 235 | begin 236 | qryIB.Database := TIBDatabase(FConnection); 237 | qryIB.Transaction := TIBDatabase(FConnection).DefaultTransaction; 238 | DS.Dataset := qryIB; 239 | FSQL := qryIB.SQL; 240 | l := True; 241 | end; 242 | 243 | if FConnection is TDatabase then 244 | begin 245 | qryBDE.DatabaseName := TDatabase(FConnection).DatabaseName; 246 | DS.Dataset := qryBDE; 247 | FSQL := qryBDE.SQL; 248 | l := True; 249 | end; 250 | 251 | if FConnection is TADOConnection then 252 | begin 253 | qryADO.Connection := TADOConnection(FConnection); 254 | DS.Dataset := qryADO; 255 | FSQL := qryADO.SQL; 256 | l := True; 257 | end; 258 | 259 | if not l then 260 | begin 261 | FMain.PumpDlg(Format('Connection %s has unsupported class %s!', [FConnection.Name, FConnection.ClassName]), mtError, [mbOk], 0); 262 | exit; 263 | end; 264 | 265 | if FTV = FMain.tvDest 266 | then AssignTree(FTV, tv, True) 267 | else AssignTree(FMain.tvSource, tv, False); 268 | 269 | if FTV = FMain.tvDest 270 | then Caption := Caption + FMain.GetDestDB 271 | else Caption := Caption + FMain.GetSourceDB; 272 | 273 | DBGrid.Visible := (FTV = FMain.tvSource) or (FTV = FMain.tvSourceTr); 274 | btnExecute.Visible := DBGrid.Visible; 275 | 276 | tvParams.Visible := FTV = FMain.tvDest; 277 | btnParams.Visible := FTV = FMain.tvDest; 278 | 279 | result := True; 280 | end; 281 | 282 | procedure TibpSQLEditor.DeInit; 283 | begin 284 | memSQL.OnChange := nil; 285 | eName.OnChange := nil; 286 | DS.Dataset := nil; 287 | end; 288 | 289 | procedure TibpSQLEditor.OnSQLChanged(Sender: TObject); 290 | begin 291 | btnSave.Enabled := True; 292 | end; 293 | 294 | procedure TibpSQLEditor.btnExecuteClick(Sender: TObject); 295 | begin 296 | DS.DataSet.Close; 297 | FSQL.Assign(memSQL.Lines); 298 | DS.DataSet.Open; 299 | end; 300 | 301 | procedure TibpSQLEditor.btnParamsClick(Sender: TObject); 302 | var 303 | tmpQ: TIBQuery; 304 | i: integer; 305 | nd: TccTreeNode; 306 | begin 307 | if DS.DataSet is TIBQuery then 308 | begin 309 | tmpQ := DS.DataSet as TIBQuery; 310 | tmpQ.Close; 311 | FSQL.Assign(memSQL.Lines); 312 | try 313 | tvParams.Items.BeginUpdate; 314 | try 315 | nd := tvParams.Items.GetFirstNode; 316 | nd.DeleteChildren; 317 | nd.InfoText := '(0)'; 318 | tmpQ.Prepare; 319 | tmpQ.GenerateParamNames := True; 320 | for i := 0 to tmpQ.ParamCount-1 321 | do tvParams.Items.AddChild(nd, tmpQ.Params[i].Name); 322 | nd.InfoText := Format('(%d)', [tmpQ.ParamCount]); 323 | nd.Expand(True); 324 | finally 325 | tvParams.Items.EndUpdate; 326 | end; 327 | finally 328 | tmpQ.UnPrepare; 329 | end; 330 | end 331 | else 332 | begin 333 | raise Exception.Create(Format('Wrong class %s', [DS.ClassName])); 334 | end; 335 | end; 336 | 337 | procedure TibpSQLEditor.FormCloseQuery(Sender: TObject; 338 | var CanClose: Boolean); 339 | begin 340 | if ModalResult = mrOK then 341 | begin 342 | DoControlExit; 343 | CanClose := False; 344 | 345 | if Length(Trim(eName.Text)) = 0 then 346 | begin 347 | if eName.CanFocus 348 | then eName.SetFocus; 349 | FMain.PumpDlg('Name can not be empty!', mtError, [mbOk], 0); 350 | Exit; 351 | end; 352 | 353 | if Length(Trim(memSQL.Lines.Text)) = 0 then 354 | begin 355 | if memSQL.CanFocus 356 | then memSQL.SetFocus; 357 | FMain.PumpDlg('SQL can not be empty!', mtError, [mbOk], 0); 358 | Exit; 359 | end; 360 | 361 | if not CheckName then 362 | begin 363 | FMain.PumpDlg('Name duplicated!', mtError, [mbOk], 0); 364 | Exit; 365 | end; 366 | 367 | CanClose := True; 368 | end; 369 | end; 370 | 371 | procedure TibpSQLEditor.popMenuPopup(Sender: TObject); 372 | begin 373 | AddTableName1.Visible := (tv.Selected <> nil) and (tv.Selected.ImageIndex <= Integer(picTableLoop)); 374 | AddAllFields1.Visible := (tv.Selected <> nil) and (tv.Selected.ImageIndex <= Integer(picTableLoop)); 375 | AddFieldName1.Visible := (tv.Selected <> nil) and (tv.Selected.ImageIndex in [Integer(picSourceField), Integer(picDestField)]); 376 | end; 377 | 378 | procedure TibpSQLEditor.AddTableName1Click(Sender: TObject); 379 | var 380 | s: string; 381 | i: integer; 382 | begin 383 | if memSQL.CanFocus then 384 | begin 385 | memSQL.SetFocus; 386 | if tv.Selected.ImageIndex <= Integer(picTableLoop) 387 | then i := FSQLDialect 388 | else i := FQuoteFields; 389 | s := GetSQLName(tv.Selected.Text, FConnectionType, i); 390 | memSQL.SetSelTextBuf(PChar(Format(' %s ', [s]))); 391 | end; 392 | end; 393 | 394 | procedure TibpSQLEditor.AddAllFields1Click(Sender: TObject); 395 | var 396 | nd: TccTreeNode; 397 | s: string; 398 | begin 399 | if memSQL.CanFocus then 400 | begin 401 | s := ','; 402 | memSQL.SetFocus; 403 | nd := tv.Selected.GetFirstChild; 404 | while nd <> nil do 405 | begin 406 | memSQL.SetSelTextBuf(PChar(Format(' %s ', [GetSQLName(nd.Text, FConnectionType, FQuoteFields)]))); 407 | nd := nd.GetNextSibling; 408 | if nd <> nil 409 | then memSQL.SetSelTextBuf(PChar(s)); 410 | end; 411 | end; 412 | end; 413 | 414 | procedure TibpSQLEditor.tvDblClick(Sender: TObject); 415 | begin 416 | if tv.Selected <> nil then 417 | begin 418 | if (tv.Selected.ImageIndex <= Integer(picTableLoop)) and 419 | (GetAsyncKeyState(VK_CONTROL) < 0) then 420 | begin 421 | AddAllFields1Click(Sender); 422 | exit; 423 | end; 424 | if tv.Selected.ImageIndex in [Integer(picTableNoLinks), 425 | Integer(picTableLinks), 426 | Integer(picTableLoop), 427 | Integer(picSourceField), 428 | Integer(picDestField)] then 429 | begin 430 | AddTableName1Click(Sender); 431 | exit; 432 | end; 433 | end; 434 | end; 435 | 436 | function TibpSQLEditor.CheckName: boolean; 437 | var 438 | AName: string; 439 | nd: TccTreeNode; 440 | begin 441 | result := False; 442 | AName := UpperCase(Trim(eName.Text)); 443 | if UpperCase(FTable) <> AName then 444 | begin 445 | nd := FTV.Items.GetFirstNode; 446 | while nd <> nil do 447 | begin 448 | if UpperCase(nd.TheText) = AName 449 | then exit; 450 | nd := nd.GetNextSibling; 451 | end; 452 | end; 453 | result := True; 454 | end; 455 | 456 | procedure TibpSQLEditor.tvMouseDown(Sender: TObject; Button: TMouseButton; 457 | Shift: TShiftState; X, Y: Integer); 458 | var 459 | ANode: TccTreeNode; 460 | begin 461 | if Button = mbRight then 462 | begin 463 | ANode := TccTreeView(Sender).GetNodeAt(X,Y); 464 | if ANode <> nil 465 | then ANode.Selected := True; 466 | end; 467 | end; 468 | 469 | 470 | procedure TibpSQLEditor.tvCustomDraw(Sender: TObject; 471 | TreeNode: TccTreeNode; AFont: TFont; var AColor, ABkColor: TColor); 472 | begin 473 | if Pos(#0, TreeNode.Text) > 0 then 474 | begin 475 | AFont.Style := AFont.Style + [fsBold]; 476 | end; 477 | end; 478 | 479 | procedure TibpSQLEditor.FormCreate(Sender: TObject); 480 | begin 481 | GetWindStat(Self); 482 | end; 483 | 484 | procedure TibpSQLEditor.FormDestroy(Sender: TObject); 485 | begin 486 | SetWindStat(Self); 487 | end; 488 | 489 | end. 490 | -------------------------------------------------------------------------------- /Sources/IBDataPump/ibpUpdDefs.dfm: -------------------------------------------------------------------------------- 1 | object ibpUpdDefs: TibpUpdDefs 2 | Left = 485 3 | Top = 272 4 | Width = 450 5 | Height = 288 6 | Caption = 'Update Defenitions' 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 = poDesktopCenter 15 | Scaled = False 16 | OnCreate = FormCreate 17 | OnDestroy = FormDestroy 18 | PixelsPerInch = 96 19 | TextHeight = 13 20 | object Panel1: TPanel 21 | Left = 0 22 | Top = 215 23 | Width = 434 24 | Height = 34 25 | Align = alBottom 26 | BevelOuter = bvNone 27 | TabOrder = 1 28 | DesignSize = ( 29 | 434 30 | 34) 31 | object btnStart: TButton 32 | Left = 284 33 | Top = 6 34 | Width = 75 35 | Height = 25 36 | Anchors = [akRight, akBottom] 37 | Caption = 'Start' 38 | Default = True 39 | TabOrder = 0 40 | OnClick = btnStartClick 41 | end 42 | object btnClose: TButton 43 | Left = 364 44 | Top = 6 45 | Width = 75 46 | Height = 25 47 | Anchors = [akRight, akBottom] 48 | Cancel = True 49 | Caption = 'Close' 50 | ModalResult = 2 51 | TabOrder = 1 52 | end 53 | end 54 | object memRep: TMemo 55 | Left = 0 56 | Top = 0 57 | Width = 434 58 | Height = 215 59 | Align = alClient 60 | Color = clBtnFace 61 | ReadOnly = True 62 | TabOrder = 0 63 | WordWrap = False 64 | end 65 | end 66 | -------------------------------------------------------------------------------- /Sources/IBDataPump/ibpUpdDefs.pas: -------------------------------------------------------------------------------- 1 | { 2 | Copyright (c) 2000-2005 CleverComponents.com 3 | Product: Interbase DataPump 4 | Author: Alexandre Poloziouk 5 | Unit: ibpUpdDefs.pas 6 | } 7 | 8 | unit ibpUpdDefs; 9 | 10 | interface 11 | 12 | {$INCLUDE ccGetVer.inc} 13 | 14 | uses 15 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, 16 | ibpMain, ccTreeView; 17 | 18 | type 19 | 20 | { TRelCollectionItem } 21 | 22 | TRelCollectionItem = class(TCollectionItem) 23 | private 24 | FChk: boolean; 25 | FDest: string; 26 | FSrc: string; 27 | FDestLst: TStringList; 28 | FSrcLst: TStringList; 29 | public 30 | constructor Create(Collection: TCollection); override; 31 | destructor Destroy; override; 32 | published 33 | property Chk: boolean read FChk write FChk; 34 | property Dest: string read FDest write FDest; 35 | property Src: string read FSrc write FSrc; 36 | property DestLst: TStringList read FDestLst write FDestLst; 37 | property SrcLst: TStringList read FSrcLst write FSrcLst; 38 | end; 39 | 40 | { TibpUpdDefs } 41 | 42 | TibpUpdDefs = class(TForm) 43 | memRep: TMemo; 44 | btnStart: TButton; 45 | btnClose: TButton; 46 | Panel1: TPanel; 47 | procedure btnStartClick(Sender: TObject); 48 | procedure FormCreate(Sender: TObject); 49 | procedure FormDestroy(Sender: TObject); 50 | private 51 | FCol: TCollection; 52 | FGen: TCollection; 53 | FCustomSQL: TStringList; 54 | FCustomTrSQL: TStringList; 55 | FCustomParams: TStringList; 56 | FMain: TibpMain; 57 | 58 | procedure SaveRelations(ACol: TCollection; tvDest: TccTreeView); 59 | procedure RestoreRelations(ACol: TCollection; tvDest, tvSrc: TccTreeView; ADropProc: TDragDropEvent); 60 | procedure SaveCustomSQL(tv: TccTreeView; ACustomSQL: TStringList); 61 | public 62 | constructor Create(AOwner: TComponent); override; 63 | end; 64 | 65 | { Common } 66 | 67 | procedure DoUpdDefs(AMain: TibpMain); 68 | 69 | implementation 70 | 71 | {$R *.DFM} 72 | 73 | { Common } 74 | 75 | procedure DoUpdDefs(AMain: TibpMain); 76 | var 77 | FUpdDefs: TibpUpdDefs; 78 | begin 79 | FUpdDefs := TibpUpdDefs.Create(AMain); 80 | try 81 | FUpdDefs.ShowModal; 82 | finally 83 | FUpdDefs.Free; 84 | end; 85 | end; 86 | 87 | { TRelCollectionItem } 88 | 89 | constructor TRelCollectionItem.Create(Collection: TCollection); 90 | begin 91 | inherited; 92 | FChk := False; 93 | SetLength(FDest, 0); 94 | SetLength(FSrc, 0); 95 | FDestLst := TStringList.Create; 96 | FSrcLst := TStringList.Create; 97 | end; 98 | 99 | destructor TRelCollectionItem.Destroy; 100 | begin 101 | FDestLst.Free; 102 | FSrcLst.Free; 103 | inherited; 104 | end; 105 | 106 | { TibpUpdDefs } 107 | 108 | constructor TibpUpdDefs.Create(AOwner: TComponent); 109 | begin 110 | inherited; 111 | FMain := AOwner as TibpMain; 112 | end; 113 | 114 | procedure TibpUpdDefs.FormCreate(Sender: TObject); 115 | begin 116 | FCol := TCollection.Create(TRelCollectionItem); 117 | FGen := TCollection.Create(TRelCollectionItem); 118 | FCustomSQL := TStringList.Create; 119 | FCustomTrSQL := TStringList.Create; 120 | FCustomParams := TStringList.Create; 121 | GetWindStat(Self); 122 | end; 123 | 124 | procedure TibpUpdDefs.FormDestroy(Sender: TObject); 125 | begin 126 | FCol.Free; 127 | FGen.Free; 128 | FCustomSQL.Free; 129 | FCustomTrSQL.Free; 130 | FCustomParams.Free; 131 | SetWindStat(Self); 132 | end; 133 | 134 | procedure TibpUpdDefs.btnStartClick(Sender: TObject); 135 | begin 136 | memRep.Lines.Clear; 137 | memRep.Lines.Add('=== Start: ' + DateTimeToStr(now)); 138 | 139 | SaveRelations(FCol, FMain.tvDest); 140 | SaveRelations(FGen, FMain.tvDestTr); 141 | 142 | SaveCustomSQL(FMain.tvSource, FCustomSQL); 143 | SaveCustomSQL(FMain.tvSourceTr, FCustomTrSQL); 144 | SaveCustomSQL(FMain.tvDest, FCustomParams); 145 | 146 | FMain.btnGetDfn.Click; 147 | 148 | FMain.RestoreCustomSQLFields(FCustomSQL, FMain.tvSource); 149 | FMain.RestoreCustomSQLFields(FCustomTrSQL, FMain.tvSourceTr); 150 | FMain.RestoreCustomSQLParams(FCustomParams); 151 | 152 | RestoreRelations(FCol, FMain.tvDest, FMain.tvSource, FMain.tvDestDragDrop); 153 | RestoreRelations(FGen, FMain.tvDestTr, FMain.tvSourceTr, FMain.tvDestTrDragDrop); 154 | 155 | memRep.Lines.Add('=== Finish: ' + DateTimeToStr(now)); 156 | end; 157 | 158 | procedure TibpUpdDefs.SaveRelations(ACol: TCollection; tvDest: TccTreeView); 159 | var 160 | nd, ndc: TccTreeNode; 161 | Item: TRelCollectionItem; 162 | begin 163 | ACol.Clear; 164 | nd := tvDest.Items.GetFirstNode; 165 | while nd <> nil do 166 | begin 167 | Item := TRelCollectionItem(ACol.Add); 168 | Item.Chk := nd.Checked; 169 | Item.Dest := nd.TheText; 170 | Item.Src := nd.InfoText; 171 | ndc := FindTheNode(nd, picRelationFields); 172 | if ndc <> nil then 173 | begin 174 | ndc := ndc.GetFirstChild; 175 | while ndc <> nil do 176 | begin 177 | Item.DestLst.Add(ndc.TheText); 178 | Item.SrcLst.Add(ndc.InfoText); 179 | ndc := ndc.GetNextSibling; 180 | end; 181 | end; 182 | nd := nd.GetNextSibling; 183 | end; 184 | end; 185 | 186 | procedure TibpUpdDefs.RestoreRelations(ACol: TCollection; tvDest, tvSrc: TccTreeView; ADropProc: TDragDropEvent); 187 | var 188 | i, j: integer; 189 | nd, ndr, ndf, ndc, tmp: TccTreeNode; 190 | ns, nsc: TccTreeNode; 191 | Item: TRelCollectionItem; 192 | lTbl: boolean; 193 | begin 194 | tvDest.Items.BeginUpdate; 195 | tvSrc.Items.BeginUpdate; 196 | try 197 | for i := 0 to ACol.Count-1 do 198 | begin 199 | Item := TRelCollectionItem(ACol.Items[i]); 200 | lTbl := False; 201 | nd := tvDest.Items.GetFirstNode; 202 | while nd <> nil do 203 | begin 204 | if nd.TheText = Item.Dest then 205 | begin 206 | lTbl := True; 207 | nd.Checked := Item.Chk; 208 | if IsConst(Item.Src) then 209 | begin 210 | nd.InfoText := Item.Src; 211 | end 212 | else 213 | begin 214 | if Length(Trim(Item.Src)) > 0 then 215 | begin 216 | ns := FindSourceTable(tvSrc, Item.Src); 217 | if ns <> nil then 218 | begin 219 | ndr := FindTheNode(nd, picRelationFields); 220 | ndf := FindTheNode(nd, picDestFields); 221 | if (ndr <> nil) or (ndf <> nil) then 222 | begin 223 | MakeTableLink(nd, ns, False); 224 | for j := 0 to Item.DestLst.Count-1 do 225 | begin 226 | if IsConst(Item.SrcLst[j]) then 227 | begin 228 | tmp := tvDest.Items.AddChild(ndr, Item.DestLst[j]); 229 | tmp.InfoText := Item.SrcLst[j]; 230 | tmp.ImageIndex := Integer(picRelationField); 231 | tmp.SelectedIndex := tmp.ImageIndex; 232 | tmp.StateIndex := -1; 233 | UpdateStatus(ndr.Parent); 234 | UpdateFieldsStatus(ndr.Parent); 235 | end 236 | else 237 | begin 238 | ndc := FindSourceField(ndf, Item.DestLst[j]); 239 | if ndc <> nil then 240 | begin 241 | nsc := FindSourceField(ns, Item.SrcLst[j]); 242 | if nsc <> nil then 243 | begin 244 | ndc.MakeVisible; 245 | nsc.MakeVisible; 246 | tvSrc.Selected := nsc; 247 | ADropProc(tvDest, tvSrc, ndc.DisplayRect(True).Left, ndc.DisplayRect(True).Top); 248 | end 249 | else 250 | begin 251 | memRep.Lines.Add(Format('Can not find SourceField: %s from SourceTable %s for DestField: %s from DestTable: %s', 252 | [Item.SrcLst[j], Item.Src, Item.DestLst[j], Item.Dest])); 253 | end; 254 | end 255 | else 256 | begin 257 | memRep.Lines.Add(Format('Can not find DestField: %s for DestTable: %s', [Item.DestLst[j], Item.Dest])); 258 | end; 259 | end; 260 | end; 261 | end 262 | else 263 | begin 264 | nd.InfoText := ns.TheText; 265 | ns.Data := Pointer(Integer(ns.Data) + 1); 266 | end; 267 | end 268 | else 269 | begin 270 | memRep.Lines.Add(Format('Can not find Source: %s for Destination: %s', [Item.Src, Item.Dest])); 271 | end; 272 | end; 273 | end; 274 | break; 275 | end; 276 | nd := nd.GetNextSibling; 277 | end; 278 | if not lTbl 279 | then memRep.Lines.Add(Format('Can not find Destination: %s', [Item.Dest])); 280 | end; 281 | tvDest.FullCollapse; 282 | tvSrc.FullCollapse; 283 | finally 284 | tvDest.Items.EndUpdate; 285 | tvSrc.Items.EndUpdate; 286 | end; 287 | end; 288 | 289 | procedure TibpUpdDefs.SaveCustomSQL(tv: TccTreeView; ACustomSQL: TStringList); 290 | var 291 | nd: TccTreeNode; 292 | begin 293 | ACustomSQL.Clear; 294 | nd := tv.Items.GetFirstNode; 295 | while nd <> nil do 296 | begin 297 | if Pos(#0, nd.Text) > 0 298 | then ACustomSQL.Add(nd.Text); 299 | nd := nd.GetNextSibling; 300 | end; 301 | end; 302 | 303 | end. 304 | -------------------------------------------------------------------------------- /Sources/INSTALL.txt: -------------------------------------------------------------------------------- 1 | Copyright (c) 2000-2019 CleverComponents.com 2 | Product: Interbase DataPump 3 | Author: Alexandre Poloziouk 4 | Version: 3.5s3 5 | 6 | PLEASE _STRICTLY_ FOLLOW INSTALLATION STEPS: 7 | 8 | 1. You MUST have all latest updates for Delphi and Interbase Express Library (IBX) installed. 9 | Visit www.borland.com for more informations regarding updates. 10 | 11 | 2. Install ccIBPumpVCL 12 | ccIBPumpVCL library include TccTreeView, TccSpinEdit and TccButonEdit components. 13 | - run Delphi then open and install ccIBPumpVCL5.dpk (Delphi 5), ccIBPumpVCL6.dpk (Delphi 6) 14 | or ccIBPumpVCL7.dpk (Delphi 7) 15 | - go to Delphi Environment Options dialog and add path to ccIBPumpVCL to Library paths 16 | 17 | 3. The current version of IBPump utilizes the non-free library Clever Internet Suite for displaying the news line. 18 | This is a drawback, and we suggest the task of changing the program so that it does the same job without the non-free library. 19 | Optionally, you can disable this library by commenting the CCNEWS compiler conditional define within the ccGetVer.inc file. 20 | 21 | For compiling the IBPump with Clever Internet Suite, download and install the Clever Internet Suite library using the link below: 22 | https://www.clevercomponents.com/downloads/inetsuite/suitedownload.asp 23 | 24 | 4. Compile IBDataPump 25 | - first you need to fix some bugs in Borland ADODB.pas 26 | - copy ADODB.pas from $(DELPHI)\Source\Vcl\ to the same directory with IBPump.dpr and IBPumpPlug.dpr (IBDataPump by default) 27 | - find following code and add line to fix known problem with Required attributes 28 | 29 | { Determine if the field's property list contains an ISAUTOINCREMENT entry } 30 | procedure AddFieldDef(F: Field; FieldDefs: TFieldDefs); 31 | var 32 | FieldType: TFieldType; 33 | FieldDef: TFieldDef; 34 | I: Integer; 35 | FName: string; 36 | FSize: Integer; 37 | FPrecision: Integer; 38 | begin 39 | FieldType := ADOTypeToFieldType(F.Type_, EnableBCD); 40 | if FieldType <> ftUnknown then 41 | begin 42 | FSize := 0; 43 | FPrecision := 0; 44 | FieldDef := FieldDefs.AddFieldDef; 45 | 46 | // ****Bug Fix A. Schmidt 23.10.2001**** 47 | FieldDef.Required := (F.Attributes and adFldIsNullable)=0; 48 | - find following line: 49 | if TagVariant(IndexInfo.Fields[SOrdinalPosition].Value).ulVal > 1 then 50 | and replace it with: 51 | if IndexDefs.IndexOf(VarToStr(IndexInfo.Fields[SIndexName].Value)) <> -1 then // ****Bug Fix Troy Wolbrink 01.11.2001**** 52 | 53 | - now you can open and compile IBPump.dpr and IBPumpPlug.dpr projects 54 | 55 | Please note that all versions of Delphi 5 and Delphi 6 are supported. 56 | 57 | 5. IMPORTANT : Please remember that all Interbase DataPump forms and modules 58 | contains links to ibpDM.pas module and you will have to open ibpDM module 59 | first before compile or change anything. 60 | 61 | 6. Read END-USER LICENSE AGREEMENT (EULA.txt) before start using this software. 62 | 63 | Contributors: 64 | 65 | Claude GUTH. 14.03.2019 66 | - dynamic creation of the cc components so it compiles with a standard D7 (no need to install the components); 67 | - correction of the qryFree SQL; 68 | - the qryFree is created dynamically. Other query and IBSql could be created dynamically to clean up the dfm; 69 | - minor adjustments of layout (buttons too close from edges...). 70 | 71 | If you have any questions or concerns please contact us at https://www.clevercomponents.com/portal/ 72 | or visit www.CleverComponents.com and we will happy to help you. 73 | 74 | Sincerely yours CleverComponents Team -------------------------------------------------------------------------------- /Sources/ccIBPumpVCL/ccButtonEdit.pas: -------------------------------------------------------------------------------- 1 | { 2 | Copyright (c) 2000-2002 CleverComponents.com 3 | Product: CleverComponents Interbase DataPump VCL 4 | Author: Alexandre Poloziouk, alex@CleverComponents.com 5 | Unit: ccButtonEdit.pas 6 | Version: 1.0 7 | } 8 | 9 | unit ccButtonEdit; 10 | 11 | {$INCLUDE ccGetVer.inc} 12 | 13 | interface 14 | 15 | uses 16 | Windows, Messages, SysUtils, Classes, Controls, StdCtrls, 17 | {$IFDEF DELPHI6} 18 | Variants, 19 | {$ENDIF} 20 | Mask, comctrls, buttons, CommCtrl; 21 | 22 | type 23 | 24 | { TccButtonEdit } 25 | 26 | TccButtonEdit = class(TMaskEdit) 27 | private 28 | FButton: TSpeedButton; 29 | FOnButtonClick: TNotifyEvent; 30 | 31 | procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND; 32 | procedure WMSize(var Message: TWMSize); message WM_SIZE; 33 | procedure WMSetCursor(var Msg: TWMSetCursor); message WM_SETCURSOR; 34 | procedure CMWinIniChange(var Message: TWMWinIniChange); message CM_WININICHANGE; 35 | protected 36 | procedure ButtonClick(Sender: TObject); 37 | procedure KeyDown(var Key: Word; Shift: TShiftState); override; 38 | procedure CalcBtnSize; 39 | public 40 | constructor Create(AOwner: TComponent); override; 41 | destructor Destroy; override; 42 | procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override; 43 | published 44 | property OnButtonClick: TNotifyEvent read FOnButtonClick write FOnButtonClick; 45 | end; 46 | 47 | implementation 48 | 49 | { TccButtonEdit } 50 | 51 | constructor TccButtonEdit.Create(AOwner: TComponent); 52 | begin 53 | inherited Create(AOwner); 54 | FButton := TSpeedButton.Create(Self); 55 | FButton.Parent := Self; 56 | FButton.OnClick := ButtonClick; 57 | FButton.Caption := '...'; 58 | end; 59 | 60 | destructor TccButtonEdit.Destroy; 61 | begin 62 | FButton.Free; 63 | inherited Destroy; 64 | end; 65 | 66 | procedure TccButtonEdit.WMEraseBkgnd(var Message: TWMEraseBkgnd); 67 | var 68 | R: TRect; 69 | begin 70 | R := ClientRect; 71 | R.Right := FButton.Left; 72 | FillRect(Message.DC, R, Brush.Handle); 73 | Message.Result := 1; 74 | end; 75 | 76 | procedure TccButtonEdit.WMSize(var Message: TWMSize); 77 | begin 78 | inherited; 79 | CalcBtnSize; 80 | end; 81 | 82 | procedure TccButtonEdit.CMWinIniChange(var Message: TWMWinIniChange); 83 | begin 84 | inherited; 85 | CalcBtnSize; 86 | SetBounds(Left, Top, Width, Height); 87 | Invalidate; 88 | end; 89 | 90 | procedure TccButtonEdit.WMSetCursor(var Msg: TWMSetCursor); 91 | var 92 | P: TPoint; 93 | begin 94 | GetCursorPos(P); 95 | if PtInRect(Rect(Width - FButton.Width - 3, 0, Width, Height), ScreenToClient(P)) 96 | then Windows.SetCursor(LoadCursor(0, idc_Arrow)) 97 | else inherited; 98 | end; 99 | 100 | procedure TccButtonEdit.SetBounds(ALeft, ATop, AWidth, AHeight: Integer); 101 | begin 102 | inherited; 103 | if HandleAllocated 104 | then Self.Perform(EM_SETMARGINS, EC_RIGHTMARGIN, MakeLParam(0, FButton.Width)); 105 | end; 106 | 107 | procedure TccButtonEdit.CalcBtnSize; 108 | begin 109 | FButton.Top := 0; 110 | FButton.Height := Self.ClientHeight; 111 | FButton.Width := GetSystemMetrics(SM_CXVSCROLL) + 2; 112 | FButton.Left := Self.Width - FButton.Width - 3; 113 | end; 114 | 115 | procedure TccButtonEdit.ButtonClick(Sender: TObject); 116 | begin 117 | if Assigned(FOnButtonClick) 118 | then FOnButtonClick(Self); 119 | end; 120 | 121 | procedure TccButtonEdit.KeyDown(var Key: Word; Shift: TShiftState); 122 | begin 123 | inherited KeyDown(Key, Shift); 124 | 125 | if (Key = VK_DOWN) 126 | then ButtonClick(Self); 127 | end; 128 | 129 | end. 130 | -------------------------------------------------------------------------------- /Sources/ccIBPumpVCL/ccGetVer.inc: -------------------------------------------------------------------------------- 1 | { ccGetVer.inc } 2 | 3 | {$B-} { Complete Boolean Evaluation } 4 | {$R-} { Range-Checking } 5 | {$T-} { Typed @ operator } 6 | {$X+} { Extended syntax } 7 | {$P+} { Open string params } 8 | {$J+} { Writeable structured consts } 9 | {$H+} { Use long strings by default } 10 | {$Q-} { Overflow checking } 11 | 12 | {$IFDEF VER130} { Delphi 5.0 } 13 | {$DEFINE DELPHI5} 14 | {$ENDIF} 15 | 16 | {$IFDEF VER140} { Delphi 6.0 } 17 | {$DEFINE DELPHI5} 18 | {$DEFINE DELPHI6} 19 | {$ENDIF} 20 | 21 | {$IFDEF VER150} { Delphi 7.0 } 22 | {$DEFINE DELPHI5} 23 | {$DEFINE DELPHI6} 24 | {$DEFINE DELPHI7} 25 | {$ENDIF} -------------------------------------------------------------------------------- /Sources/ccIBPumpVCL/ccIBPumpVCL.dcr: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CleverComponents/Interbase-DataPump/b1e455a7dc356dfc0c2ff329107fc2163875146b/Sources/ccIBPumpVCL/ccIBPumpVCL.dcr -------------------------------------------------------------------------------- /Sources/ccIBPumpVCL/ccIBPumpVCL5.dpk: -------------------------------------------------------------------------------- 1 | { 2 | Copyright (c) 2000-2002 CleverComponents.com 3 | Product: CleverComponents Interbase DataPump VCL 4 | Author: Alexandre Poloziouk, alex@CleverComponents.com 5 | Unit: ccIBPumpVCL5, Delphi 5 version 6 | Version: 1.0 7 | } 8 | 9 | package ccIBPumpVCL5; 10 | 11 | {$INCLUDE ccGetVer.inc} 12 | {$R *.RES} 13 | {$R 'ccIBPumpVCL.dcr'} 14 | {$ALIGN ON} 15 | {$ASSERTIONS ON} 16 | {$BOOLEVAL OFF} 17 | {$DEBUGINFO OFF} 18 | {$EXTENDEDSYNTAX ON} 19 | {$IMPORTEDDATA ON} 20 | {$IOCHECKS ON} 21 | {$LOCALSYMBOLS ON} 22 | {$LONGSTRINGS ON} 23 | {$OPENSTRINGS ON} 24 | {$OPTIMIZATION ON} 25 | {$OVERFLOWCHECKS OFF} 26 | {$RANGECHECKS OFF} 27 | {$REFERENCEINFO ON} 28 | {$SAFEDIVIDE OFF} 29 | {$STACKFRAMES OFF} 30 | {$TYPEDADDRESS OFF} 31 | {$VARSTRINGCHECKS ON} 32 | {$WRITEABLECONST ON} 33 | {$MINENUMSIZE 1} 34 | {$IMAGEBASE $400000} 35 | {$DESCRIPTION 'CleverComponents Interbase DataPump VCL'} 36 | {$IMPLICITBUILD OFF} 37 | 38 | requires 39 | 40 | Vcl50, 41 | Vcldb50; 42 | 43 | contains 44 | ccIBPumpVCLReg in 'ccIBPumpVCLReg.pas', 45 | ccSpinEdit in 'ccSpinEdit.pas', 46 | ccButtonEdit in 'ccButtonEdit.pas', 47 | ccTreeView in 'ccTreeView.pas', 48 | ccTreeViewEditor in 'ccTreeViewEditor.pas', 49 | ccTreeViewItemsEditor in 'ccTreeViewItemsEditor.pas'; 50 | 51 | end. 52 | 53 | 54 | -------------------------------------------------------------------------------- /Sources/ccIBPumpVCL/ccIBPumpVCL5.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CleverComponents/Interbase-DataPump/b1e455a7dc356dfc0c2ff329107fc2163875146b/Sources/ccIBPumpVCL/ccIBPumpVCL5.res -------------------------------------------------------------------------------- /Sources/ccIBPumpVCL/ccIBPumpVCL6.dpk: -------------------------------------------------------------------------------- 1 | { 2 | Copyright (c) 2000-2002 CleverComponents.com 3 | Product: CleverComponents Interbase DataPump VCL 4 | Author: Alexandre Poloziouk, alex@CleverComponents.com 5 | Unit: ccIBPumpVCL6, Delphi 6 version 6 | Version: 1.0 7 | } 8 | 9 | package ccIBPumpVCL6; 10 | 11 | {$INCLUDE ccGetVer.inc} 12 | {$R *.RES} 13 | {$R 'ccIBPumpVCL.dcr'} 14 | {$ALIGN ON} 15 | {$ASSERTIONS ON} 16 | {$BOOLEVAL OFF} 17 | {$DEBUGINFO OFF} 18 | {$EXTENDEDSYNTAX ON} 19 | {$IMPORTEDDATA ON} 20 | {$IOCHECKS ON} 21 | {$LOCALSYMBOLS ON} 22 | {$LONGSTRINGS ON} 23 | {$OPENSTRINGS ON} 24 | {$OPTIMIZATION ON} 25 | {$OVERFLOWCHECKS OFF} 26 | {$RANGECHECKS OFF} 27 | {$REFERENCEINFO ON} 28 | {$SAFEDIVIDE OFF} 29 | {$STACKFRAMES OFF} 30 | {$TYPEDADDRESS OFF} 31 | {$VARSTRINGCHECKS ON} 32 | {$WRITEABLECONST ON} 33 | {$MINENUMSIZE 1} 34 | {$IMAGEBASE $400000} 35 | {$DESCRIPTION 'CleverComponents Interbase DataPump VCL'} 36 | {$IMPLICITBUILD OFF} 37 | 38 | requires 39 | 40 | Vcl, 41 | Vcldb, 42 | designide; 43 | 44 | contains 45 | ccIBPumpVCLReg in 'ccIBPumpVCLReg.pas', 46 | ccSpinEdit in 'ccSpinEdit.pas', 47 | ccTreeView in 'ccTreeView.pas', 48 | ccTreeViewEditor in 'ccTreeViewEditor.pas', 49 | ccTreeViewItemsEditor in 'ccTreeViewItemsEditor.pas'; 50 | 51 | end. 52 | 53 | 54 | -------------------------------------------------------------------------------- /Sources/ccIBPumpVCL/ccIBPumpVCL6.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CleverComponents/Interbase-DataPump/b1e455a7dc356dfc0c2ff329107fc2163875146b/Sources/ccIBPumpVCL/ccIBPumpVCL6.res -------------------------------------------------------------------------------- /Sources/ccIBPumpVCL/ccIBPumpVCL7.dpk: -------------------------------------------------------------------------------- 1 | { 2 | Copyright (c) 2000-2002 CleverComponents.com 3 | Product: CleverComponents Interbase DataPump VCL 4 | Author: Alexandre Poloziouk, alex@CleverComponents.com 5 | Unit: ccIBPumpVCL7, Delphi 7 version 6 | Version: 1.0 7 | } 8 | 9 | package ccIBPumpVCL7; 10 | 11 | {$INCLUDE ccGetVer.inc} 12 | {$R *.RES} 13 | {$R 'ccIBPumpVCL.dcr'} 14 | {$ALIGN ON} 15 | {$ASSERTIONS ON} 16 | {$BOOLEVAL OFF} 17 | {$DEBUGINFO OFF} 18 | {$EXTENDEDSYNTAX ON} 19 | {$IMPORTEDDATA ON} 20 | {$IOCHECKS ON} 21 | {$LOCALSYMBOLS ON} 22 | {$LONGSTRINGS ON} 23 | {$OPENSTRINGS ON} 24 | {$OPTIMIZATION ON} 25 | {$OVERFLOWCHECKS OFF} 26 | {$RANGECHECKS OFF} 27 | {$REFERENCEINFO ON} 28 | {$SAFEDIVIDE OFF} 29 | {$STACKFRAMES OFF} 30 | {$TYPEDADDRESS OFF} 31 | {$VARSTRINGCHECKS ON} 32 | {$WRITEABLECONST ON} 33 | {$MINENUMSIZE 1} 34 | {$IMAGEBASE $400000} 35 | {$DESCRIPTION 'CleverComponents Interbase DataPump VCL'} 36 | {$IMPLICITBUILD OFF} 37 | 38 | requires 39 | 40 | Vcl, 41 | Vcldb, 42 | designide; 43 | 44 | contains 45 | ccIBPumpVCLReg in 'ccIBPumpVCLReg.pas', 46 | ccSpinEdit in 'ccSpinEdit.pas', 47 | ccTreeView in 'ccTreeView.pas', 48 | ccTreeViewEditor in 'ccTreeViewEditor.pas', 49 | ccTreeViewItemsEditor in 'ccTreeViewItemsEditor.pas'; 50 | 51 | end. 52 | 53 | 54 | -------------------------------------------------------------------------------- /Sources/ccIBPumpVCL/ccIBPumpVCL7.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/CleverComponents/Interbase-DataPump/b1e455a7dc356dfc0c2ff329107fc2163875146b/Sources/ccIBPumpVCL/ccIBPumpVCL7.res -------------------------------------------------------------------------------- /Sources/ccIBPumpVCL/ccIBPumpVCLReg.pas: -------------------------------------------------------------------------------- 1 | { 2 | Copyright (c) 2000-2002 CleverComponents.com 3 | Product: CleverComponents Interbase DataPump VCL 4 | Author: Alexandre Poloziouk, alex@CleverComponents.com 5 | Unit: ccIBPumpVCLReg.pas 6 | Version: 1.0 7 | } 8 | 9 | unit ccIBPumpVCLReg; 10 | 11 | {$INCLUDE ccGetVer.inc} 12 | 13 | interface 14 | 15 | uses 16 | Classes, 17 | {$IFDEF DELPHI6} 18 | DesignIntf, 19 | {$ELSE} 20 | DsgnIntf, 21 | {$ENDIF} 22 | ccTreeView, ccTreeViewEditor, ccSpinEdit, ccButtonEdit; 23 | 24 | procedure Register; 25 | 26 | implementation 27 | 28 | const 29 | ALibName = 'ccIBDataPump'; 30 | 31 | procedure Register; 32 | begin 33 | RegisterComponents(ALibName, [TccSpinEdit]); 34 | RegisterComponents(ALibName, [TccButtonEdit]); 35 | RegisterComponents(ALibName, [TccTreeView]); 36 | RegisterPropertyEditor(TypeInfo(TccTreeNodes), TccTreeView, 'Items', TccTreeViewParams); 37 | end; 38 | 39 | end. 40 | -------------------------------------------------------------------------------- /Sources/ccIBPumpVCL/ccSpinEdit.pas: -------------------------------------------------------------------------------- 1 | { 2 | Copyright (c) 2000-2002 CleverComponents.com 3 | Product: CleverComponents Interbase DataPump VCL 4 | Author: Alexandre Poloziouk, alex@CleverComponents.com 5 | Unit: ccSpinEdit.pas 6 | Version: 1.0 7 | } 8 | 9 | unit ccSpinEdit; 10 | 11 | {$INCLUDE ccGetVer.inc} 12 | 13 | interface 14 | 15 | uses 16 | Windows, Messages, SysUtils, Classes, Graphics, Controls, StdCtrls, 17 | {$IFDEF DELPHI6} 18 | Variants, 19 | {$ENDIF} 20 | Mask, DBCtrls, comctrls, db, buttons, CommCtrl, ToolWin, extctrls, menus, clipbrd; 21 | 22 | type 23 | 24 | { TccSpinSpeedButton } 25 | 26 | TccSpinSpeedButton = class(TSpeedButton) 27 | private 28 | FRepeatTimer: TTimer; 29 | FUp: boolean; 30 | 31 | procedure TimerExpired(Sender: TObject); 32 | protected 33 | procedure MouseDown(Button: TMouseButton; Shift: TShiftState; 34 | X, Y: Integer); override; 35 | procedure MouseUp(Button: TMouseButton; Shift: TShiftState; 36 | X, Y: Integer); override; 37 | procedure Paint; override; 38 | procedure PaintEnd(lEn: integer); 39 | public 40 | constructor Create(AOwner: TComponent; Up: boolean); reintroduce; 41 | destructor Destroy; override; 42 | end; 43 | 44 | { TccSpinFieldDataLink } 45 | 46 | TccSpinFieldDataLink = class(TDataLink) 47 | private 48 | FField: TField; 49 | FFieldName: string; 50 | FControl: TComponent; 51 | FEditing: Boolean; 52 | FModified: Boolean; 53 | FOnDataChange: TNotifyEvent; 54 | FOnUpdateData: TNotifyEvent; 55 | FOnActiveChange: TNotifyEvent; 56 | FOnEditingChange: TNotifyEvent; 57 | 58 | function GetCanModify: Boolean; 59 | procedure SetEditing(Value: Boolean); 60 | procedure SetField(Value: TField); 61 | procedure SetFieldName(const Value: string); 62 | procedure UpdateField; 63 | protected 64 | procedure EditingChanged; override; 65 | procedure ActiveChanged; override; 66 | procedure FocusControl(Field: TFieldRef); override; 67 | procedure LayoutChanged; override; 68 | procedure RecordChanged(Field: TField); override; 69 | procedure UpdateData; override; 70 | public 71 | function Edit: Boolean; 72 | procedure Modified; 73 | procedure Reset; 74 | property CanModify: Boolean read GetCanModify; 75 | property Control: TComponent read FControl write FControl; 76 | property Editing: Boolean read FEditing; 77 | property Field: TField read FField; 78 | property FieldName: string read FFieldName write SetFieldName; 79 | property OnDataChange: TNotifyEvent read FOnDataChange write FOnDataChange; 80 | property OnEditingChange: TNotifyEvent read FOnEditingChange write FOnEditingChange; 81 | property OnUpdateData: TNotifyEvent read FOnUpdateData write FOnUpdateData; 82 | property OnActiveChange: TNotifyEvent read FOnActiveChange write FOnActiveChange; 83 | end; 84 | 85 | { TccSpinEdit } 86 | 87 | TccSpinEditValueType = (vtInteger, vtFloat); 88 | 89 | TccSpinEdit = class(TCustomMaskEdit) 90 | private 91 | FDataLink: TccSpinFieldDataLink; 92 | FAlignment: TAlignment; 93 | FFocused: Boolean; 94 | FUpButton: TccSpinSpeedButton; 95 | FDownButton: TccSpinSpeedButton; 96 | FIncNow: boolean; 97 | FAllowEmptyText: boolean; 98 | FLeftPrefix: string; 99 | FRightPrefix: string; 100 | FIncrement: double; 101 | FMin: double; 102 | FMax: double; 103 | FValue: Variant; 104 | FValueType: TccSpinEditValueType; 105 | 106 | procedure SetLeftPrefix(Value: string); 107 | procedure SetRightPrefix(Value: string); 108 | procedure SetAlignment(Value: TAlignment); 109 | 110 | procedure BtnMouseUp(Sender: TObject); 111 | procedure BtnMouseDown(Sender: TObject); 112 | 113 | procedure DataChange(Sender: TObject); 114 | procedure EditingChange(Sender: TObject); 115 | function GetDataField: string; 116 | function GetDataSource: TDataSource; 117 | function GetField: TField; 118 | function GetReadOnly: Boolean; 119 | procedure SetDataField(const Value: string); 120 | procedure SetDataSource(Value: TDataSource); 121 | procedure SetFocused(Value: Boolean); 122 | procedure SetReadOnly(Value: Boolean); 123 | procedure UpdateData(Sender: TObject); 124 | procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND; 125 | procedure WMCut(var Message: TMessage); message WM_CUT; 126 | procedure WMPaste(var Message: TMessage); message WM_PASTE; 127 | procedure CMEnter(var Message: TCMEnter); message CM_ENTER; 128 | procedure CMExit(var Message: TCMExit); message CM_EXIT; 129 | procedure WMSize(var Message: TWMSize); message WM_SIZE; 130 | procedure WMSetCursor(var Msg: TWMSetCursor); message WM_SETCURSOR; 131 | procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK; 132 | function IsValidChar(Key: Char): boolean; 133 | procedure CMWinIniChange(var Message: TWMWinIniChange); message CM_WININICHANGE; 134 | protected 135 | function GetEnabled: Boolean; reintroduce; 136 | procedure SetEnabled(Value: Boolean); reintroduce; 137 | procedure Change; override; 138 | function EditCanModify: Boolean; override; 139 | procedure KeyDown(var Key: Word; Shift: TShiftState); override; 140 | procedure KeyPress(var Key: Char); override; 141 | procedure Loaded; override; 142 | procedure Notification(AComponent: TComponent; Operation: TOperation); override; 143 | procedure Reset; override; 144 | procedure SetValue(AValue: Variant); 145 | function GetValue: Variant; 146 | procedure SetValueType(Value: TccSpinEditValueType); 147 | procedure CalcBtnSize; 148 | public 149 | constructor Create(AOwner: TComponent); override; 150 | destructor Destroy; override; 151 | procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override; 152 | 153 | property Field: TField read GetField; 154 | property Value: Variant read GetValue write SetValue; 155 | published 156 | property AutoSelect; 157 | property AutoSize; 158 | property Anchors; 159 | property BorderStyle; 160 | property CharCase; 161 | property Color; 162 | property Ctl3D; 163 | property DataField: string read GetDataField write SetDataField; 164 | property DataSource: TDataSource read GetDataSource write SetDataSource; 165 | property DragCursor; 166 | property DragMode; 167 | property Font; 168 | property ImeMode; 169 | property ImeName; 170 | property MaxLength; 171 | property ParentColor; 172 | property ParentCtl3D; 173 | property ParentFont; 174 | property ParentShowHint; 175 | property PasswordChar; 176 | property PopupMenu; 177 | property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False; 178 | property ShowHint; 179 | property TabOrder; 180 | property TabStop; 181 | property Visible; 182 | property OnChange; 183 | property OnClick; 184 | property OnDblClick; 185 | property OnDragDrop; 186 | property OnDragOver; 187 | property OnEndDrag; 188 | property OnEnter; 189 | property OnExit; 190 | property OnKeyDown; 191 | property OnKeyPress; 192 | property OnKeyUp; 193 | property OnMouseDown; 194 | property OnMouseMove; 195 | property OnMouseUp; 196 | property OnStartDrag; 197 | property PrefixLeft : string read FLeftPrefix write SetLeftPrefix; 198 | property PrefixRight : string read FRightPrefix write SetRightPrefix; 199 | property Alignment: TAlignment read FAlignment write SetAlignment; 200 | property Increment: double read FIncrement write FIncrement; 201 | property Min: double read FMin write FMin; 202 | property Max: double read FMax write FMax; 203 | property Enabled: Boolean read GetEnabled write SetEnabled; 204 | property AllowEmptyText: boolean read FAllowEmptyText write FAllowEmptyText default true; 205 | property ValueType: TccSpinEditValueType read FValueType write SetValueType default vtInteger; 206 | end; 207 | 208 | implementation 209 | 210 | type 211 | TccSpinCharsSet = set of char; 212 | 213 | var 214 | sDec: String; 215 | sEditArr: TccSpinCharsSet; 216 | 217 | { Common } 218 | 219 | procedure ResetMaxLength(DBEdit: TccSpinEdit); 220 | var 221 | F: TField; 222 | begin 223 | with DBEdit do 224 | if (MaxLength > 0) and Assigned(DataSource) and Assigned(DataSource.DataSet) then 225 | begin 226 | F := DataSource.DataSet.FindField(DataField); 227 | if Assigned(F) and (F.DataType = ftString) and (F.Size = MaxLength) 228 | then MaxLength := 0; 229 | end; 230 | end; 231 | 232 | { TccSpinEdit } 233 | 234 | procedure TccSpinEdit.WMEraseBkgnd(var Message: TWMEraseBkgnd); 235 | var 236 | R: TRect; 237 | begin 238 | R := ClientRect; 239 | R.Right := FUpButton.Left; 240 | FillRect(Message.DC, R, Brush.Handle); 241 | Message.Result := 1; 242 | end; 243 | 244 | procedure TccSpinEdit.SetBounds(ALeft, ATop, AWidth, AHeight: Integer); 245 | begin 246 | inherited; 247 | if HandleAllocated 248 | then Self.Perform(EM_SETMARGINS, EC_RIGHTMARGIN, MakeLParam(0, FUpButton.Width)); 249 | end; 250 | 251 | procedure TccSpinEdit.CalcBtnSize; 252 | begin 253 | FUpButton.Top := 0; 254 | FUpButton.Height := Round((self.Height - 3) / 2); 255 | FUpButton.Width := GetSystemMetrics(SM_CXVSCROLL) + 2; 256 | FUpButton.Left := self.Width - FUpButton.Width - 3; 257 | 258 | FDownButton.Top := self.Height - FUpButton.Height - 3; 259 | FDownButton.Height := FUpButton.Height; 260 | FDownButton.Width := FUpButton.Width; 261 | FDownButton.Left := FUpButton.Left; 262 | end; 263 | 264 | procedure TccSpinEdit.WMSize(var Message: TWMSize); 265 | begin 266 | inherited; 267 | CalcBtnSize; 268 | end; 269 | 270 | procedure TccSpinEdit.CMWinIniChange(var Message: TWMWinIniChange); 271 | begin 272 | inherited; 273 | CalcBtnSize; 274 | SetBounds(Left, Top, Width, Height); 275 | Invalidate; 276 | end; 277 | 278 | 279 | procedure TccSpinEdit.WMSetCursor(var Msg: TWMSetCursor); 280 | var 281 | P: TPoint; 282 | begin 283 | GetCursorPos(P); 284 | if PtInRect(Rect(Width - FUpButton.Width - 3, 0, Width, Height), ScreenToClient(P)) 285 | then Windows.SetCursor(LoadCursor(0, idc_Arrow)) 286 | else inherited; 287 | end; 288 | 289 | constructor TccSpinEdit.Create(AOwner: TComponent); 290 | begin 291 | inherited Create(AOwner); 292 | FUpButton := TccSpinSpeedButton.Create(self,true); 293 | FUpButton.Parent := self; 294 | FUpButton.OnClick := BtnMouseUp; 295 | inherited ReadOnly := False; 296 | ControlStyle := ControlStyle + [csReplicatable]; 297 | FDataLink := TccSpinFieldDataLink.Create; 298 | FDataLink.Control := Self; 299 | FDataLink.OnEditingChange := EditingChange; 300 | FDataLink.OnUpdateData := UpdateData; 301 | FDataLink.OnDataChange := DataChange; 302 | 303 | FDownButton := TccSpinSpeedButton.Create(self,false); 304 | FDownButton.Parent := self; 305 | FDownButton.OnClick := BtnMouseDown; 306 | 307 | FIncrement := 1; 308 | FMin := 0; 309 | FMax := MaxInt; 310 | FAllowEmptyText := true; 311 | FValue := 0; 312 | FValueType := vtInteger; 313 | end; 314 | 315 | destructor TccSpinEdit.Destroy; 316 | begin 317 | FDataLink.Free; 318 | FDataLink := nil; 319 | FUpButton.Free; 320 | FDownButton.Free; 321 | inherited Destroy; 322 | end; 323 | 324 | procedure TccSpinEdit.Loaded; 325 | begin 326 | inherited Loaded; 327 | ResetMaxLength(Self); 328 | if (csDesigning in ComponentState) 329 | then DataChange(Self); 330 | end; 331 | 332 | procedure TccSpinEdit.Notification(AComponent: TComponent; Operation: TOperation); 333 | begin 334 | inherited Notification(AComponent, Operation); 335 | if (Operation = opRemove) and (FDataLink <> nil) and 336 | (AComponent = DataSource) 337 | then DataSource := nil; 338 | end; 339 | 340 | procedure TccSpinEdit.KeyDown(var Key: Word; Shift: TShiftState); 341 | begin 342 | inherited KeyDown(Key, Shift); 343 | FIncNow := false; 344 | 345 | if (Key = VK_DELETE) or ((Key = VK_INSERT) and (ssShift in Shift)) 346 | then FDataLink.Edit; 347 | 348 | if (Key = VK_UP) then 349 | begin 350 | FIncNow := true; 351 | BtnMouseUp(self); 352 | end; 353 | 354 | if (Key = VK_DOWN) then 355 | begin 356 | FIncNow := true; 357 | BtnMouseDown(self); 358 | end; 359 | 360 | FIncNow := false; 361 | end; 362 | 363 | procedure TccSpinEdit.KeyPress(var Key: Char); 364 | begin 365 | inherited KeyPress(Key); 366 | 367 | if (Key in [#32..#255]) and (not IsValidChar(Key)) then 368 | begin 369 | MessageBeep(0); 370 | Key := #0; 371 | exit; 372 | end; 373 | 374 | case Key of 375 | ^H, ^V, ^X, #32..#255: 376 | begin 377 | if Field <> nil 378 | then FDataLink.Edit; 379 | end; 380 | #27: 381 | begin 382 | if Field <> nil 383 | then FDataLink.Reset; 384 | SelectAll; 385 | Key := #0; 386 | end; 387 | #13: 388 | begin 389 | Key := #0; 390 | end; 391 | end; 392 | end; 393 | 394 | function TccSpinEdit.EditCanModify: Boolean; 395 | begin 396 | Result := FDataLink.Edit; 397 | end; 398 | 399 | procedure TccSpinEdit.Reset; 400 | begin 401 | if Field <> nil 402 | then FDataLink.Reset; 403 | SelectAll; 404 | end; 405 | 406 | procedure TccSpinEdit.SetFocused(Value: Boolean); 407 | begin 408 | if FFocused <> Value then 409 | begin 410 | FFocused := Value; 411 | if (FAlignment <> taLeftJustify) and (not IsMasked) 412 | then Invalidate; 413 | 414 | if Field <> nil 415 | then FDataLink.Reset; 416 | end; 417 | end; 418 | 419 | procedure TccSpinEdit.Change; 420 | begin 421 | if csLoading in ComponentState 422 | then exit; 423 | 424 | if Field <> nil 425 | then FDataLink.Modified; 426 | inherited Change; 427 | end; 428 | 429 | function TccSpinEdit.GetDataSource: TDataSource; 430 | begin 431 | Result := FDataLink.DataSource; 432 | end; 433 | 434 | procedure TccSpinEdit.SetDataSource(Value: TDataSource); 435 | begin 436 | FDataLink.DataSource := Value; 437 | if Value <> nil 438 | then Value.FreeNotification(Self); 439 | end; 440 | 441 | function TccSpinEdit.GetDataField: string; 442 | begin 443 | Result := FDataLink.FieldName; 444 | end; 445 | 446 | procedure TccSpinEdit.SetDataField(const Value: string); 447 | begin 448 | if not (csDesigning in ComponentState) 449 | then ResetMaxLength(Self); 450 | FDataLink.FieldName := Value; 451 | end; 452 | 453 | function TccSpinEdit.GetReadOnly: Boolean; 454 | begin 455 | Result := inherited ReadOnly; 456 | if Field <> nil 457 | then Result := Result or FDataLink.ReadOnly or (not FDataLink.CanModify); 458 | end; 459 | 460 | procedure TccSpinEdit.SetReadOnly(Value: Boolean); 461 | begin 462 | inherited ReadOnly := Value; 463 | end; 464 | 465 | function TccSpinEdit.GetField: TField; 466 | begin 467 | Result := FDataLink.Field; 468 | end; 469 | 470 | procedure TccSpinEdit.SetLeftPrefix(Value: string); 471 | begin 472 | FLeftPrefix := Value; 473 | DataChange(Self); 474 | end; 475 | 476 | procedure TccSpinEdit.SetRightPrefix(Value: string); 477 | begin 478 | FRightPrefix := Value; 479 | DataChange(Self); 480 | end; 481 | 482 | procedure TccSpinEdit.SetAlignment(Value: TAlignment); 483 | begin 484 | FAlignment := Value; 485 | DataChange(Self); 486 | Repaint; 487 | end; 488 | 489 | procedure TccSpinEdit.BtnMouseUp(Sender: TObject); 490 | var 491 | Cur, New: Double; 492 | begin 493 | Cur := 0; 494 | 495 | if Assigned(OnClick) 496 | then OnClick(Sender); 497 | 498 | if not FFocused 499 | then SetFocus; 500 | 501 | if (Field <> nil) and (not EditCanModify) 502 | then exit; 503 | 504 | if ReadOnly 505 | then exit; 506 | 507 | if Trim(Text) <> '' 508 | then Cur := StrToFloat(Text); 509 | 510 | if FMin = FMax then 511 | begin 512 | New := Cur + FIncrement 513 | end 514 | else 515 | begin 516 | if Cur < FMin 517 | then New := FMin 518 | else 519 | if FMax >= Cur + FIncrement 520 | then New := Cur + FIncrement 521 | else New := FMax; 522 | end; 523 | 524 | if (New <> Cur) and (Field <> nil) then 525 | begin 526 | if EditCanModify 527 | then Field.AsFloat := New; 528 | end 529 | else Value := VarAsType(New, varDouble); 530 | 531 | if not FIncNow 532 | then SelectAll; 533 | end; 534 | 535 | procedure TccSpinEdit.BtnMouseDown(Sender: TObject); 536 | var 537 | Cur, New: Double; 538 | l: boolean; 539 | begin 540 | Cur := 0; 541 | 542 | if Assigned(OnClick) 543 | then OnClick(Sender); 544 | 545 | if not FFocused 546 | then SetFocus; 547 | 548 | if (Field <> nil) and (not EditCanModify) 549 | then exit; 550 | 551 | if ReadOnly 552 | then exit; 553 | 554 | if Trim(Text) <> '' then 555 | begin 556 | Cur := StrToFloat(Text); 557 | l := False; 558 | end 559 | else 560 | begin 561 | l := True 562 | end; 563 | 564 | if FMin = FMax then 565 | begin 566 | New := Cur - FIncrement 567 | end 568 | else 569 | begin 570 | if Cur > FMax 571 | then New := FMax 572 | else 573 | if FMin <= Cur - FIncrement 574 | then New := Cur - FIncrement 575 | else New := FMin; 576 | end; 577 | 578 | if ((New <> Cur) or l) and (Field <> nil) then 579 | begin 580 | if EditCanModify 581 | then Field.AsFloat := New; 582 | end 583 | else Value := VarAsType(New, varDouble); 584 | 585 | if not FIncNow 586 | then SelectAll; 587 | end; 588 | 589 | procedure TccSpinEdit.DataChange(Sender: TObject); 590 | begin 591 | if Field <> nil then 592 | begin 593 | EditMask := Field.EditMask; 594 | if not (csDesigning in ComponentState) then 595 | begin 596 | if (Field.DataType = ftString) and (MaxLength = 0) 597 | then MaxLength := Field.Size; 598 | end; 599 | 600 | if FFocused and FDataLink.CanModify 601 | then Text := VarToStr(Field.Value) 602 | else 603 | begin 604 | if Field.DisplayText <> '' 605 | then EditText := PrefixLeft + Field.DisplayText + PrefixRight 606 | else EditText := ''; 607 | 608 | if FDataLink.Editing and FDataLink.FModified 609 | then Modified := True; 610 | end; 611 | end 612 | else 613 | begin 614 | EditMask := ''; 615 | if csDesigning in ComponentState 616 | then EditText := Name 617 | else 618 | begin 619 | if FValue = NULL 620 | then EditText := '' 621 | else 622 | if FFocused 623 | then EditText := FloatToStr(FValue) 624 | else EditText := PrefixLeft + FloatToStr(FValue) + PrefixRight; 625 | end; 626 | end; 627 | end; 628 | 629 | procedure TccSpinEdit.EditingChange(Sender: TObject); 630 | begin 631 | end; 632 | 633 | procedure TccSpinEdit.UpdateData(Sender: TObject); 634 | begin 635 | ValidateEdit; 636 | try 637 | if (FMin <> FMax) then 638 | begin 639 | if StrToFloat(Text) < FMin 640 | then Text := FloatToStr(FMin); 641 | if StrToFloat(Text) > FMax 642 | then Text := FloatToStr(FMax); 643 | end; 644 | except 645 | on E: Exception do 646 | begin 647 | E.Message := 'Wrong format!'; 648 | if not ((Text = '') and FAllowEmptyText) 649 | then Text := FloatToStr(FMin); 650 | end; 651 | end; 652 | Field.AsString := Text; 653 | end; 654 | 655 | procedure TccSpinEdit.WMPaste(var Message: TMessage); 656 | begin 657 | if Field <> nil 658 | then FDataLink.Edit; 659 | inherited; 660 | end; 661 | 662 | procedure TccSpinEdit.WMCut(var Message: TMessage); 663 | begin 664 | if Field <> nil 665 | then FDataLink.Edit; 666 | inherited; 667 | end; 668 | 669 | procedure TccSpinEdit.CMEnter(var Message: TCMEnter); 670 | begin 671 | SetFocused(True); 672 | inherited; 673 | if Field = nil 674 | then DataChange(nil); 675 | end; 676 | 677 | function TccSpinEdit.GetValue: Variant; 678 | begin 679 | if Field <> nil then 680 | begin 681 | FDataLink.UpdateRecord; 682 | result := Field.AsVariant; 683 | end 684 | else 685 | begin 686 | if FFocused then 687 | begin 688 | try 689 | FValue := VarAsType(StrToFloat(Text), varDouble); 690 | if (FMin <> FMax) then 691 | begin 692 | if StrToFloat(Text) < FMin 693 | then FValue := VarAsType(FMin, varDouble); 694 | if StrToFloat(Text) > FMax 695 | then FValue := VarAsType(FMax, varDouble); 696 | end; 697 | except 698 | on E: Exception do 699 | begin 700 | E.Message := 'Wrong format!'; 701 | if not ((Text = '') and FAllowEmptyText) 702 | then FValue := VarAsType(FMin, varDouble) 703 | else FValue := NULL; 704 | end; 705 | end; 706 | end; 707 | result := FValue; 708 | Value := FValue; 709 | end; 710 | end; 711 | 712 | procedure TccSpinEdit.CMExit(var Message: TCMExit); 713 | begin 714 | try 715 | if Field <> nil 716 | then FDataLink.UpdateRecord 717 | else 718 | begin 719 | try 720 | FValue := VarAsType(StrToFloat(Text), varDouble); 721 | if (FMin <> FMax) then 722 | begin 723 | if StrToFloat(Text) < FMin 724 | then FValue := VarAsType(FMin, varDouble); 725 | if StrToFloat(Text) > FMax 726 | then FValue := VarAsType(FMax, varDouble); 727 | end; 728 | except 729 | on E: Exception do 730 | begin 731 | E.Message := 'Wrong format!'; 732 | if not ((Text = '') and FAllowEmptyText) 733 | then FValue := VarAsType(FMin, varDouble) 734 | else FValue := NULL; 735 | end; 736 | end; 737 | Value := FValue; 738 | end; 739 | except 740 | SelectAll; 741 | SetFocus; 742 | raise; 743 | end; 744 | SetFocused(False); 745 | CheckCursor; 746 | DoExit; 747 | end; 748 | 749 | procedure TccSpinEdit.CMGetDataLink(var Message: TMessage); 750 | begin 751 | Message.Result := Integer(FDataLink); 752 | end; 753 | 754 | function TccSpinEdit.GetEnabled: Boolean; 755 | begin 756 | result := inherited Enabled; 757 | end; 758 | 759 | procedure TccSpinEdit.SetEnabled(Value: Boolean); 760 | begin 761 | inherited Enabled := Value; 762 | FUpButton.Enabled := Value; 763 | FDownButton.Enabled := Value; 764 | end; 765 | 766 | procedure TccSpinEdit.SetValue(AValue: Variant); 767 | begin 768 | FValue := AValue; 769 | if FValue = NULL 770 | then Text := '' 771 | else 772 | if FFocused 773 | then Text := FValue 774 | else Text := PrefixLeft + FloatToStr(FValue) + PrefixRight; 775 | end; 776 | 777 | procedure TccSpinEdit.SetValueType(Value: TccSpinEditValueType); 778 | begin 779 | FValueType := Value; 780 | if FValueType = vtInteger then 781 | begin 782 | FValue := VarAsType(0, varInteger); 783 | FValue := VarAsType(FValue, varInteger); 784 | end 785 | else 786 | begin 787 | FValue := VarAsType(0, varDouble); 788 | FValue := VarAsType(FValue, varDouble); 789 | end; 790 | end; 791 | 792 | function TccSpinEdit.IsValidChar(Key: Char): boolean; 793 | begin 794 | if Field <> nil 795 | then result := Field.IsValidChar(Key) 796 | else 797 | begin 798 | result := false; 799 | if FValueType = vtInteger then 800 | begin 801 | if Key in sEditArr 802 | then result := true; 803 | end 804 | else 805 | begin 806 | if (Key = sDec) or (Key in sEditArr) 807 | then result := true; 808 | end; 809 | end; 810 | end; 811 | 812 | { TccSpinFieldDataLink} 813 | 814 | procedure TccSpinFieldDataLink.SetEditing(Value: Boolean); 815 | begin 816 | if FEditing <> Value then 817 | begin 818 | FEditing := Value; 819 | FModified := False; 820 | if Assigned(FOnEditingChange) 821 | then FOnEditingChange(Self); 822 | end; 823 | end; 824 | 825 | procedure TccSpinFieldDataLink.SetFieldName(const Value: string); 826 | begin 827 | if FFieldName <> Value then 828 | begin 829 | FFieldName := Value; 830 | UpdateField; 831 | end; 832 | end; 833 | 834 | procedure TccSpinFieldDataLink.SetField(Value: TField); 835 | begin 836 | if FField <> Value then 837 | begin 838 | FField := Value; 839 | EditingChanged; 840 | RecordChanged(nil); 841 | end; 842 | end; 843 | 844 | procedure TccSpinFieldDataLink.UpdateField; 845 | begin 846 | if Active and (FFieldName <> '') then 847 | begin 848 | if Assigned(FControl) 849 | then SetField(GetFieldProperty(DataSource.DataSet, FControl, FFieldName)) 850 | else SetField(DataSource.DataSet.FieldByName(FFieldName)); 851 | end 852 | else SetField(nil); 853 | end; 854 | 855 | function TccSpinFieldDataLink.Edit: Boolean; 856 | begin 857 | if CanModify 858 | then inherited Edit; 859 | Result := FEditing; 860 | end; 861 | 862 | function TccSpinFieldDataLink.GetCanModify: Boolean; 863 | begin 864 | Result := (not ReadOnly) and (Field <> nil) and Field.CanModify; 865 | end; 866 | 867 | procedure TccSpinFieldDataLink.Modified; 868 | begin 869 | FModified := True; 870 | end; 871 | 872 | procedure TccSpinFieldDataLink.Reset; 873 | begin 874 | RecordChanged(nil); 875 | end; 876 | 877 | procedure TccSpinFieldDataLink.ActiveChanged; 878 | begin 879 | UpdateField; 880 | if Assigned(FOnActiveChange) 881 | then FOnActiveChange(Self); 882 | end; 883 | 884 | procedure TccSpinFieldDataLink.EditingChanged; 885 | begin 886 | SetEditing(inherited Editing and CanModify); 887 | end; 888 | 889 | procedure TccSpinFieldDataLink.FocusControl(Field: TFieldRef); 890 | begin 891 | if (Field^ <> nil) and (Field^ = FField) and (FControl is TWinControl) then 892 | begin 893 | if TWinControl(FControl).CanFocus then 894 | begin 895 | Field^ := nil; 896 | TWinControl(FControl).SetFocus; 897 | end; 898 | end; 899 | end; 900 | 901 | procedure TccSpinFieldDataLink.RecordChanged(Field: TField); 902 | begin 903 | try 904 | if (Field = nil) or (Field = FField) then 905 | begin 906 | if Assigned(FOnDataChange) 907 | then FOnDataChange(Self); 908 | FModified := False; 909 | end; 910 | except 911 | end; 912 | end; 913 | 914 | procedure TccSpinFieldDataLink.LayoutChanged; 915 | begin 916 | UpdateField; 917 | end; 918 | 919 | procedure TccSpinFieldDataLink.UpdateData; 920 | begin 921 | if FModified then 922 | begin 923 | if (Field <> nil) and Assigned(FOnUpdateData) 924 | then FOnUpdateData(Self); 925 | FModified := False; 926 | end; 927 | end; 928 | 929 | { TccSpinSpeedButton } 930 | 931 | constructor TccSpinSpeedButton.Create(AOwner: TComponent; Up: boolean); 932 | begin 933 | inherited Create(AOwner); 934 | FUp := Up; 935 | end; 936 | 937 | destructor TccSpinSpeedButton.Destroy; 938 | begin 939 | if FRepeatTimer <> nil 940 | then FRepeatTimer.Free; 941 | FRepeatTimer := nil; 942 | inherited Destroy; 943 | end; 944 | 945 | procedure TccSpinSpeedButton.Paint; 946 | begin 947 | inherited; 948 | if Enabled 949 | then PaintEnd(0) 950 | else 951 | begin 952 | PaintEnd(1); 953 | PaintEnd(0); 954 | end; 955 | end; 956 | 957 | procedure TccSpinSpeedButton.PaintEnd(lEn: integer); 958 | var 959 | xB, xE, Y, w, start: integer; 960 | begin 961 | w := ClientHeight-2; 962 | xB := Round((ClientWidth-w)/2); 963 | xE := xB + w; 964 | start := Round((ClientHeight-2)/4); 965 | 966 | if not FUp 967 | then Y := start 968 | else Y := ClientHeight - start - 2; 969 | 970 | if FState in [bsDown] then 971 | begin 972 | if FUp 973 | then Dec(Y, 1) 974 | else Inc(Y, 1); 975 | Dec(xE,1); 976 | Dec(xB,1); 977 | end; 978 | 979 | if Enabled 980 | then Canvas.Pen.Color := clBtnText 981 | else Canvas.Pen.Color := clBtnShadow; 982 | 983 | if lEn <> 0 then 984 | begin 985 | Canvas.Pen.Color := clBtnHighlight; 986 | Inc(Y, lEn); 987 | Inc(xE, lEn); 988 | Inc(xB, lEn); 989 | end; 990 | 991 | while xB <= xE do 992 | begin 993 | Canvas.MoveTo(xB, Y); 994 | Canvas.LineTo(xE, Y); 995 | inc(xB); 996 | dec(xE); 997 | if not FUp 998 | then Inc(Y) 999 | else Dec(Y); 1000 | end; 1001 | end; 1002 | 1003 | procedure TccSpinSpeedButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 1004 | begin 1005 | inherited MouseDown (Button, Shift, X, Y); 1006 | if FRepeatTimer = nil 1007 | then FRepeatTimer := TTimer.Create(Self); 1008 | 1009 | FRepeatTimer.OnTimer := TimerExpired; 1010 | FRepeatTimer.Interval := InitRepeatPause; 1011 | FRepeatTimer.Enabled := True; 1012 | end; 1013 | 1014 | procedure TccSpinSpeedButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 1015 | begin 1016 | inherited MouseUp (Button, Shift, X, Y); 1017 | if FRepeatTimer <> nil 1018 | then FRepeatTimer.Enabled := False; 1019 | end; 1020 | 1021 | procedure TccSpinSpeedButton.TimerExpired(Sender: TObject); 1022 | begin 1023 | FRepeatTimer.Interval := RepeatPause; 1024 | if (FState = bsDown) and MouseCapture then 1025 | begin 1026 | try 1027 | Click; 1028 | except 1029 | FRepeatTimer.Enabled := False; 1030 | raise; 1031 | end; 1032 | end; 1033 | end; 1034 | 1035 | initialization 1036 | sDec := '0'; 1037 | GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_SDECIMAL, PChar(sDec), Length(sDec)); 1038 | sEditArr := ['0','1','2','3','4','5','6','7','8','9','-','+']; 1039 | 1040 | end. 1041 | -------------------------------------------------------------------------------- /Sources/ccIBPumpVCL/ccTreeViewEditor.pas: -------------------------------------------------------------------------------- 1 | { 2 | Copyright (c) 2000-2002 CleverComponents.com 3 | Product: CleverComponents Interbase DataPump VCL 4 | Author: Alexandre Poloziouk, alex@CleverComponents.com 5 | Unit: ccTreeViewEditor.pas 6 | Version: 1.0 7 | } 8 | 9 | unit ccTreeViewEditor; 10 | 11 | {$INCLUDE ccGetVer.inc} 12 | 13 | interface 14 | 15 | uses 16 | Windows, Messages, SysUtils, Classes, Controls, 17 | {$IFDEF DELPHI6} 18 | DesignIntf, 19 | DesignEditors, 20 | {$ELSE} 21 | DsgnIntf, 22 | {$ENDIF} 23 | ccTreeView, ccTreeViewItemsEditor; 24 | 25 | type 26 | 27 | { TccTreeViewParams } 28 | 29 | TccTreeViewParams = class(TPropertyEditor) 30 | public 31 | function GetValue: string; override; 32 | function GetAttributes: TPropertyAttributes; override; 33 | procedure Edit; override; 34 | end; 35 | 36 | implementation 37 | 38 | { TccTreeViewParams } 39 | 40 | function TccTreeViewParams.GetValue: string; 41 | begin 42 | Result := Format('(%s)', [TccTreeViewParams.ClassName]); 43 | end; 44 | 45 | function TccTreeViewParams.GetAttributes: TPropertyAttributes; 46 | begin 47 | Result := [paMultiSelect, paDialog]; 48 | end; 49 | 50 | procedure TccTreeViewParams.Edit; 51 | begin 52 | if EditCCTreeView(TccTreeView(GetComponent(0))) then Modified; 53 | end; 54 | 55 | end. 56 | -------------------------------------------------------------------------------- /Sources/ccIBPumpVCL/ccTreeViewItemsEditor.dfm: -------------------------------------------------------------------------------- 1 | object ccTreeViewItemsEditor: TccTreeViewItemsEditor 2 | Left = 270 3 | Top = 185 4 | Width = 628 5 | Height = 213 6 | Caption = 'TreeView Items Editor' 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 = True 14 | Position = poScreenCenter 15 | OnShow = FormShow 16 | PixelsPerInch = 96 17 | TextHeight = 13 18 | object Panel1: TPanel 19 | Left = 0 20 | Top = 157 21 | Width = 620 22 | Height = 29 23 | Align = alBottom 24 | BevelOuter = bvNone 25 | TabOrder = 0 26 | object Panel4: TPanel 27 | Left = 375 28 | Top = 0 29 | Width = 245 30 | Height = 29 31 | Align = alRight 32 | BevelOuter = bvNone 33 | TabOrder = 0 34 | object bOk: TButton 35 | Left = 5 36 | Top = 3 37 | Width = 75 38 | Height = 25 39 | Caption = 'Ok' 40 | ModalResult = 1 41 | TabOrder = 0 42 | end 43 | object bCancel: TButton 44 | Left = 85 45 | Top = 3 46 | Width = 75 47 | Height = 25 48 | Caption = 'Cancel' 49 | ModalResult = 2 50 | TabOrder = 1 51 | end 52 | object bApply: TButton 53 | Left = 169 54 | Top = 3 55 | Width = 75 56 | Height = 25 57 | Caption = 'Apply' 58 | TabOrder = 2 59 | OnClick = bApplyClick 60 | end 61 | end 62 | end 63 | object Panel2: TPanel 64 | Left = 405 65 | Top = 0 66 | Width = 215 67 | Height = 157 68 | Align = alRight 69 | BevelOuter = bvNone 70 | TabOrder = 1 71 | object GroupBox1: TGroupBox 72 | Left = 0 73 | Top = 0 74 | Width = 215 75 | Height = 157 76 | Align = alClient 77 | Caption = 'Item Properties' 78 | TabOrder = 0 79 | object Label1: TLabel 80 | Left = 8 81 | Top = 44 82 | Width = 58 83 | Height = 13 84 | Caption = 'Image Index' 85 | end 86 | object Label2: TLabel 87 | Left = 8 88 | Top = 118 89 | Width = 42 90 | Height = 13 91 | Caption = 'Info Text' 92 | end 93 | object Label3: TLabel 94 | Left = 8 95 | Top = 20 96 | Width = 21 97 | Height = 13 98 | Caption = 'Text' 99 | end 100 | object Label4: TLabel 101 | Left = 8 102 | Top = 69 103 | Width = 71 104 | Height = 13 105 | Caption = 'Selected Index' 106 | end 107 | object Label5: TLabel 108 | Left = 8 109 | Top = 93 110 | Width = 54 111 | Height = 13 112 | Caption = 'State Index' 113 | end 114 | object cbBold: TCheckBox 115 | Left = 7 116 | Top = 136 117 | Width = 91 118 | Height = 17 119 | Alignment = taLeftJustify 120 | Caption = 'Bold' 121 | TabOrder = 0 122 | OnClick = cbBoldExit 123 | OnExit = cbBoldExit 124 | end 125 | object eText: TEdit 126 | Left = 85 127 | Top = 16 128 | Width = 121 129 | Height = 21 130 | TabOrder = 1 131 | OnChange = eTextExit 132 | OnExit = eTextExit 133 | end 134 | object eInfoText: TEdit 135 | Left = 85 136 | Top = 114 137 | Width = 121 138 | Height = 21 139 | TabOrder = 2 140 | OnChange = eInfoTextExit 141 | OnExit = eInfoTextExit 142 | end 143 | object eImageInd: TccSpinEdit 144 | Left = 85 145 | Top = 41 146 | Width = 94 147 | Height = 21 148 | TabOrder = 3 149 | OnChange = eImageIndExit 150 | OnExit = eImageIndExit 151 | Alignment = taLeftJustify 152 | Increment = 1 153 | Max = 9999999 154 | Enabled = True 155 | end 156 | object eSelInd: TccSpinEdit 157 | Left = 85 158 | Top = 65 159 | Width = 94 160 | Height = 21 161 | TabOrder = 4 162 | OnChange = eSelIndExit 163 | OnExit = eSelIndExit 164 | Alignment = taLeftJustify 165 | Increment = 1 166 | Max = 9999999 167 | Enabled = True 168 | end 169 | object eStateInd: TccSpinEdit 170 | Left = 85 171 | Top = 90 172 | Width = 94 173 | Height = 21 174 | TabOrder = 5 175 | OnChange = eStateIndExit 176 | OnExit = eStateIndExit 177 | Alignment = taLeftJustify 178 | Increment = 1 179 | Max = 9999999 180 | Enabled = True 181 | end 182 | end 183 | end 184 | object Panel3: TPanel 185 | Left = 0 186 | Top = 0 187 | Width = 405 188 | Height = 157 189 | Align = alClient 190 | BevelOuter = bvNone 191 | Caption = 'Panel3' 192 | TabOrder = 2 193 | object tree: TccTreeView 194 | Left = 0 195 | Top = 0 196 | Width = 316 197 | Height = 157 198 | ReadOnly = True 199 | RightClickSelect = True 200 | HideSelection = False 201 | Indent = 19 202 | OnChange = treeChange 203 | Align = alClient 204 | TabOrder = 0 205 | end 206 | object Panel5: TPanel 207 | Left = 316 208 | Top = 0 209 | Width = 89 210 | Height = 157 211 | Align = alRight 212 | BevelOuter = bvNone 213 | TabOrder = 1 214 | object bNew: TButton 215 | Left = 8 216 | Top = 6 217 | Width = 75 218 | Height = 25 219 | Caption = 'New Item' 220 | TabOrder = 0 221 | OnClick = bNewClick 222 | end 223 | object bSub: TButton 224 | Left = 8 225 | Top = 37 226 | Width = 75 227 | Height = 25 228 | Caption = 'New SebItem' 229 | TabOrder = 1 230 | OnClick = bSubClick 231 | end 232 | object bDel: TButton 233 | Left = 8 234 | Top = 69 235 | Width = 75 236 | Height = 25 237 | Caption = 'Delete' 238 | TabOrder = 2 239 | OnClick = bDelClick 240 | end 241 | object bLoad: TButton 242 | Left = 8 243 | Top = 102 244 | Width = 75 245 | Height = 25 246 | Caption = 'Load' 247 | TabOrder = 3 248 | Visible = False 249 | OnClick = bLoadClick 250 | end 251 | object bSave: TButton 252 | Left = 9 253 | Top = 132 254 | Width = 75 255 | Height = 25 256 | Caption = 'Save' 257 | TabOrder = 4 258 | Visible = False 259 | OnClick = bSaveClick 260 | end 261 | end 262 | end 263 | object OpenDialog: TOpenDialog 264 | Left = 42 265 | Top = 38 266 | end 267 | object SaveDialog: TSaveDialog 268 | Left = 42 269 | Top = 86 270 | end 271 | end 272 | -------------------------------------------------------------------------------- /Sources/ccIBPumpVCL/ccTreeViewItemsEditor.pas: -------------------------------------------------------------------------------- 1 | { 2 | Copyright (c) 2000-2002 CleverComponents.com 3 | Product: CleverComponents Interbase DataPump VCL 4 | Author: Alexandre Poloziouk, alex@CleverComponents.com 5 | Unit: ccTreeViewItemsEditor.pas 6 | Version: 1.0 7 | } 8 | 9 | unit ccTreeViewItemsEditor; 10 | 11 | {$INCLUDE ccGetVer.inc} 12 | 13 | interface 14 | 15 | uses 16 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls, Mask, 17 | ccTreeView, ccSpinEdit; 18 | 19 | type 20 | TccTreeViewItemsEditor = class(TForm) 21 | Panel1: TPanel; 22 | Panel2: TPanel; 23 | Panel3: TPanel; 24 | GroupBox1: TGroupBox; 25 | Panel4: TPanel; 26 | bOk: TButton; 27 | bCancel: TButton; 28 | bApply: TButton; 29 | Label1: TLabel; 30 | Label2: TLabel; 31 | Label3: TLabel; 32 | Label4: TLabel; 33 | Label5: TLabel; 34 | cbBold: TCheckBox; 35 | eText: TEdit; 36 | eInfoText: TEdit; 37 | eImageInd: TccSpinEdit; 38 | eSelInd: TccSpinEdit; 39 | eStateInd: TccSpinEdit; 40 | Panel5: TPanel; 41 | bNew: TButton; 42 | bSub: TButton; 43 | bDel: TButton; 44 | bLoad: TButton; 45 | bSave: TButton; 46 | OpenDialog: TOpenDialog; 47 | SaveDialog: TSaveDialog; 48 | tree: TccTreeView; 49 | procedure treeChange(Sender: TObject; Node: TccTreeNode); 50 | procedure FormShow(Sender: TObject); 51 | procedure bDelClick(Sender: TObject); 52 | procedure bNewClick(Sender: TObject); 53 | procedure bSubClick(Sender: TObject); 54 | procedure eTextExit(Sender: TObject); 55 | procedure eImageIndExit(Sender: TObject); 56 | procedure eSelIndExit(Sender: TObject); 57 | procedure eStateIndExit(Sender: TObject); 58 | procedure eInfoTextExit(Sender: TObject); 59 | procedure cbBoldExit(Sender: TObject); 60 | procedure bLoadClick(Sender: TObject); 61 | procedure bSaveClick(Sender: TObject); 62 | procedure bApplyClick(Sender: TObject); 63 | private 64 | lRes: boolean; 65 | TV: TccTreeView; 66 | end; 67 | 68 | function EditCCTreeView(ATV: TccTreeView): boolean; 69 | 70 | implementation 71 | 72 | {$R *.DFM} 73 | 74 | function EditCCTreeView(ATV: TccTreeView): boolean; 75 | var 76 | frmTreeView: TccTreeViewItemsEditor; 77 | begin 78 | frmTreeView := TccTreeViewItemsEditor.Create(nil); 79 | with frmTreeView do 80 | begin 81 | try 82 | lRes := False; 83 | TV := ATV; 84 | tree.Items.Assign(ATV.Items); 85 | if ShowModal = mrOk then 86 | begin 87 | lRes := True; 88 | TV.Items.Assign(tree.Items); 89 | end; 90 | finally 91 | result := lRes; 92 | frmTreeView.Free; 93 | end; 94 | end; 95 | end; 96 | 97 | procedure TccTreeViewItemsEditor.treeChange(Sender: TObject; Node: TccTreeNode); 98 | begin 99 | eText.Enabled := Node <> nil; 100 | eInfoText.Enabled := Node <> nil; 101 | eImageInd.Enabled := Node <> nil; 102 | eSelInd.Enabled := Node <> nil; 103 | eStateInd.Enabled := Node <> nil; 104 | cbBold.Enabled := Node <> nil; 105 | 106 | if Node = nil then 107 | begin 108 | eText.Text := ''; 109 | eInfoText.Text := ''; 110 | eImageInd.Text := '0'; 111 | eSelInd.Text := '0'; 112 | eStateInd.Text := '-1'; 113 | cbBold.Checked := False; 114 | end 115 | else 116 | begin 117 | eText.Text := Node.Text; 118 | eInfoText.Text := Node.InfoText; 119 | eImageInd.Text := IntToStr(Node.ImageIndex); 120 | eSelInd.Text := IntToStr(Node.SelectedIndex); 121 | eStateInd.Text := IntToStr(Node.StateIndex); 122 | cbBold.Checked := Node.Bold; 123 | end; 124 | end; 125 | 126 | procedure TccTreeViewItemsEditor.FormShow(Sender: TObject); 127 | begin 128 | treeChange(nil, nil); 129 | end; 130 | 131 | procedure TccTreeViewItemsEditor.bDelClick(Sender: TObject); 132 | begin 133 | if tree.Selected <> nil 134 | then tree.Items.Delete(tree.Selected); 135 | end; 136 | 137 | procedure TccTreeViewItemsEditor.bNewClick(Sender: TObject); 138 | var 139 | tn: TccTreeNode; 140 | begin 141 | tn := tree.Items.Add(tree.Selected,''); 142 | tree.Selected := tn; 143 | eText.SetFocus; 144 | end; 145 | 146 | procedure TccTreeViewItemsEditor.bSubClick(Sender: TObject); 147 | var 148 | tn: TccTreeNode; 149 | begin 150 | if tree.Selected = nil 151 | then exit; 152 | tn := tree.Items.AddChild(tree.Selected,''); 153 | tree.Selected := tn; 154 | eText.SetFocus; 155 | end; 156 | 157 | procedure TccTreeViewItemsEditor.eTextExit(Sender: TObject); 158 | begin 159 | if tree.Selected <> nil 160 | then tree.Selected.Text := eText.Text; 161 | end; 162 | 163 | procedure TccTreeViewItemsEditor.eImageIndExit(Sender: TObject); 164 | begin 165 | if tree.Selected <> nil then 166 | begin 167 | try 168 | tree.Selected.ImageIndex := StrToInt(eImageInd.Text); 169 | except 170 | tree.Selected.ImageIndex := 0; 171 | end; 172 | end; 173 | end; 174 | 175 | procedure TccTreeViewItemsEditor.eSelIndExit(Sender: TObject); 176 | begin 177 | if tree.Selected <> nil then 178 | begin 179 | try 180 | tree.Selected.SelectedIndex := StrToInt(eSelInd.Text); 181 | except 182 | tree.Selected.SelectedIndex := 0; 183 | end; 184 | end; 185 | end; 186 | 187 | procedure TccTreeViewItemsEditor.eStateIndExit(Sender: TObject); 188 | begin 189 | if tree.Selected <> nil then 190 | begin 191 | try 192 | tree.Selected.StateIndex := StrToInt(eStateInd.Text); 193 | except 194 | tree.Selected.StateIndex := -1; 195 | end; 196 | end; 197 | end; 198 | 199 | procedure TccTreeViewItemsEditor.eInfoTextExit(Sender: TObject); 200 | begin 201 | if tree.Selected <> nil 202 | then tree.Selected.InfoText := eInfoText.Text; 203 | end; 204 | 205 | procedure TccTreeViewItemsEditor.cbBoldExit(Sender: TObject); 206 | begin 207 | if tree.Selected <> nil 208 | then tree.Selected.Bold := cbBold.Checked; 209 | end; 210 | 211 | procedure TccTreeViewItemsEditor.bLoadClick(Sender: TObject); 212 | begin 213 | if OpenDialog.Execute 214 | then tree.LoadFromFile(OpenDialog.FileName); 215 | end; 216 | 217 | procedure TccTreeViewItemsEditor.bSaveClick(Sender: TObject); 218 | begin 219 | if SaveDialog.Execute 220 | then tree.SaveToFile(SaveDialog.FileName); 221 | end; 222 | 223 | procedure TccTreeViewItemsEditor.bApplyClick(Sender: TObject); 224 | begin 225 | lRes := True; 226 | TV.Items.Assign(tree.Items); 227 | end; 228 | 229 | end. 230 | --------------------------------------------------------------------------------