jvquibdataset.pas

East make Tray Icon in delphi

procedure TJvUIBCustomDataSet.InternalInitFieldDefs;
var
  i: Integer;
{$IFDEF FPC}
  aName    : string;
  FieldNo  : Integer;
  Required : Boolean;
  DataType : TFieldType;
  Size     : Word;
  Precision: Integer;
{$ELSE}
  count  : Integer;
  TmpName: string;
{$ENDIF FPC}
begin
  FStatement.Prepare;
  {$IFNDEF FPC}
  FieldDefs.BeginUpdate;
  {$ENDIF !FPC}
  FieldDefs.Clear;
  try
    for i := 0 to FStatement.Fields.FieldCount - 1 do
    with {$IFNDEF FPC} FieldDefs.AddFieldDef,{$ENDIF} FStatement.Fields do
    begin
    {$IFNDEF FPC}
      count := 1;
      TmpName := AliasName[i];
      while TDefCollection(Collection).IndexOf(TmpName) >= 0 do
      begin
        TmpName := TmpName + inttostr(count);
        inc(count);
      end;
      Name := TmpName;
    {$ELSE}
      AName := AliasName[i];
      Precision:=-1;
    {$ENDIF !FPC}
      FieldNo := i;
      Required := not IsNullable[i];
      case FieldType[i] of
        uftNumeric:
          begin
          {$IFDEF FPC}
             DataType := ftFloat;
          {$ELSE}

            case SQLType[i] of
              SQL_SHORT:
                begin
                  DataType := ftBCD;
                  Size := -Data.sqlvar[i].SqlScale;
                  if Size = 4 then
                    Precision := 5 else
                    Precision := 4;
                end;
              SQL_LONG:
                begin
                  Size := -Data.sqlvar[i].SqlScale;
                  if Size = 9 then
                    Precision := 10 else
                    Precision := 9; 
                  if size > 4 then
                    DataType := ftFMTBcd else 
                    DataType := ftBCD;
                end;
              SQL_INT64,
              SQL_QUAD:
                begin
                  DataType := ftBCD;
                  Size := -Data.sqlvar[i].SqlScale;
                  if Size = 18 then
                    Precision := 19 else
                    Precision := 18; 
                  if size > 4 then
                    DataType := ftFMTBcd else 
                    DataType := ftBCD;
                end;
              SQL_DOUBLE:
                DataType := ftFloat; // possible
            else
              //raise
            end;
          {$ENDIF FPC}
          end;
        uftChar,
        uftCstring,
        uftVarchar:
          begin
            DataType := ftString;
            Size := SQLLen[i];
          end;
        uftSmallint: DataType := ftSmallint;
        uftInteger : DataType := ftInteger;
        uftFloat,
        uftDoublePrecision: DataType := ftFloat;
        uftTimestamp: DataType := ftDateTime;
        uftBlob, uftBlobId:
          begin
            if Data.sqlvar[i].SqlSubType = 1 then
              DataType := ftMemo else
              DataType := ftBlob;
            Size := SizeOf(TIscQuad);
          end;
        uftDate : DataType := ftDate;
        uftTime : DataType := ftTime;
        uftInt64:
        {$IFDEF FPC}
          DataType := ftInteger; // :(
        {$ELSE}
          DataType := ftLargeint;
        {$ENDIF FPC}
      {$IFDEF IB7_UP}
        uftBoolean: DataType := ftBoolean;
      {$ENDIF IB7_UP}
      else
        DataType := ftUnknown;
      end;
      
      {$IFDEF FPC}
      //Add new defs
      FieldDefs.Add(aName,DataType,Size,Required);
      //If Precision is specified, update the definition
      if Precision<>-1 then
          FieldDefs.Items[FieldNo].Precision:=Precision;
      {$ENDIF FPC}
    end; //With
  finally
    {$IFNDEF FPC}
    FieldDefs.EndUpdate;
    {$ENDIF !FPC}
  end;
end;

function TJvUIBCustomDataSet.GetFieldData(FieldNo: Integer;
  Buffer: Pointer): Boolean;
var
  FieldType: TUIBFieldType;
