adataset.pas

delphi通过OCI访问ORACLE

  ParamParamType: TAParamType);
begin
  inherited Create;
  FParent := Parent;
  FName := ParamName;
  FFieldType := ParamFieldType;
  FParamType := ParamParamType;
end;

procedure TAParam.TestType(t: TAFieldType);
begin
  if t <> FieldType
    then raise Exception.Create(Format(SErrParamDataTypeMismatch, [FName, AFieldTypeNames[FFieldType], AFieldTypeNames[t]]));
end;

function TAParam.ReadBlobToStream(Stream: TStream): cardinal;
var buf:array[0..16383] of byte;
    sz:cardinal;
    Offset:integer;
begin
  Result := 0;
  Offset := 0;
  repeat
   sz := ReadBlob(Offset, @buf, sizeof(buf));
   Result := Result + sz;
   inc(Offset, sz);
   Stream.Write(buf, sz);
  until sz <> sizeof(buf);
end;

function TAParam.WriteBlobFromStream(Stream: TStream): cardinal;
var buf:array[0..16383] of byte;
    sz:integer;
    Offset:integer;
begin
  ClearBlob;
  Result := 0;
  Offset := 0;
  Stream.Seek(0, soFromBeginning);
  if Stream.Size > 0 then begin
   repeat
    sz := Stream.Read(buf, sizeof(buf));
    Result := Result + WriteBlob(Offset, @buf, sz);
    inc(Offset, sz);
   until Offset = Stream.Size;
  end;
end;

{ TAField }

procedure TAField.Allocate;
begin
  if Values = nil then
    case FieldType of
      ftoString:   Values := THArrayStringFix.CreateSize(FieldSize);
      ftoBoolean:  Values := THArrayBoolean.Create;
      ftoDouble:   Values := THArrayDouble.Create;
      ftoCurrency: Values := THArrayCurrency.Create;
      ftoDate:     Values := THArrayInteger.Create;
      ftoTime:     Values := THArrayInteger.Create;
      ftoDateTime: Values := THArrayInt64.Create;
      ftoInt64:    Values := THArrayInt64.Create;
      ftoInteger:  Values := THArrayInteger.Create;
      ftoSmallInt: Values := THArraySmallInt.Create;
      ftoWord:     Values := THArrayWord.Create;
      ftoBlob,
      ftoClob:
      begin
        Values := THArrayPointer.Create;
        ValuesSize := THArrayInteger.Create;
      end;
   else
     raise Exception.Create(SUnknownFieldType);
   end;

  if FRequired then
  begin
    if ValuesNull <> nil
      then ValuesNull.Free;
    ValuesNull := nil;
  end
  else
  begin
    if ValuesNull = nil
      then ValuesNull := THArrayBoolean.Create;
  end;

end;

{procedure TAField.Allocate(HArray:THArray;HArrayNull:THArrayBoolean;HArraySize:THArrayInteger=nil);
begin
 Values:=HArray;
 ValuesNull:=HArrayNull;
 ValuesSize:=HArraySize;
 FRequired:=(HArrayNull=nil);
end;
 }
procedure TAField.Clear;
begin
 if Assigned(Values) then begin Values.Free; Values:=nil; end;
 if Assigned(ValuesSize) then begin ValuesSize.Free; ValuesSize:=nil; end;
 if Assigned(ValuesNull) then begin ValuesNull.Free; ValuesNull:=nil; end;
end;

constructor TAField.Create(Parent: TADataSet; FieldName: string;
  RFieldType: TAFieldType; FieldSize: word; Required: boolean);
begin
 inherited Create;
 FParent := Parent;
 FName := FieldName;
 FFieldType := RFieldType;
 FFieldSize := FieldSize;
 FRequired := Required;
 if RFieldType in [ftoBlob,ftoClob]
  then FFieldSize := 0; // for BLOBs the site is stored in the ValuesSize array

 Values := nil;
 ValuesNull := nil;
 ValuesSize := nil;

 Visible := True;
 ReadOnly := False;
end;

procedure TAField.DeleteRecord(RecordNum: integer);
begin
 if Values = nil
  then raise Exception.CreateFmt(SErrRecordNotFound, [RecordNum]);
 Values.Delete(RecordToInternal(RecordNum));
 if Assigned(ValuesSize) then ValuesSize.Delete(RecordToInternal(RecordNum));
 if Assigned(ValuesNull) then ValuesNull.Delete(RecordToInternal(RecordNum));
end;

destructor TAField.Destroy;
begin
{$ifdef ADEBUG}LogMessage('TAField.Destroy BEGIN');{$endif}

 Clear;
 inherited Destroy;

 {$ifdef ADEBUG}LogMessage('TAField.Destroy END');{$endif}
end;

