jvquib.pas

East make Tray Icon in delphi

      with TMetaDataBase(FMetadata) do
      begin
        OIDDatabases := FMetaDataOptions.Objects;
        OIDTables := FMetaDataOptions.Tables;
        OIDViews := FMetaDataOptions.Views;
        OIDProcedures := FMetaDataOptions.Procedures;
        OIDUDFs := FMetaDataOptions.UDFs;
        SysInfos := FMetaDataOptions.FSysInfos
      end;
      try
        TMetaDataBase(FMetadata).LoadFromDatabase(Transaction);
        Transaction.Commit;
      except
        FreeAndNil(FMetadata);
        raise;
      end;
    finally
      Transaction.Free;
    end;
  end;
  Result := FMetadata;
end;

function TJvUIBDataBase.GetSegmentSize: Word;
begin
  Result := FLibrary.SegMentSize;
end;

procedure TJvUIBDataBase.SetSegmentSize(const Value: Word);
begin
  FLibrary.SegMentSize := Value;
end;

{ TJvUIBStatement }

procedure TJvUIBStatement.SetTransaction(const Transaction: TJvUIBTransaction);
begin
  if (FTransaction <> Transaction) then
  begin
    if (FTransaction <> nil) then
    begin
      if FTransaction.AutoRetain then
        InternalClose(etmDefault, True) else
        InternalClose(etmStayIn, True);
      FTransaction.RemoveSQLComponent(Self);
    end;
    FTransaction := Transaction;
    if (Transaction <> nil) then
      Transaction.AddSQLComponent(Self);
    FCurrentState := qsDataBase;
  end;
end;

procedure TJvUIBStatement.SetDataBase(ADataBase: TJvUIBDataBase);
begin
  if (FDataBase <> ADataBase) then
  begin
    if (FTransaction <> nil) then
    begin
      if FTransaction.AutoRetain then
        InternalClose(etmDefault, True) else
        InternalClose(etmStayIn, True);
    end;
    FDataBase := ADataBase;
  end;
end;

procedure TJvUIBStatement.BeginTransaction;
begin
  if FTransaction <> nil then
    FTransaction.BeginTransaction else
    raise Exception.Create(EUIB_TRANSACTIONNOTDEF);
  FCurrentState := qsTransaction;
end;

procedure TJvUIBStatement.Close(const Mode: TEndTransMode);
begin
//  if Mode = etmStayIn then
//    CloseCursor else
    InternalClose(Mode, False);
end;

procedure TJvUIBStatement.Open(FetchFirst: boolean = True);
begin
  // if you reopen the same query I Close
  // the cursor, clean sql result and
  // execute the query again to save
  // the prepare time !
  if (FCurrentState = qsExecute) then
    CloseCursor;

  if FetchFirst then
    InternalNext else
    BeginExecute;
end;

procedure TJvUIBStatement.Next;
begin
  if (FCurrentState <> qsExecute) then
  raise Exception.Create(EUIB_MUSTBEOPEN);
  InternalNext;
end;

procedure TJvUIBStatement.Prior;
begin
  InternalPrior;
end;

procedure TJvUIBStatement.Last;
begin

  FetchAll;
end;

procedure TJvUIBStatement.First;
begin
  if (FSQLResult <> nil) and
   (FSQLResult.RecordCount > 0) and
    (FSQLResult.CurrentRecord <> 0) then
   FSQLResult.CurrentRecord := 0;
end;

procedure TJvUIBStatement.FetchAll;
begin
  while not Eof do Next;
end;

procedure TJvUIBStatement.Execute;
begin
  BeginExecute;
end;

procedure TJvUIBStatement.ExecSQL;
begin
  BeginExecImme;
end;

procedure TJvUIBStatement.Prepare;
begin
  if (FCurrentState < qsPrepare) then
  BeginPrepare
end;

procedure TJvUIBStatement.InternalNext;
begin
  if (FCurrentState < qsExecute) then
    BeginExecute;
  if ((Fields.CurrentRecord + 1) < Fields.RecordCount) then
  begin
    Fields.CurrentRecord := Fields.CurrentRecord + 1;
  end else
  begin
    Lock;
    try
      with FindDataBase.FLibrary do
      try
        if FSQLResult.FetchBlobs then
          DSQLFetchWithBlobs(FindDataBase.FDbHandle,
            FTransaction.FTrHandle, FStHandle, FTransaction.FSQLDialect, FSQLResult) else
          DSQLFetch(FStHandle, FTransaction.FSQLDialect, FSQLResult);
      except
        if FOnError <> etmStayIn then
          EndExecute(FOnError, False);
        raise;
      end;
    finally
      UnLock;
    end;
  end;
end;

procedure TJvUIBStatement.InternalPrior;
begin
  if Fields.CachedFetch then
  begin
    if Fields.CurrentRecord > 0 then
      Fields.CurrentRecord := Fields.CurrentRecord - 1;
  end else
    raise Exception.Create(EUIB_CACHEDFETCHNOTSET);
end;

procedure TJvUIBStatement.EndTransaction(const ETM: TEndTransMode; Auto: boolean);
begin
  if FTransaction <> nil then
  begin
    if FTransaction.EndTransaction(ETM, Self, Auto) then
      FCurrentState := qsDataBase;
  end else
    raise Exception.Create(EUIB_TRANSACTIONNOTDEF);
end;

procedure TJvUIBStatement.BeginStatement;
begin
  BeginTransaction;
  Lock;
  try
    with FindDataBase.FLibrary do
    try
      FStHandle := nil;
      DSQLAllocateStatement(FindDataBase.FDbHandle, FStHandle);
    except
      EndTransaction(FOnError, False);
      raise;
    end;
    inc(FTransaction.FStatements);
  finally
    UnLock;
  end;
  FCurrentState := qsStatement;
