jvbdequery.pas

East make Tray Icon in delphi

    (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 TJvQuery.RecreateMacros;
var
  List: TParams;
begin
  if not (csReading in ComponentState) then
  begin
    List := TParams.Create(Self);
    try
      CreateMacros(List, PChar(FSQL.Text));
      List.AssignValues(FMacros);
      FMacros.Clear;
      FMacros.Assign(List);
    finally
      List.Free;
    end;
  end
  else
  begin
    FMacros.Clear;
    CreateMacros(FMacros, PChar(FSQL.Text));
  end;
end;

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

procedure TJvQuery.Expand(Query: TStrings);
var
  I: Integer;

  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
          NameDelimiters(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;

begin
  Query.BeginUpdate;
  try
    for I := 0 to SQL.Count - 1 do
      Query.Add(ReplaceString(SQL[I]));
  finally
    Query.EndUpdate;
  end;
end;

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

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

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


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

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

procedure TJvQuery.PSExecute;
begin
  ExecSQL;
end;

//=== { TJvQueryThread } =====================================================

constructor TJvQueryThread.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 TJvQueryThread.DoTerminate;
begin
  Synchronize(FData.EnableControls);
  inherited DoTerminate;
end;

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

procedure TJvQueryThread.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 TJvQueryThread.HandleException;
begin
  FException := TObject(ExceptObject);
  Synchronize(DoHandleException);
end;

procedure TJvQueryThread.Execute;
begin
  try
    if FPrepare and not (FMode in [rqExecDirect]) then
    begin
      if FData is TJvQuery then
        TJvQuery(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 TJvQuery then
            TJvQuery(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 TJvQuery then
            TJvQuery(FData).ExecDirect
          else
            ModeError;
        end;
      rqOpenOrExec:
        begin
          if FData is TJvQuery then
            TJvQuery(FData).OpenOrExec(True)
          else
            FData.Open;
        end;
    end;
  except
    HandleException;
  end;
end;

//=== { TJvSQLScript } =======================================================

constructor TJvSQLScript.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FSQL := TStringList.Create;
  FSQL.OnChange := QueryChanged;
  FParams := TParams.Create(Self);
  FQuery := TJvQuery.Create(Self);
  FSemicolonTerm := True;
  FTerm := DefaultTermChar;
end;

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

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

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

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

function TJvSQLScript.GetSessionName: string;
begin
  Result := FQuery.SessionName;
end;

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

function TJvSQLScript.GetDBSession: TSession;
begin
  Result := FQuery.DBSession;
end;

procedure TJvSQLScript.CheckExecQuery(LineNo, StatementNo: Integer);
var
  Done: Boolean;
  Action: TScriptAction;
  I: Integer;
  Param: TParam;
  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(SParseError, [SMsgdlgError, LineNo]);
        if E is EDBEngineError then
          TDBError.Create(EDBEngineError(E), 0, LineNo,
            PChar(S))
        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 TJvSQLScript.ExecuteScript(StatementNo: Integer);
var
  S, LastStr: string;
  IsTrans, SQLFilled, StmtFound: Boolean;
  I, P, CurrStatement: Integer;
begin
  IsTrans := FTransaction and not TransActive(Database) and (StatementNo < 0);
  LastStr := '';
  try
    if IsTrans then
    begin
      if not Database.IsSQLBased then
        Database.TransIsolation := tiDirtyRead;
      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
      DatabaseError(Format(SListIndexError, [StatementNo]));
    end;
    if IsTrans then
      Database.Commit;
  except
    if IsTrans then
      Database.Rollback;
    raise;
  end;
end;

procedure TJvSQLScript.ExecStatement(StatementNo: Integer);
begin
  if SQL.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 TJvSQLScript.ExecSQL;
begin
  ExecStatement(-1);
end;

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

function TJvSQLScript.GetSQL: TStrings;
begin
  Result := FSQL;
end;

procedure TJvSQLScript.SetSQL(Value: TStrings);
begin
  FSQL.OnChange := nil;
  FSQL.Assign(Value);
  FSQL.OnChange := QueryChanged;
  QueryChanged(nil);
end;

function TJvSQLScript.GetText: string;
begin
  Result := SQL.Text;
end;

procedure TJvSQLScript.QueryChanged(Sender: TObject);
var
  List: TParams;
begin
  if not (csReading in ComponentState) then
  begin
    List := TParams.Create(Self);
    try
      CreateParams(List, PChar(Text));
      List.AssignValues(FParams);
      FParams.Clear;
      FParams.Assign(List);
    finally
      List.Free;
    end;
  end
  else
  begin
    FParams.Clear;
    CreateParams(FParams, PChar(Text));
  end;
end;

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

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

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


procedure TJvSQLScript.DefineProperties(Filer: TFiler);
begin
  inherited DefineProperties(Filer);
  Filer.DefineProperty('ParamData', ReadParamData, WriteParamData, True);
end;

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

procedure TJvSQLScript.WriteParamData(Writer: TWriter);
begin
  Writer.WriteCollection(Params);
end;

{$IFDEF UNITVERSIONING}
initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.