function TAField.GetAsBoolean(RecordNum: integer): Boolean;
begin
 TestType(ftoBoolean);
 if IsNull[RecordNum]
  then Result := False
  else
   if Values = nil
    then raise Exception.CreateFmt(SErrRecordNotFound, [RecordNum])
    else Result := THArrayBoolean(Values)[RecordToInternal(RecordNum)];
end;

function TAField.GetAsCurrency(RecordNum: integer): Currency;
begin
 TestType(ftoCurrency);
 if IsNull[RecordNum]
  then Result := 0
  else
   if Values = nil
    then raise Exception.CreateFmt(SErrRecordNotFound, [RecordNum])
    else Result := THArrayCurrency(Values)[RecordToInternal(RecordNum)];
end;

function TAField.GetAsDate(RecordNum: integer): integer;
begin
 TestType(ftoDate);
 if IsNull[RecordNum]
  then Result := 0
  else
   if Values = nil
    then raise Exception.CreateFmt(SErrRecordNotFound, [RecordNum])
    else Result := THArrayInteger(Values)[RecordToInternal(RecordNum)];
end;

function TAField.GetAsDateTime(RecordNum: integer): int64;
begin
 TestType(ftoDateTime);
 if IsNull[RecordNum]
  then Result := 0
  else
   if Values = nil
    then raise Exception.CreateFmt(SErrRecordNotFound, [RecordNum])
    else Result := THArrayInt64(Values)[RecordToInternal(RecordNum)];
end;

function TAField.GetAsDouble(RecordNum: integer): Double;
begin
 TestType(ftoDouble);
 if IsNull[RecordNum]
  then Result := 0
  else
   if Values = nil
    then raise Exception.CreateFmt(SErrRecordNotFound, [RecordNum])
    else Result := THArrayDouble(Values)[RecordToInternal(RecordNum)];
end;

function TAField.GetAsInteger(RecordNum: integer): Integer;
begin
 TestType(ftoInteger);
 if IsNull[RecordNum]
  then Result := 0
  else
   if Values = nil
   then raise Exception.CreateFmt(SErrRecordNotFound, [RecordNum])
   else Result := THArrayInteger(Values)[RecordToInternal(RecordNum)];
end;

function TAField.GetAsSmallInt(RecordNum: integer): SmallInt;
begin
 TestType(ftoSmallInt);
 if IsNull[RecordNum]
  then Result := 0
  else
   if Values = nil
    then raise Exception.CreateFmt(SErrRecordNotFound, [RecordNum])
    else Result := THArraySmallInt(Values)[RecordToInternal(RecordNum)];
end;

function TAField.GetAsString(RecordNum: integer): string;
begin
 TestType(ftoString);
 if IsNull[RecordNum]
  then Result := ''
  else
   if Values = nil
    then raise Exception.CreateFmt(SErrRecordNotFound, [RecordNum])
    else Result := THArrayStringFix(Values)[RecordToInternal(RecordNum)];
end;

function TAField.GetAsTime(RecordNum: integer): integer;
begin
 TestType(ftoTime);
 if IsNull[RecordNum]
  then Result := 0
  else
   if Values = nil
    then raise Exception.CreateFmt(SErrRecordNotFound, [RecordNum])
    else Result := THArrayInteger(Values)[RecordToInternal(RecordNum)];
end;

function TAField.GetAsWord(RecordNum: integer): Word;
begin
 TestType(ftoWord);
 if IsNull[RecordNum]
  then Result := 0
  else
   if Values = nil
    then raise Exception.CreateFmt(SErrRecordNotFound, [RecordNum])
    else Result:=THArrayWord(Values)[RecordToInternal(RecordNum)];
end;

function TAField.GetAsInt64(RecordNum: integer): int64;
begin
 TestType(ftoInt64);
 if IsNull[RecordNum]
  then Result := 0
  else
   if Values = nil
    then raise Exception.CreateFmt(SErrRecordNotFound, [RecordNum])
    else Result := THArrayInt64(Values)[RecordToInternal(RecordNum)];
end;

function TAField.GetValue(RecordNum: integer): variant;
begin
 Result := Null;
 if IsNull[RecordNum] then begin
  exit;
 end;

 case FieldType of
  ftoString:   Result := AsString[RecordNum];
  ftoSmallint: Result := AsSmallInt[RecordNum];
  ftoInteger:  Result := AsInteger[RecordNum];
  ftoWord:     Result := AsWord[RecordNum];
  ftoBoolean:  Result := AsBoolean[RecordNum];
  ftoDouble:   Result := AsDouble[RecordNum];
  ftoCurrency: Result := AsCurrency[RecordNum];
  ftoDate:     Result := GoodDateToDateTime(AsDate[RecordNum]);
  ftoTime:     Result := GoodTimeToDateTime(AsTime[RecordNum]);
  ftoDateTime: Result := GoodDateTimeToDateTime(AsDateTime[RecordNum]);
{$IFDEF D6_OR_HIGHER}
  ftoInt64:    Result := AsInt64[RecordNum];
{$ENDIF}
  else
    raise Exception.Create(SUnknownFieldType);
 end;