begin
  dec(FieldNo);
  Result := False;

  if (FCurrentRecord < 0) then
    Exit;

  FStatement.Fields.GetRecord(PInteger(ActiveBuffer)^);

  if FStatement.Fields.IsNull[FieldNo] then
    Exit;

  if Buffer = nil then
  begin
    Result := True;
    Exit;
  end;
  FieldType := FStatement.Fields.FieldType[FieldNo];
  with FStatement.Fields.Data.sqlvar[FieldNo] do
  case FieldType of
        uftNumeric:
          begin
            case FStatement.Fields.SQLType[FieldNo] of
              SQL_SHORT:
                begin 
                  TBCD(Buffer^) := strToBcd(FloatToStr(PSmallint(sqldata)^ / scaledivisor[sqlscale])); 
                end;
              SQL_LONG:
                begin 
                  TBCD(Buffer^) := strToBcd(FloatToStr(PInteger(sqldata)^ / scaledivisor[sqlscale])); 
                end;
              SQL_INT64,
              SQL_QUAD:
                begin 
                  TBCD(Buffer^) := strToBcd(FloatToStr(PInt64(sqldata)^ / scaledivisor[sqlscale])); 
                end;
              SQL_DOUBLE:
                PDouble(Buffer)^ := PDouble(sqldata)^;
            else
              raise Exception.Create(EUIB_UNEXPECTEDCASTERROR);
            end;
          end;
        uftChar,
        uftCstring:
          begin
            move(sqldata^, Buffer^, SqlLen);
            PChar(Buffer)[SqlLen] := #0;
          end;
        uftVarchar:
          begin
            move(PVary(sqldata).vary_string, Buffer^, PVary(sqldata).vary_length);
            PChar(Buffer)[PVary(sqldata).vary_length] := #0;
          end;
        uftSmallint: PSmallint(Buffer)^ := PSmallint(sqldata)^;
        uftInteger : PInteger(Buffer)^ := PInteger(sqldata)^;
        uftFloat:
            PDouble(Buffer)^ := PSingle(sqldata)^;
        uftDoublePrecision:
            PDouble(Buffer)^ := PDouble(sqldata)^;
        uftTimestamp:
          begin
            {$IFDEF FPC}
              DecodeTimeStamp(PIscTimeStamp(sqldata), PDouble(Buffer)^);
            {$ELSE}
              DecodeTimeStamp(PIscTimeStamp(sqldata),  TTimeStamp(Buffer^));
              Double(Buffer^) := TimeStampToMSecs(TTimeStamp(Buffer^));
            {$ENDIF FPC}
          end;
        uftBlob, uftBlobId:
          begin
            if Buffer <> nil then
            begin
              FStatement.ReadBlob(FieldNo, TStream(Buffer));
              TStream(Buffer).Seek(0, soFromBeginning);
            end;
          end;
        uftDate:
          {$IFDEF FPC}
            DecodeSQLDate(PInteger(sqldata)^, PDouble(Buffer)^);
          {$ELSE}
            PInteger(Buffer)^ := DecodeSQLDate(PInteger(sqldata)^) + 693594;
          {$ENDIF FPC}
        uftTime:
          {$IFDEF FPC}
            PDouble(Buffer)^ := PCardinal(sqldata)^ / 864000000;
          {$ELSE}
            PInteger(Buffer)^ := PCardinal(sqldata)^ div 10;
          {$ENDIF FPC}
        uftInt64:
          {$IFDEF FPC}
            PInteger(Buffer)^ := PInt64(sqldata)^;
          {$ELSE}
            PInt64(Buffer)^ := PInt64(sqldata)^;
          {$ENDIF FPC}
      {$IFDEF IB7_UP}
        uftBoolean:
          {$IFDEF FPC}
            Boolean(Buffer^) := PSmallInt(sqldata)^ = ISC_TRUE;
          {$ELSE}
            WordBool(Buffer^) := PSmallInt(sqldata)^ = ISC_TRUE;
          {$ENDIF FPC}
      {$ENDIF IB7_UP}
      else
        raise EUIBError.Create(EUIB_UNEXPECTEDERROR);
      end;
  Result := True;
end;

function TJvUIBCustomDataSet.GetFieldData(Field: TField;
  Buffer: Pointer): Boolean;
begin
  CheckActive;
  Result := GetFieldData(Field.FieldNo, Buffer);
end;

function TJvUIBCustomDataSet.GetCanModify: Boolean;
begin
  Result := False;
end;

procedure TJvUIBCustomDataSet.OnStatementClose(Sender: TObject);
begin
  Close;
end;

function TJvUIBCustomDataSet.CreateBlobStream(Field: TField;
  Mode: TBlobStreamMode): TStream;
begin
  if (Mode = bmRead) then
  begin
    Result := TMemoryStream.Create;
    GetFieldData(Field, Result);
  end else
    Result := nil;
