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 139 by tony, Wed Jan 24 16:16:29 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;
# Line 723 | Line 725 | begin
725  
726    except on E:Exception do
727        begin
728 <        Add2Log(Format(sStatementError,[FSymbolStream.GetErrorPrefix,
729 <                           E.Message,stmt]),true);
730 <        if StopOnFirstError then Exit;
728 >        if FInternalTransaction.InTransaction then
729 >          FInternalTransaction.Rollback;
730 >        if assigned(OnErrorLog) then
731 >        begin
732 >          Add2Log(Format(sStatementError,[FSymbolStream.GetErrorPrefix,
733 >                             E.Message,stmt]),true);
734 >                             if StopOnFirstError then Exit;
735 >        end
736 >        else
737 >          raise;
738        end
739    end;
740    Result := true;
# Line 838 | Line 847 | var  RegexObj: TRegExpr;
847       charsetid: integer;
848       param: string;
849       Terminator: char;
850 +     FileName: string;
851 +     DBConnected: boolean;
852 +     LoginPrompt: boolean;
853   begin
854    Result := false;
855    ucStmt := AnsiUpperCase(stmt);
# Line 845 | Line 857 | begin
857    RegexObj := TRegExpr.Create;
858    try
859      {process create database}
860 <    RegexObj.Expression := '^ *CREATE +(DATABASE|SCHEMA) +.*(\' + Terminator + '|)';
860 >    RegexObj.Expression := '^ *CREATE +(DATABASE|SCHEMA) +''(.*)''(.*)(\' + Terminator + '|)';
861      if RegexObj.Exec(ucStmt) then
862      begin
863 +      FileName := system.copy(stmt,RegexObj.MatchPos[2], RegexObj.MatchLen[2]);
864 +      if assigned(FOnCreateDatabase) then
865 +        OnCreateDatabase(self,FileName);
866 +      stmt := 'CREATE DATABASE ''' + FileName + '''' + system.copy(stmt,RegexObj.MatchPos[3], RegexObj.MatchLen[3]);
867 +      ucStmt := AnsiUpperCase(stmt);
868        UpdateUserPassword;
869        FDatabase.Connected := false;
870        FDatabase.CreateDatabase(stmt);
# Line 950 | Line 967 | begin
967        begin
968          if Database.Attachment.CharSetName2CharSetID(param,charsetid) then
969          begin
970 +          DBConnected := Database.Connected;
971 +          LoginPrompt := Database.LoginPrompt;
972 +          Database.LoginPrompt := false;
973 +          Database.Connected := false;
974            Database.Params.Values['lc_ctype'] := param;
975 <          if Database.Connected then
976 <            DoReconnect;
975 >          Database.Connected := DBConnected;
976 >          Database.LoginPrompt := LoginPrompt;
977          end
978          else
979            raise Exception.CreateFmt(sInvalidCharacterSet, [param,stmt]);

Diff Legend

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