rxquery.pas

灰鸽子1.23源码,,,,,,,

    SQL := inherited SQL;
  end;
end;

procedure TRxQuery.ExpandMacros;
var
  ExpandedSQL: TStringList;
begin
  if not FPatternChanged and not FStreamPatternChanged and
    (MacroCount = 0) then Exit;
  ExpandedSQL := TStringList.Create;
  try
    Expand(ExpandedSQL);
    FDisconnectExpected := True;
    try
      inherited SQL := ExpandedSQL;
    finally
      FDisconnectExpected := False;
    end;
  finally
    ExpandedSQL.Free;
  end;
end;

procedure TRxQuery.RecreateMacros;
var
  List: TParams;
{$IFNDEF WIN32}
  P: PChar;
{$ENDIF}
begin
{$IFDEF RX_D4}
  if not (csReading in ComponentState) then begin
{$ENDIF RX_D4}
    List := TParams.Create{$IFDEF RX_D4}(Self){$ENDIF};
    try
  {$IFDEF WIN32}
      CreateMacros(List, PChar(FSQLPattern.Text));
  {$ELSE}
      P := FSQLPattern.GetText;
      try
        CreateMacros(List, P);
      finally
        StrDispose(P);
      end;
  {$ENDIF WIN32}
      List.AssignValues(FMacros);
  {$IFDEF RX_D4}
      FMacros.Clear;
      FMacros.Assign(List);
    finally
  {$ELSE}
      FMacros.Free;
      FMacros := List;
    except
  {$ENDIF RX_D4}
      List.Free;
    end;
{$IFDEF RX_D4}
  end
  else begin
    FMacros.Clear;
    CreateMacros(FMacros, PChar(FSQLPattern.Text));
  end;
{$ENDIF RX_D4}
end;

procedure TRxQuery.CreateMacros(List: TParams; const Value: PChar);
begin
  CreateQueryParams(List, Value, True, MacroChar, ['.']);
end;

procedure TRxQuery.Expand(Query: TStrings);

  function ReplaceString(const S: string): string;
  var
    I, J, P, LiteralChars: Integer;
    Param: TParam;
    Found: Boolean;
  begin
    Result := S;
    for I := Macros.Count - 1 downto 0 do begin
      Param := Macros[I];
      if Param.DataType = ftUnknown then Continue;
      repeat
        P := Pos(MacroChar + Param.Name, Result);
        Found := (P > 0) and ((Length(Result) = P + Length(Param.Name)) or
          NameDelimiter(Result[P + Length(Param.Name) + 1], ['.']));
        if Found then begin
          LiteralChars := 0;
          for J := 1 to P - 1 do
            if IsLiteral(Result[J]) then Inc(LiteralChars);
          Found := LiteralChars mod 2 = 0;
          if Found then begin
            Result := Copy(Result, 1, P - 1) + Param.Text + Copy(Result,
              P + Length(Param.Name) + 1, MaxInt);
          end;
        end;
      until not Found;
    end;
  end;

var
  I: Integer;
begin
  for I := 0 to FSQLPattern.Count - 1 do
    Query.Add(ReplaceString(FSQLPattern[I]));
end;

function TRxQuery.GetMacroCount: Word;
begin
  Result := FMacros.Count;
end;

function TRxQuery.MacroByName(const Value: string): TParam;
begin
  Result := FMacros.ParamByName(Value);
end;

{$IFNDEF RX_D3}
function TRxQuery.IsEmpty: Boolean;
begin
  Result := IsDataSetEmpty(Self);
end;
{$ENDIF RX_D3}

function TRxQuery.GetRealSQL: TStrings;
begin
  try
    ExpandMacros;
  except
  end;
  Result := inherited SQL;
end;

{$IFDEF RX_D5}

{ TRxQuery.IProviderSupport }

function TRxQuery.PSGetDefaultOrder: TIndexDef;
begin
  ExpandMacros;
  Result := inherited PSGetDefaultOrder;
end;

function TRxQuery.PSGetTableName: string;
begin
  ExpandMacros;
  Result := inherited PSGetTableName;
end;

procedure TRxQuery.PSExecute;
begin
  ExecSQL;
end;

{$ENDIF RX_D5}

{$IFDEF DEBUG}
procedure TRxQuery.SetRealSQL(Value: TStrings);
begin
end;
{$ENDIF DEBUG}

{$IFDEF WIN32}

{ TRxQueryThread }

constructor TRxQueryThread.Create(Data: TBDEDataSet; RunMode: TRunQueryMode;
  Prepare, CreateSuspended: Boolean);
begin
  inherited Create(True);
  FData := Data;
  FMode := RunMode;
  FPrepare := Prepare;
  FreeOnTerminate := True;
  FData.DisableControls;
  if not CreateSuspended then Resume;
end;

procedure TRxQueryThread.DoTerminate;
begin
  Synchronize(FData.EnableControls);
  inherited DoTerminate;
end;

procedure TRxQueryThread.ModeError;
begin
  SysUtils.Abort;
