ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/iblocaldb/gui/IBXCreateDatabaseFromSQLDlgUnit.pas
(Generate patch)

Comparing ibx/trunk/iblocaldb/gui/IBXCreateDatabaseFromSQLDlgUnit.pas (file contents):
Revision 271 by tony, Wed Mar 14 12:48:51 2018 UTC vs.
Revision 272 by tony, Mon Feb 4 13:34:37 2019 UTC

# Line 40 | Line 40 | type
40  
41    TIBXCreateDatabaseFromSQLDlg = class(TForm)
42      Bevel1: TBevel;
43 +    IBTransaction1: TIBTransaction;
44      IBXScript: TIBXScript;
45      Label1: TLabel;
46      ProgressBar: TProgressBar;
# Line 51 | Line 52 | type
52    private
53      FDatabasePath: string;
54      FFileName: string;
55 +    FCompletedOK: integer;
56      procedure DoRunScript(Data: PtrInt);
57    public
58      property FileName: string read FFileName write FFileName;
# Line 73 | Line 75 | begin
75    try
76      FileName := DBArchive;
77      IBXScript.Database := aDatabase;
78 <    IBXScript.Transaction := aDatabase.DefaultTransaction;
79 <    DatabasePath := aDatabase.DatabaseName;
80 <    Result := ShowModal = mrOK;
78 >    IBTransaction1.DefaultDatabase := aDatabase;
79 >    IBXScript.Transaction := IBTransaction1;
80 >    DatabasePath := aDatabase.Attachment.GetConnectString;
81 >    ShowModal;
82 >    Result := FCompletedOK <> 0;
83    finally
84      Free
85    end
# Line 91 | Line 95 | begin
95    if Reset then
96      ProgressBar.Max := value
97    else
98 <    ProgressBar.StepIt;
98 >    ProgressBar.StepBy(Value);
99    Application.ProcessMessages;
100   end;
101  
102   procedure TIBXCreateDatabaseFromSQLDlg.DoRunScript(Data: PtrInt);
103   begin
104    try
105 <    ModalResult := mrCancel;
106 <    IBXScript.Database.CreateDatabase; {try to create the database}
103 <    repeat
104 <      try
105 <        if IBXScript.RunScript(FileName) then
106 <          ModalResult := mrOK;
107 <        break;
108 <      except on E:EIBInterBaseError do
109 <      begin
110 <        writeln(E.IBErrorCode);
111 <        if (E.IBErrorCode = isc_io_error) or  (E.IBErrorCode = isc_db_or_file_exists) then
112 <          {script contains Create Database Statement}
113 <        begin
114 <          IBXScript.Database.Connected := true;
115 <          IBXScript.Database.DropDatabase;
116 <          {repeat above and let script create database}
117 <        end
118 <        else
119 <          raise;
120 <      end;
121 <      end;
122 <    until false;
105 >    if IBXScript.RunScript(FileName) then
106 >          FCompletedOK := 1;
107      with IBXScript.Transaction do
108        if InTransaction then Commit;
125    IBXScript.Database.Connected := false;
109    except on E:Exception do
110      begin
111        MessageDlg(E.Message,mtError,[mbOK],0);
129      Close;
112      end;
113    end;
114 +  Close;
115   end;
116  
117   procedure TIBXCreateDatabaseFromSQLDlg.FormShow(Sender: TObject);

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines