ibcarrayuni.pas

CrLab UniDAC 1.0 include sources

  end;
end;

procedure VarArrayPut(var A: Variant; const Value: Variant; const Indices: array of Integer);
asm
        PUSH    EBX

        MOV     EBX,[EBP+8]

        TEST    EBX,EBX
        JS      @@endLoop
@@loop:
        PUSH    [ECX+EBX*4].Integer
        DEC     EBX
        JNS     @@loop
@@endLoop:
        MOV     EBX,[EBP+8]
        INC     EBX
        PUSH    EBX
        PUSH    EDX
        PUSH    EAX
        CALL    _VarArrayPut
        LEA     ESP,[ESP+EBX*4+3*4]

        POP     EBX
end;

function VarIsType(const V: Variant; AVarType: TVarType): Boolean;
begin
  Result := VarType(V) = AVarType; 
end;
{$ENDIF}

{ TDescAccessor }

constructor TDescAccessor.Create(ArrayDescType: TARRAYDESCType; Desc: IntPtr);
begin
  inherited Create;
  FDesc := Desc;
  FArrayDescType := ArrayDescType;
end;

procedure TDescAccessor.Clear;
begin
  FillChar(FDesc, ARRAYDESC_LENGTH(FArrayDescType), $00);
end;

function TDescAccessor.GetDescVersion: SmallInt;
begin
  if FArrayDescType = adGDS then
    Result := 1
  else
    Result := Marshal.ReadInt16(FDesc, 0);
end;

procedure TDescAccessor.SetDescVersion(Value: SmallInt);
begin
  if FArrayDescType = adGDS7 then
    Marshal.WriteInt16(FDesc, 0, Value);
end;

function TDescAccessor.GetColumnName: string;
var
  Offset: integer;
begin
  if FArrayDescType = adGDS then
    Offset := 4
  else
    Offset := 8;
  Result := Marshal.PtrToStringAnsi(IntPtr(Integer(FDesc) + Offset));
end;

procedure TDescAccessor.SetColumnName(Value: string);
var
  Len: integer;
  SPtr: IntPtr;
  MetaLen: integer;
  Offset: integer;
begin
  if Value <> '' then begin
    if FArrayDescType = adGDS then begin
      MetaLen := 32;
      Offset := 4;
    end
    else begin
      MetaLen := METADATALENGTH;
      Offset := 8;
    end;
    Len := {$IFDEF CLR}Borland.Delphi.{$ENDIF}System.Length(Value);
    if Len > MetaLen then
      Len := MetaLen;
    if Len > 0 then begin
      SPtr := Marshal.StringToHGlobalAnsi(Value);
      try
        CopyBuffer(SPtr, IntPtr(Integer(FDesc) + Offset), Len);
      finally
        Marshal.FreeCoTaskMem(SPtr);
      end;
      Marshal.WriteByte(IntPtr(Integer(FDesc) + Offset), Len, $00);
    end;
  end;
end;

function TDescAccessor.GetRelationName: string;
var
  Offset: integer;
begin
  if FArrayDescType = adGDS then
    Offset := 4 + 32
  else
    Offset := 8 + METADATALENGTH;
  Result := Marshal.PtrToStringAnsi(IntPtr(Integer(FDesc) + Offset));
end;

procedure TDescAccessor.SetRelationName(Value: string);
var
  Len: integer;
  SPtr: IntPtr;
  MetaLen: integer;
  Offset: integer;
begin
  if Value <> '' then begin
    if FArrayDescType = adGDS then begin
      MetaLen := 32;
      Offset := 4 + 32
    end
    else begin
      MetaLen := METADATALENGTH;
      Offset := 8 + METADATALENGTH;
    end;
    Len := {$IFDEF CLR}Borland.Delphi.{$ENDIF}System.Length(Value);
    if Len > MetaLen then
      Len := MetaLen;
    if Len > 0 then begin
      SPtr := Marshal.StringToHGlobalAnsi(Value);
      try
        CopyBuffer(SPtr, IntPtr(Integer(FDesc) + Offset), Len);
      finally
        Marshal.FreeCoTaskMem(SPtr);
      end;
      Marshal.WriteByte(IntPtr(Integer(FDesc) + Offset), Len, $00);
    end;
  end;
end;

function TDescAccessor.GetLength: SmallInt;
var
  Offset: integer;