end;

procedure TRxQueryThread.DoHandleException;
begin
  if (FException is Exception) and not (FException is EAbort) then begin
    if Assigned(Application.OnException) then
      Application.OnException(FData, Exception(FException))
    else
      Application.ShowException(Exception(FException));
  end;
end;

procedure TRxQueryThread.HandleException;
begin
  FException := TObject(ExceptObject);
  Synchronize(DoHandleException);
end;

procedure TRxQueryThread.Execute;
begin
  try
    if FPrepare and not (FMode in [rqExecDirect]) then begin
      if FData is TRxQuery then TRxQuery(FData).Prepare
      else if FData is TQuery then TQuery(FData).Prepare
      else if FData is TStoredProc then TStoredProc(FData).Prepare;
    end;
    case FMode of
      rqOpen:
        FData.Open;
      rqExecute:
        begin
          if FData is TRxQuery then TRxQuery(FData).ExecSQL
          else if FData is TQuery then TQuery(FData).ExecSQL
          else if FData is TStoredProc then TStoredProc(FData).ExecProc
          else ModeError;
        end;
      rqExecDirect:
        begin
          if FData is TRxQuery then TRxQuery(FData).ExecDirect
          else ModeError;
        end;
      rqOpenOrExec:
        begin
          if FData is TRxQuery then TRxQuery(FData).OpenOrExec(True)
          else FData.Open;
        end;
    end;
  except
    HandleException;
  end;
end;

{$ENDIF WIN32}

{ TSQLScript }

constructor TSQLScript.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FSQL := TStringList.Create;
  TStringList(SQL).OnChange := QueryChanged;
  FParams := TParams.Create{$IFDEF RX_D4}(Self){$ENDIF};
  FQuery := TRxQuery.Create(Self);
  FSemicolonTerm := True;
  FTerm := DefaultTermChar;
end;

destructor TSQLScript.Destroy;
begin
  FQuery.Free;
  FSQL.Free;
  FParams.Free;
  inherited Destroy;
end;

function TSQLScript.GetDatabase: TDatabase;
begin
  Result := FQuery.Database;
end;

function TSQLScript.GetDatabaseName: string;
begin
  Result := FQuery.DatabaseName;
end;

procedure TSQLScript.SetDatabaseName(const Value: string);
begin
  FQuery.DatabaseName := Value;
end;

{$IFDEF WIN32}
function TSQLScript.GetSessionName: string;
begin
  Result := FQuery.SessionName;
end;

procedure TSQLScript.SetSessionName(const Value: string);
begin
  FQuery.SessionName := Value;
end;

function TSQLScript.GetDBSession: TSession;
begin
  Result := FQuery.DBSession;
end;
{$ENDIF WIN32}

procedure TSQLScript.CheckExecQuery(LineNo, StatementNo: Integer);
var
  Done: Boolean;
  Action: TScriptAction;
  I: Integer;
  Param: TParam;
{$IFNDEF WIN32}
  Msg: array[0..255] of Char;
{$ENDIF}
  S: string;
begin
  Done := False;
  repeat
    try
      if IgnoreParams then FQuery.ExecDirect
      else begin
        for I := 0 to FQuery.Params.Count - 1 do begin
          Param := FQuery.Params[I];
          Param.Assign(Params.ParamByName(Param.Name));
        end;
        FQuery.ExecSQL;
      end;
      Done := True;
    except
      on E: EDatabaseError do begin
        Action := saFail;
        S := Format(ResStr(SParseError), [ResStr(SMsgdlgError), LineNo]);
        if E is EDBEngineError then
          TDBError.Create(EDBEngineError(E), 0, LineNo,
            {$IFDEF WIN32} PChar(S) {$ELSE} StrPCopy(Msg, S) {$ENDIF})
        else begin
          if E.Message <> '' then E.Message := E.Message + '. ';
          E.Message := E.Message + S;
        end;
        if Assigned(FOnScriptError) then
          FOnScriptError(Self, E, LineNo, StatementNo, Action);
        if Action = saFail then raise;
        if Action = saAbort then SysUtils.Abort;
        if Action = saContinue then begin
          Application.HandleException(Self);
          Done := True;
        end
        else if Action = saIgnore then Done := True;
      end;
    end;
  until Done;
end;

procedure TSQLScript.ExecuteScript(StatementNo: Integer);
var
  S, LastStr: string;
  IsTrans, SQLFilled, StmtFound: Boolean;
  I, P, CurrStatement: Integer;