end;

function TAField.GetIsNull(RecordNum: integer): boolean;
begin
 if ValuesNull = nil
  then Result := False
  else Result := not ValuesNull[RecordToInternal(RecordNum)];
end;

procedure TAField.InsertRecord(RecordNum: integer);
begin
 if Assigned(Values)
  then Values.Insert(RecordNum, nil)
  else raise Exception.CreateFmt(SErrRecordNotFound, [RecordNum]);
  
 if Assigned(ValuesSize) then begin ValuesSize.Insert(RecordNum, nil); ValuesSize[RecordNum] := 0; end;
 if Assigned(ValuesNull) then begin ValuesNull.Insert(RecordNum, nil); ValuesNull[RecordNum] := False; end;
end;

function TAField.RecordToInternal(RecordNum: integer): integer;
begin
 if FParent = nil then begin
  Result := RecordNum;
 end else begin
  if (RecordNum < FParent.FBeginRecord) or (RecordNum >= FParent.RecordCount)
   then raise Exception.Create(Format(SErrRecordNotLoaded, [RecordNum]));
  Result := RecordNum - FParent.FBeginRecord;
 end;
end;

procedure TAField.SetAsBoolean(RecordNum: integer; Value: Boolean);
begin
 TestType(ftoBoolean);
 IsNull[RecordNum] := False;
 if(Values <> nil)
  then THArrayBoolean(Values)[RecordToInternal(RecordNum)] := Value
  else raise Exception.CreateFmt(SErrRecordNotFound, [RecordNum]);
end;

procedure TAField.SetAsCurrency(RecordNum: integer; Value: Currency);
begin
 TestType(ftoCurrency);
 IsNull[RecordNum] := False;
 if(Values <> nil)
  then THArrayCurrency(Values)[RecordToInternal(RecordNum)] := Value
  else raise Exception.CreateFmt(SErrRecordNotFound, [RecordNum]);
end;

procedure TAField.SetAsDate(RecordNum, Value: integer);
begin
 TestType(ftoDate);
 IsNull[RecordNum] := False;
 if(Values <> nil)
  then THArrayInteger(Values)[RecordToInternal(RecordNum)] := Value
  else raise Exception.CreateFmt(SErrRecordNotFound, [RecordNum]);
end;

procedure TAField.SetAsDateTime(RecordNum: integer; Value: int64);
begin
 TestType(ftoDateTime);
 IsNull[RecordNum] := False;
 if(Values <> nil)
  then THArrayInt64(Values)[RecordToInternal(RecordNum)] := Value
  else raise Exception.CreateFmt(SErrRecordNotFound, [RecordNum]);
end;

procedure TAField.SetAsDouble(RecordNum: integer; Value: Double);
begin
 TestType(ftoDouble);
 IsNull[RecordNum] := False;
 if(Values <> nil)
  then THArrayDouble(Values)[RecordToInternal(RecordNum)] := Value
  else raise Exception.CreateFmt(SErrRecordNotFound, [RecordNum]);
end;

procedure TAField.SetAsInteger(RecordNum, Value: Integer);
begin
 TestType(ftoInteger);
 IsNull[RecordNum] := False;
 if(Values <> nil)
  then THArrayInteger(Values)[RecordToInternal(RecordNum)] := Value
  else raise Exception.CreateFmt(SErrRecordNotFound, [RecordNum]);
end;

procedure TAField.SetAsSmallInt(RecordNum: integer; Value: SmallInt);
begin
 TestType(ftoSmallInt);
 IsNull[RecordNum] := False;
 if(Values <> nil)
  then THArraySmallInt(Values)[RecordToInternal(RecordNum)] := Value
  else raise Exception.CreateFmt(SErrRecordNotFound, [RecordNum]);
end;

procedure TAField.SetAsString(RecordNum: integer; Value: string);
begin
 TestType(ftoString);
 IsNull[RecordNum] := False;
 if(Values <> nil)
  then THArrayStringFix(Values)[RecordToInternal(RecordNum)] := Value
  else raise Exception.CreateFmt(SErrRecordNotFound, [RecordNum]);
end;

procedure TAField.SetAsTime(RecordNum, Value: integer);
begin
 TestType(ftoTime);
 IsNull[RecordNum] := False;
 if(Values <> nil)
  then THArrayInteger(Values)[RecordToInternal(RecordNum)] := Value
  else raise Exception.CreateFmt(SErrRecordNotFound, [RecordNum]);
end;