begin
  if FArrayDescType = adGDS then
    Offset := 2
  else
    Offset := 6;
  Result := Marshal.ReadInt16(FDesc, Offset);
end;

procedure TDescAccessor.SetLength(Value: SmallInt);
var
  Offset: integer;
begin
  if FArrayDescType = adGDS then
    Offset := 2
  else
    Offset := 6;
  Marshal.WriteInt16(FDesc, Offset, Value);
end;

function TDescAccessor.GetDimensions: SmallInt;
var
  Offset: integer;
begin
  if FArrayDescType = adGDS then
    Offset := 4 + 32 * 2
  else
    Offset := 8 + METADATALENGTH * 2;
  Result := Marshal.ReadInt16(FDesc, Offset);
end;

procedure TDescAccessor.SetDimensions(Value: SmallInt);
var
  Offset: integer;
begin
  if FArrayDescType = adGDS then
    Offset := 4 + 32 * 2
  else
    Offset := 8 + METADATALENGTH * 2;
  Marshal.WriteInt16(FDesc, Offset, Value);
end;

function TDescAccessor.GetHighBound(Dimension: integer): SmallInt;
var
  Offset: integer;
begin
  if FArrayDescType = adGDS then
    Offset := 8 + (32 * 2) + (Dimension * SizeOfISC_ARRAY_BOUND) + 2
  else
    Offset := 12 + (METADATALENGTH * 2) + (Dimension * SizeOfISC_ARRAY_BOUND) + 2;
  Result := Marshal.ReadInt16(FDesc, Offset);
end;

procedure TDescAccessor.SetHighBound(Dimension: integer; Value: SmallInt);
var
  Offset: integer;
begin
  if FArrayDescType = adGDS then
    Offset := 8 + (32 * 2) + (Dimension * SizeOfISC_ARRAY_BOUND) + 2
  else
    Offset := 12 + (METADATALENGTH * 2) + (Dimension * SizeOfISC_ARRAY_BOUND) + 2;
  Marshal.WriteInt16(FDesc, Offset, Value);
end;

function TDescAccessor.GetLowBound(Dimension: integer): SmallInt;
var
  Offset: integer;
begin
  if FArrayDescType = adGDS then
    Offset := 8 + (32 * 2) + (Dimension * SizeOfISC_ARRAY_BOUND)
  else
    Offset := 12 + (METADATALENGTH * 2) + (Dimension * SizeOfISC_ARRAY_BOUND);
  Result := Marshal.ReadInt16(FDesc, Offset)
end;

procedure TDescAccessor.SetLowBound(Dimension: integer; Value: SmallInt);
var
  Offset: integer;
begin
  if FArrayDescType = adGDS then
    Offset := 8 + (32 * 2) + (Dimension * SizeOfISC_ARRAY_BOUND)
  else
    Offset := 12 + (METADATALENGTH * 2) + (Dimension * SizeOfISC_ARRAY_BOUND);
  Marshal.WriteInt16(FDesc, Offset, Value);
end;

function TDescAccessor.GetDataType: byte;
var
  Offset: integer;
begin
  if FArrayDescType = adGDS then
    Offset := 0
  else
    Offset := 2;
  Result := Marshal.ReadByte(FDesc, Offset);
end;

procedure TDescAccessor.SetDataType(Value: byte);
var
  Offset: integer;
begin
  if FArrayDescType = adGDS then
    Offset := 0
  else
    Offset := 2;
  Marshal.WriteByte(FDesc, Offset, Value);
end;

function TDescAccessor.GetScale: ShortInt;
var
  Offset: integer;
begin
  if FArrayDescType = adGDS then
    Offset := 1
  else
    Offset := 4;
  Result := ShortInt(Marshal.ReadByte(FDesc, Offset));
end;

procedure TDescAccessor.SetScale(Value: ShortInt);
var
  Offset: integer;
begin
  if FArrayDescType = adGDS then
    Offset := 1
  else
    Offset := 4;
  Marshal.WriteByte(FDesc, Offset, Value);
end;

procedure TDescAccessor.SetDesc(Desc: IntPtr);
begin
  FDesc := Desc;
end;

{ TCustomIBCArray }

constructor TCustomIBCArray.Create(DbHandle: TISC_DB_HANDLE; TrHandle: TISC_TR_HANDLE);
var
  ADType: TARRAYDESCType;