begin
  IsTrans := FTransaction {$IFNDEF WIN32} and Database.IsSQLBased {$ENDIF}
    and not TransActive(Database) and (StatementNo < 0);
  LastStr := '';
  try
    if IsTrans then begin
{$IFDEF WIN32}
      if not Database.IsSQLBased then
        Database.TransIsolation := tiDirtyRead;
{$ENDIF}
      Database.StartTransaction;
    end;
  except
    IsTrans := False;
  end;
  try
    I := 0;
    CurrStatement := 0;
    StmtFound := False;
    while I < SQL.Count do begin
      FQuery.SQL.BeginUpdate;
      try
        FQuery.SQL.Clear;
        SQLFilled := False;
        repeat
          if LastStr <> '' then begin
            FQuery.SQL.Add(LastStr);
            LastStr := '';
          end;
          if I < SQL.Count then begin
            S := Trim(SQL[I]);
            Inc(I);
            P := Pos(';', S);
            if (P > 0) and FSemicolonTerm then begin
              LastStr := Trim(Copy(S, P + 1, MaxInt));
              S := Copy(S, 1, P - 1);
              if S <> '' then FQuery.SQL.Add(S);
              SQLFilled := True;
            end
            else begin
              if (S = Term) then SQLFilled := True
              else if S <> '' then FQuery.SQL.Add(S);
            end;
          end
          else SQLFilled := True;
        until SQLFilled;
      finally
        FQuery.SQL.EndUpdate;
      end;
      if FQuery.SQL.Count > 0 then begin
        if (StatementNo < 0) or (StatementNo = CurrStatement) then begin
          StmtFound := True;
          CheckExecQuery(I - 1, CurrStatement);
          if StatementNo = CurrStatement then Break;
        end;
        Inc(CurrStatement);
      end;
    end;
    if not StmtFound then begin
{$IFDEF RX_D3}
      DatabaseError(Format(SListIndexError, [StatementNo]));
{$ELSE}
      DatabaseError(Format('%s: %d', [LoadStr(SListIndexError), StatementNo]));
{$ENDIF RX_D3}
    end;
    if IsTrans then Database.Commit;
  except
    if IsTrans then Database.Rollback;
    raise;
  end;
end;

procedure TSQLScript.ExecStatement(StatementNo: Integer);
begin
  if FSQL.Count = 0 then _DBError(SEmptySQLStatement);
  FQuery.SetDBFlag(dbfExecScript, True);
  try
    if not Database.Connected then _DBError(SDatabaseClosed);
    if Assigned(FBeforeExec) then FBeforeExec(Self);
    ExecuteScript(StatementNo);
    if Assigned(FAfterExec) then FAfterExec(Self);
  finally
    FQuery.SetDBFlag(dbfExecScript, False);
  end;
end;

procedure TSQLScript.ExecSQL;
begin
  ExecStatement(-1);
end;

procedure TSQLScript.CreateParams(List: TParams; const Value: PChar);
begin
  CreateQueryParams(List, Value, False, ':', []);
end;

procedure TSQLScript.SetQuery(Value: TStrings);
begin
  TStringList(SQL).OnChange := nil;
  FSQL.Assign(Value);
  TStringList(SQL).OnChange := QueryChanged;
  QueryChanged(nil);
end;

function TSQLScript.GetText: {$IFDEF WIN32} string {$ELSE} PChar {$ENDIF};
begin
{$IFDEF WIN32}
  Result := SQL.Text;
{$ELSE}
  Result := SQL.GetText;
{$ENDIF}
end;

procedure TSQLScript.QueryChanged(Sender: TObject);
var
  List: TParams;
{$IFNDEF WIN32}
  P: PChar;
{$ENDIF}
begin
{$IFDEF RX_D4}
  if not (csReading in ComponentState) then begin
{$ENDIF RX_D4}
    List := TParams.Create{$IFDEF RX_D4}(Self){$ENDIF};
    try
  {$IFDEF WIN32}
      CreateParams(List, PChar(Text));
  {$ELSE}
      P := GetText;
      try
        CreateParams(List, P);
      finally
        StrDispose(P);
      end;
  {$ENDIF WIN32}
      List.AssignValues(FParams);
  {$IFDEF RX_D4}
      FParams.Clear;
      FParams.Assign(List);
    finally
  {$ELSE}
      FParams.Free;
      FParams := List;
    except
  {$ENDIF RX_D4}
      List.Free;
    end;
{$IFDEF RX_D4}
  end
  else begin
    FParams.Clear;
    CreateParams(FParams, PChar(Text));
  end;
{$ENDIF RX_D4}
end;

function TSQLScript.ParamByName(const Value: string): TParam;
begin
  Result := FParams.ParamByName(Value);
end;

procedure TSQLScript.SetParamsList(Value: TParams);
begin
  FParams.AssignValues(Value);
end;

function TSQLScript.GetParamsCount: Cardinal;
begin
  Result := FParams.Count;
end;

{$IFDEF RX_D4}
procedure TSQLScript.DefineProperties(Filer: TFiler);
begin
  inherited DefineProperties(Filer);
  Filer.DefineProperty('ParamData', ReadParamData, WriteParamData, True);
end;

procedure TSQLScript.ReadParamData(Reader: TReader);
begin
  Reader.ReadValue;
  Reader.ReadCollection(FParams);
end;

procedure TSQLScript.WriteParamData(Writer: TWriter);
begin
  Writer.WriteCollection(Params);
end;
{$ENDIF RX_D4}

end.