end;

function TJvUIBCustomDataSet.GetFetchBlobs: boolean;
begin
  Result := FStatement.FetchBlobs;
end;

procedure TJvUIBCustomDataSet.SetFetchBlobs(const Value: boolean);
begin
  FStatement.FetchBlobs := Value;
end;

procedure TJvUIBCustomDataSet.Execute;
begin
  FStatement.Execute;
end;

procedure TJvUIBCustomDataSet.ExecSQL;
begin
  FStatement.ExecSQL;
end;

{$IFNDEF FPC}
procedure TJvUIBCustomDataSet.SetActive(Value: Boolean);
begin
  inherited;
  if not Value then
    FStatement.Close(FOnClose);
end;
{$ENDIF !FPC}



procedure TJvUIBCustomDataSet.SetDatabase(const Value: TJvUIBDataBase);
begin
  FStatement.DataBase := Value;
end;

function TJvUIBCustomDataSet.GetDatabase: TJvUIBDataBase;
begin
  Result := FStatement.DataBase;
end;

procedure TJvUIBCustomDataSet.ParamsSetBlob(const Name: string;
  Stream: TStream);
begin
  FStatement.ParamsSetBlob(Name, Stream);
end;

procedure TJvUIBCustomDataSet.ParamsSetBlob(const Name: string;
  var str: string);
begin
  FStatement.ParamsSetBlob(Name, str);
end;

procedure TJvUIBCustomDataSet.ParamsSetBlob(const Name: string;
  Buffer: Pointer; Size: Word);
begin
  FStatement.ParamsSetBlob(Name, Buffer, Size);
end;

procedure TJvUIBCustomDataSet.ParamsSetBlob(const Index: Word;
  Stream: TStream);
begin
  FStatement.ParamsSetBlob(Index, Stream);
end;

procedure TJvUIBCustomDataSet.ParamsSetBlob(const Index: Word;
  var str: string);
begin
  FStatement.ParamsSetBlob(Index, str);
end;

procedure TJvUIBCustomDataSet.ParamsSetBlob(const Index: Word;
  Buffer: Pointer; Size: Word);
begin
  FStatement.ParamsSetBlob(Index, Buffer, Size);
end;

procedure TJvUIBCustomDataSet.ReadBlob(const name: string;
  Stream: TStream);
begin
  FStatement.ReadBlob(name, Stream);
end;

procedure TJvUIBCustomDataSet.ReadBlob(const name: string;
  var str: string);
begin
  FStatement.ReadBlob(name, str);
end;

procedure TJvUIBCustomDataSet.ReadBlob(const name: string;
  var Value: Variant);
begin
  FStatement.ReadBlob(name, Value);
end;

procedure TJvUIBCustomDataSet.ReadBlob(const Index: Word; Stream: TStream);
begin
  FStatement.ReadBlob(Index, Stream);
end;

procedure TJvUIBCustomDataSet.ReadBlob(const Index: Word; var str: string);
begin
  FStatement.ReadBlob(Index, str);
end;

procedure TJvUIBCustomDataSet.ReadBlob(const Index: Word;
  var Value: Variant);
begin
  FStatement.ReadBlob(Index, Value);
end;

function TJvUIBCustomDataSet.GetParams: TSQLParams;
begin
  Result := FStatement.Params;
end;

function TJvUIBCustomDataSet.GetInternalFields: TSQLResult;
begin
  Result := FStatement.Fields;
end;

function TJvUIBCustomDataSet.GetBufferChunks: Cardinal;
begin
  Result := FStatement.BufferChunks;
end;

procedure TJvUIBCustomDataSet.SetBufferChunks(const Value: Cardinal);
begin
  FStatement.BufferChunks := Value;
end;

function TJvUIBCustomDataSet.GetRowsAffected: Cardinal;
begin
  Result := FStatement.RowsAffected;
end;

procedure TJvUIBCustomDataSet.InternalRefresh;
var RecCount: Integer;
begin
  if FStatement.Fields <> nil then
    RecCount := FStatement.Fields.RecordCount
  else
    RecCount := 0;
  FStatement.Open;
  while (RecCount > 1) and not FStatement.Eof do
  begin
    FStatement.Next;
    dec(RecCount);
  end;
end;


{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvQUIBDataSet.pas,v $';
    Revision: '$Revision: 1.12 $';
    Date: '$Date: 2005/02/06 14:06:17 $';
    LogPath: 'JVCL\run'
  );

initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}


end.