begin
  inherited Create;
  
  if GDSVersion >= 7 then
    ADType := adGDS7
  else
    ADType := adGDS;
  FStatusVector := Marshal.AllocHGlobal(20 * SizeOf(ISC_Status));
  FDbHandle := Marshal.AllocHGlobal(SizeOf(TISC_DB_HANDLE));
  Marshal.WriteIntPtr(FDbHandle, DbHandle);
  FTrHandle := Marshal.AllocHGlobal(SizeOf(TISC_TR_HANDLE));
  Marshal.WriteIntPtr(FTrHandle, TrHandle);
  FArrayDesc := Marshal.AllocHGlobal(ARRAYDESC_LENGTH(ADType));
  FDescAccessor := TDescAccessor.Create(ADType, FArrayDesc);
  FDescAccessor.Clear;
  FArrayID := Marshal.AllocHGlobal(SizeOf(TISC_QUAD));
  Marshal.WriteInt64(FArrayID, 0);
  FArrayBuffer := nil;
  FCached := False;
  FInternalItemType := dtUnknown;
  FNativeDesc := True;
  FModified := False;
  FFirstWrite := True;
end;

constructor TCustomIBCArray.Create(DbHandle: TISC_DB_HANDLE; TrHandle: TISC_TR_HANDLE; TableName, ColumnName: string);
begin
  Create(DbHandle, TrHandle);
  if TableName = '' then
    raise Exception.Create(SInvalidTable);
  if ColumnName = '' then
    raise Exception.Create(SInvalidColumn);
  FTableName := TableName;
  FColumnName := ColumnName;
  //GetArrayInfo;
end;

destructor TCustomIBCArray.Destroy;
begin
  FreeBuffer;
  Marshal.FreeHGlobal(FArrayID);
  FDescAccessor.Free;
  if (FArrayDesc <> nil) and FNativeDesc then
    Marshal.FreeHGlobal(FArrayDesc);
  Marshal.FreeHGlobal(FStatusVector);
  Marshal.FreeHGlobal(FDbHandle);
  Marshal.FreeHGlobal(FTrHandle);

  inherited Destroy;
end;

function TCustomIBCArray.GetDbHandle: TISC_DB_HANDLE;
begin
  Result := Marshal.ReadIntPtr(FDbHandle);
end;

procedure TCustomIBCArray.SetDbHandle(Value: TISC_DB_HANDLE);
begin
  if GetDbHandle <> Value then begin
    SetArrayID(0);
    Marshal.WriteIntPtr(FDbHandle, Value);
  end;
end;

function TCustomIBCArray.GetTrHandle: TISC_TR_HANDLE;
begin
  Result := Marshal.ReadIntPtr(FTrHandle);
end;

procedure TCustomIBCArray.SetTrHandle(Value: TISC_TR_HANDLE);
begin
  if GetTrHandle <> Value then begin
    SetArrayID(0);
    Marshal.WriteIntPtr(FTrHandle, Value);
  end;
end;

function TCustomIBCArray.GetArrayID: TISC_QUAD;
begin
  Result := Marshal.ReadInt64(FArrayID);
end;

procedure TCustomIBCArray.SetArrayID(const Value: TISC_QUAD);
begin
  Marshal.WriteInt64(FArrayID, Value);
end;

procedure TCustomIBCArray.SetColumnName(const Value: string);
begin
  FColumnName := Value;
  FDescAccessor.ColumnName := FColumnName;
end;

procedure TCustomIBCArray.SetTableName(const Value: string);
begin
  FTableName := Value;
  FDescAccessor.RelationName := FTableName;
end;

procedure TCustomIBCArray.AllocBuffer;
var
  Size: integer;
begin
  FreeBuffer;
  Size := GetCachedSize;
  FArrayBuffer := Marshal.AllocHGlobal(Size);
  FillChar(FArrayBuffer, Size, $00);
end;

procedure TCustomIBCArray.FreeBuffer;
begin
  if FArrayBuffer <> nil then begin
    Marshal.FreeHGlobal(FArrayBuffer);
    FArrayBuffer := nil;
  end;
end;

procedure TCustomIBCArray.SetCached(Value: boolean);
begin
  if FCached <> Value then begin
    if (FArrayBuffer <> nil) and (not Value) then
      raise Exception.Create(SCannotDisableArrayCache)
    else
    if GetArrayID <> 0 then begin
      GetArrayInfo;
      ReadArray;
    end;
    FCached := Value;
  end;
end;