end;

procedure TJvUIBStatement.EndStatement(const ETM: TEndTransMode; Auto: boolean);
begin
  Lock;
  try
    with FindDataBase.FLibrary do
      DSQLFreeStatement(FStHandle, DSQL_drop);

    FStHandle := nil;
    Dec(FTransaction.FStatements);
  finally
    UnLock;
  end;
  FCurrentState := qsTransaction;
  if (ETM <> etmStayIn) then
    EndTransaction(ETM, Auto);

  if Assigned(FOnClose) then
    FOnClose(Self);    
end;

procedure TJvUIBStatement.BeginPrepare;
begin
  if (FStHandle = nil) then BeginStatement;
  FSQLResult := ResultClass.Create(0, FCachedFetch, FFetchBlobs, FBufferChunks);
  Lock;
  try
    with FindDataBase.FLibrary do
    try
    if (FQuickScript or (not FParseParams)) then
      FStatementType := DSQLPrepare(FTransaction.FTrHandle, FStHandle,
        FSQL.Text, FTransaction.FSQLDialect, FSQLResult) else
      FStatementType := DSQLPrepare(FTransaction.FTrHandle, FStHandle,
        FParsedSQL, FTransaction.FSQLDialect, FSQLResult);
      FCursorName := 'C' + inttostr(Integer(FStHandle));
      if FUseCursor then
        DSQLSetCursorName(FStHandle, FCursorName);
    except
      FSQLResult.Free;
      FSQLResult := nil;
      EndStatement(FOnError, False);
      raise;
    end;
  finally
    UnLock;
  end;
  FCurrentState := qsPrepare;
end;

procedure TJvUIBStatement.EndPrepare(const ETM: TEndTransMode; Auto: boolean);
begin
  FSQLResult.Free;
  FSQLResult := nil;
  FCurrentState := qsStatement;
  EndStatement(ETM, Auto);
end;

procedure TJvUIBStatement.BeginExecute;
begin
  if (FSQLResult = nil) then BeginPrepare;
  Lock;
  try
    with FindDataBase.FLibrary do
    try
      if (FStatementType = stExecProcedure) then
        DSQLExecute2(FTransaction.FTrHandle, FStHandle,
          FTransaction.FSQLDialect, FParameter, FSQLResult) else
        DSQLExecute(FTransaction.FTrHandle, FStHandle,
          FTransaction.FSQLDialect, FParameter);
    except
      if (FOnError <> etmStayIn) then
        EndPrepare(FOnError, False);
      raise;
    end;
  finally
    UnLock;
  end;
  FCurrentState := qsExecute;
end;

procedure TJvUIBStatement.EndExecute(const ETM: TEndTransMode; Auto: boolean);
begin
  FCurrentState := qsPrepare;
  EndPrepare(ETM, Auto);
end;

procedure TJvUIBStatement.BeginExecImme;
var
  I: Integer;
  procedure ExecuteQuery(const AQuery: String; Params: TSQLParams);
  begin
    if (Trim(AQuery) = '') then exit;
    Lock;
    try
      with FindDataBase.FLibrary do
      try
        DSQLExecuteImmediate(FindDataBase.FDbHandle, FTransaction.FTrHandle,
          AQuery, FTransaction.FSQLDialect, Params);
      except
        if (FOnError <> etmStayIn) then
          EndExecImme(FOnError, False);
        raise;
      end;
    finally
      UnLock;
    end;
  end;
begin
  BeginTransaction;
  if FQuickScript then
    for i := 0 to FSQL.Count - 1 do
    begin
      ExecuteQuery(FSQL.Strings[i], nil);
    end else
      if FParseParams then
        ExecuteQuery(FParsedSQL, FParameter) else
        ExecuteQuery(FSQL.Text, FParameter);
  FCurrentState := qsExecImme;
end;

procedure TJvUIBStatement.EndExecImme(const ETM: TEndTransMode; Auto: boolean);
begin
  FCurrentState := qsTransaction;
  if (ETM <> etmStayIn) then
    EndTransaction(ETM, Auto);
end;

function TJvUIBStatement.ParamsClass: TSQLParamsClass;
begin
  Result := TSQLParams;
end;

function TJvUIBStatement.ResultClass: TSQLResultClass;
begin
  Result := TSQLResult;
end;

procedure TJvUIBStatement.Lock;
begin
  inherited;
    Ftransaction.Lock;
end;

procedure TJvUIBStatement.UnLock;
begin
    Ftransaction.UnLock;
  inherited;
end;

procedure TJvUIBStatement.SetSQL(const Value: TStrings);
begin
  FSQL.Assign(Value);
end;

function TJvUIBStatement.GetPlan: string;
begin
  Lock;
  try
    if (FCurrentState < qsPrepare) then
      Raise Exception.Create(EUIB_MUSTBEPREPARED)else
        Result := FindDataBase.FLibrary.DSQLInfoPlan(FStHandle);
  finally
    UnLock
  end;
end;

function TJvUIBStatement.GetStatementType: TUIBStatementType;
begin
  if (FCurrentState < qsPrepare) then
    Raise Exception.Create(EUIB_MUSTBEPREPARED)else
    Result := FStatementType;
end;

procedure TJvUIBStatement.DoSQLChange(Sender: TObject);
begin
  InternalClose(etmStayIn, True);
  if (not FQuickScript or FParseParams) then
    FParsedSQL := FParameter.Parse(FSQL.Text);
end;