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

Comparing ibx/trunk/runtime/ibxscript.pas (file contents):
Revision 60 by tony, Mon Mar 27 15:21:02 2017 UTC vs.
Revision 142 by tony, Thu Jan 25 16:48:38 2018 UTC

# Line 253 | Line 253 | type
253    TLogEvent = procedure(Sender: TObject; Msg: string) of Object;
254    TOnSelectSQL = procedure (Sender: TObject; SQLText: string) of object;
255    TOnSetStatement = procedure(Sender: TObject; command, aValue, stmt: string; var Done: boolean) of object;
256 +  TOnCreateDatabase = procedure (Sender: TObject; var DatabaseFileName: string) of object;
257  
258    { TCustomIBXScript }
259  
# Line 274 | Line 275 | type
275      FDatabase: TIBDatabase;
276      FDataOutputFormatter: TIBCustomDataOutput;
277      FIgnoreGrants: boolean;
278 +    FOnCreateDatabase: TOnCreateDatabase;
279      FOnErrorLog: TLogEvent;
280      FOnSelectSQL: TOnSelectSQL;
281      FOnSetStatement: TOnSetStatement;
# Line 325 | Line 327 | type
327      property OnProgressEvent: TOnProgressEvent read GetOnProgressEvent write SetOnProgressEvent; {Progress Bar Support}
328      property OnSelectSQL: TOnSelectSQL read FOnSelectSQL write FOnSelectSQL; {Handle Select SQL Statements}
329      property OnSetStatement: TOnSetStatement read FOnSetStatement write FOnSetStatement;
330 +    property OnCreateDatabase: TOnCreateDatabase read FOnCreateDatabase write FOnCreateDatabase;
331    end;
332  
333    {
# Line 425 | Line 428 | uses Sysutils, RegExpr;
428  
429   resourcestring
430    sTerminatorUnknownState = 'Statement Terminator in unexpected state (%d)';
428 –  sUnterminatedString = 'Unterminated string';
429 –  sUnknownSymbol = 'Unknown Symbol %d';
431    sNoSelectSQL = 'Select SQL Statements are not supported';
432    sStackUnderflow = 'Stack Underflow';
433    sNoParamQueries =  'Parameterised Queries are not supported';
434    sStackOverFlow = 'Stack Overflow';
435    sResolveQueryParam =  'Resolving Query Parameter: %s';
435 –  sNoCommit =  'Commit not allowed here';
436 –  sNoReconnect = 'Reconnect not allowed here';
436    sXMLStackUnderflow = 'XML Stack Underflow';
437    sInvalidEndTag = 'XML End Tag Mismatch - %s';
438    sXMLStackOverFlow = 'XML Stack Overflow';
# Line 563 | Line 562 | begin
562   end;
563  
564   procedure TCustomIBXScript.DoReconnect;
565 + var LoginPrompt: boolean;
566   begin
567    with GetTransaction do
568      if InTransaction then Commit;
569 +  LoginPrompt := Database.LoginPrompt;
570 +  Database.LoginPrompt := false;
571    Database.Connected := false;
572    Database.Connected := true;
573 +  Database.LoginPrompt := LoginPrompt;
574    GetTransaction.Active := true;
575   end;
576  
577   procedure TCustomIBXScript.ExecSQL(stmt: string);
578   var DDL: boolean;
579      I: integer;
577 –    stats: TPerfCounters;
580   begin
581     Database.Connected := true;
582     FISQL.SQL.Text := stmt;
# Line 649 | Line 651 | end;
651  
652   procedure TCustomIBXScript.SetDatabase(AValue: TIBDatabase);
653   begin
654 < if FDatabase = AValue then Exit;
654 > if not (csLoading in ComponentState) and (FDatabase = AValue) then Exit;
655   FDatabase := AValue;
656   FISQL.Database := AValue;
657   FIBXMLProcessor.Database := AValue;
658 + FInternalTransaction.Active := false;
659   FInternalTransaction.DefaultDatabase := AValue;
660   end;
661  
# Line 723 | Line 726 | begin
726  
727    except on E:Exception do
728        begin
729 <        Add2Log(Format(sStatementError,[FSymbolStream.GetErrorPrefix,
730 <                           E.Message,stmt]),true);
731 <        if StopOnFirstError then Exit;
729 >        if FInternalTransaction.InTransaction then
730 >          FInternalTransaction.Rollback;
731 >        if assigned(OnErrorLog) then
732 >        begin
733 >          Add2Log(Format(sStatementError,[FSymbolStream.GetErrorPrefix,
734 >                             E.Message,stmt]),true);
735 >                             if StopOnFirstError then Exit;
736 >        end
737 >        else
738 >          raise;
739        end
740    end;
741    Result := true;
# Line 838 | Line 848 | var  RegexObj: TRegExpr;
848       charsetid: integer;
849       param: string;
850       Terminator: char;
851 +     FileName: string;
852 +     DBConnected: boolean;
853 +     LoginPrompt: boolean;
854   begin
855    Result := false;
856    ucStmt := AnsiUpperCase(stmt);
# Line 845 | Line 858 | begin
858    RegexObj := TRegExpr.Create;
859    try
860      {process create database}
861 <    RegexObj.Expression := '^ *CREATE +(DATABASE|SCHEMA) +.*(\' + Terminator + '|)';
861 >    RegexObj.Expression := '^ *CREATE +(DATABASE|SCHEMA) +''(.*)''(.*)(\' + Terminator + '|)';
862      if RegexObj.Exec(ucStmt) then
863      begin
864 +      FileName := system.copy(stmt,RegexObj.MatchPos[2], RegexObj.MatchLen[2]);
865 +      if assigned(FOnCreateDatabase) then
866 +        OnCreateDatabase(self,FileName);
867 +      stmt := 'CREATE DATABASE ''' + FileName + '''' + system.copy(stmt,RegexObj.MatchPos[3], RegexObj.MatchLen[3]);
868 +      ucStmt := AnsiUpperCase(stmt);
869        UpdateUserPassword;
870        FDatabase.Connected := false;
871        FDatabase.CreateDatabase(stmt);
# Line 950 | Line 968 | begin
968        begin
969          if Database.Attachment.CharSetName2CharSetID(param,charsetid) then
970          begin
971 +          DBConnected := Database.Connected;
972 +          LoginPrompt := Database.LoginPrompt;
973 +          Database.LoginPrompt := false;
974 +          Database.Connected := false;
975            Database.Params.Values['lc_ctype'] := param;
976 <          if Database.Connected then
977 <            DoReconnect;
976 >          Database.Connected := DBConnected;
977 >          Database.LoginPrompt := LoginPrompt;
978          end
979          else
980            raise Exception.CreateFmt(sInvalidCharacterSet, [param,stmt]);

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines