zsqlbuffer.~pas

控件名称：WINZEOS.ZIP 2002年08月03日 作者：CapellaDevelopment Zeos系列构件套件包含一组可直接存取Linux知名的免费数据库MySQL、Postgre

    else
      Self.SqlIndices.Remove(NewIndexDesc);
  end;
end;

{ Find field with index }
function TSqlBuffer.IndexOfIndex(Index: Integer): Integer;
var
  I: Integer;
begin
  Result := -1;
  if (Index >= 0) and (Index < Count) then
    if Index = Items[Index].Index then
    begin
      Result := Index;
      Exit;
    end;
  for I := 0 to Count - 1 do
    if Index = Items[I].Index then
    begin
      Result := I;
      Exit;
    end;
end;

{ Find item, move it into list and return its index }
function TSqlBuffer.SafeIndexOfIndex(Index: Integer): Integer;
var
  I: Integer;
  Ptr: PChar;
begin
  { Try to find visible record }
  Result := IndexOfIndex(Index);
  if Result >= 0 then Exit;
  { Try to find hidden record }
  for I := 0 to FillCount-1 do
  begin
    Ptr := FillList^[I];
    if (PByte(Ptr)^ = ITEM_FILTERED) and (PRecordData(Ptr + 1).Index = Index) then
    begin
      Result := Count;
      Count := Count + 1;
      List^[Result] := Ptr + 1;
      Exit;
    end;
  end;
end;

{ Get field from internal buffer }
function TSqlBuffer.GetFieldData(FieldDesc: PFieldDesc; Buffer: Pointer;
  RecordData: PRecordData): Boolean;
begin
  Result := False;
  if RecordData.Bytes[FieldDesc.Offset] = 0 then
  begin
    if Buffer <> nil then
      System.Move(RecordData.Bytes[FieldDesc.Offset + 1], Buffer^, FieldDesc.DataSize);
    Result := True;
  end;
end;

{ Set field to internal buffer }
procedure TSqlBuffer.SetFieldData(FieldDesc: PFieldDesc; Buffer: Pointer;
  RecordData: PRecordData);
begin
  if Buffer = nil then
    RecordData.Bytes[FieldDesc.Offset] := 1
  else
  begin
    RecordData.Bytes[FieldDesc.Offset] := 0;
    System.Move(Buffer^, RecordData.Bytes[FieldDesc.Offset + 1], FieldDesc.DataSize);
  end;
end;

{ Set field to internal buffer with specified length }
procedure TSqlBuffer.SetFieldDataLen(FieldDesc: PFieldDesc; Buffer: Pointer;
  RecordData: PRecordData; Length: Integer);
begin
  if Buffer = nil then
    RecordData.Bytes[FieldDesc.Offset] := 1
  else begin
    RecordData.Bytes[FieldDesc.Offset] := 0;
    System.Move(Buffer^, RecordData.Bytes[FieldDesc.Offset + 1],
      Min(FieldDesc.DataSize, Length));
    if Length < FieldDesc.DataSize then
      RecordData.Bytes[FieldDesc.Offset + 1 + Length] := 0;
  end;
end;

{ Get field value as Variant }
function TSqlBuffer.GetFieldValue(FieldDesc: PFieldDesc;
  RecordData: PRecordData): Variant;
var
  Buffer: Pointer;
  TempStamp: TTimeStamp;
  Dataset: TZDataset;
begin
  Dataset := TZDataset(Self.Dataset);
  Result := Null;
  if RecordData = nil then Exit;
  Buffer := @RecordData.Bytes[FieldDesc.Offset + 1];
  if RecordData.Bytes[FieldDesc.Offset] = 0 then
    case FieldDesc.FieldType of
      ftString:
        Result := StrPas(PChar(Buffer));
{$IFNDEF VER100}
      ftLargeInt:
        Result := IntToStr(PInt64(Buffer)^);
{$ENDIF}
      ftBCD:
        Result := PCurrency(Buffer)^;
      ftInteger, ftAutoInc:
        Result := PLongInt(Buffer)^;
      ftSmallInt:
        Result := PSmallInt(Buffer)^;
      ftFloat, ftCurrency:
        Result := PDouble(Buffer)^;
      ftBoolean:
        Result := PWordBool(Buffer)^;
      ftTime:
        begin
          TempStamp.Time := PLongInt(Buffer)^;
          TempStamp.Date := DateDelta;
          Result := TimeStampToDateTime(TempStamp);
        end;
      ftDateTime:
        begin
          Result := TimeStampToDateTime(MSecsToTimeStamp(PDateTime(Buffer)^));
          Result := TDateTime(Result + Sgn(Result) * 0.5E-6);
        end;
      ftDate:
        begin
          TempStamp.Time := 0;
          TempStamp.Date := PLongInt(Buffer)^;
          Result := TimeStampToDateTime(TempStamp);
        end;
{
      ftArray:
        begin
          Result := MemPas(Buffer,FieldDesc^.DataSize);
        end;
}
      ftMemo:
        Result := MemPas(PChar(PRecordBlob(Buffer).Data), PRecordBlob(Buffer).Size);
      ftBlob:
        if Dataset.DatabaseType = dtPostgreSql then
          Result := PRecordBlob(Buffer).Handle.Ptr
        else
          Result := MemPas(PChar(PRecordBlob(Buffer).Data), PRecordBlob(Buffer).Size);
    end;
end;

{ Set field value as Variant }
procedure TSqlBuffer.SetFieldValue(FieldDesc: PFieldDesc; Value: Variant;
  RecordData: PRecordData);
var
  Buffer: array[0..MAX_STRING_SIZE] of Char;
  RecordBlob: PRecordBlob;
begin
  if VarType(Value) in [varEmpty, varNull] then
    SetFieldData(FieldDesc, nil, RecordData)
  else try
    case FieldDesc.FieldType of
      ftString:
        begin
          StrPLCopy(Buffer, Value, FieldDesc.DataSize - 1);
          Buffer[FieldDesc.DataSize - 1] := #0;
        end;
{$IFNDEF VER100}
      ftLargeInt:
        PInt64(@Buffer)^ := StrToInt64Def(Value, 0);
{$ENDIF}
      ftBCD:
        PCurrency(@Buffer)^ := Value;
      ftInteger, ftAutoInc:
        PLongInt(@Buffer)^ := Value;
      ftSmallInt:
        PSmallInt(@Buffer)^ := Value;
      ftFloat, ftCurrency:
        PDouble(@Buffer)^ := Value;
      ftBoolean:
        PWordBool(@Buffer)^ := Value;
      ftDate:
        PLongInt(@Buffer)^ := DateTimeToTimeStamp(VarAsType(Value, varDate)).Date;
      ftTime:
        PLongInt(@Buffer)^ := DateTimeToTimeStamp(VarAsType(Value, varDate)).Time;
      ftDateTime:
        PDateTime(@Buffer)^ := TimeStampToMSecs(DateTimeToTimeStamp(
          VarAsType(Value, varDate)));
      ftMemo, ftBlob:
        begin
          RecordBlob := PRecordBlob(@RecordData.Bytes[FieldDesc.Offset + 1]);
          RecordBlob.Size := Length(VarAsType(Value, varString)) + 1;
          if (RecordData.Bytes[FieldDesc.Offset] = 0) then
            ReallocMem(RecordBlob.Data, RecordBlob.Size)
          else
            RecordBlob.Data := AllocMem(RecordBlob.Size);
          StrPCopy(PChar(RecordBlob.Data), VarAsType(Value, varString));
          RecordBlob.Data[RecordBlob.Size] := 0;
        end;
      else
        Exit;
    end;

    RecordData.Bytes[FieldDesc.Offset] := 0;
    System.Move(Buffer, RecordData.Bytes[FieldDesc.Offset + 1], FieldDesc.DataSize);
  except
    RecordData.Bytes[FieldDesc.Offset] := 1;
  end;
end;

{ Get field value as String }
function TSqlBuffer.GetField(FieldDesc: PFieldDesc;
  RecordData: PRecordData): string;
begin
  if RecordData <> nil then
    Result := VariantToSqlValue(GetFieldValue(FieldDesc, RecordData),
      FieldDesc.FieldType, TZDataset(Dataset).DatabaseType)
  else
    Result := Null;
end;

{ Set field value as String }
procedure TSqlBuffer.SetField(FieldDesc: PFieldDesc; Value: string;
  RecordData: PRecordData);
begin
  SetFieldValue(FieldDesc, SqlValueToVariant(Value, FieldDesc.FieldType,
    TZDataset(Dataset).DatabaseType), RecordData);
end;

{ Get is field null }
function TSqlBuffer.GetFieldNull(FieldDesc: PFieldDesc;
  RecordData: PRecordData): Boolean;
begin
  Result := (RecordData = nil) or (RecordData.Bytes[FieldDesc.Offset] = 1);
end;

{ Set field null flag }
procedure TSqlBuffer.SetFieldNull(FieldDesc: PFieldDesc; Value: Boolean;
  RecordData: PRecordData);
begin
  if Value then
    RecordData.Bytes[FieldDesc.Offset] := 1
  else
    RecordData.Bytes[FieldDesc.Offset] := 0;
end;

{ Filter records }
function TSqlBuffer.FilterRecord(Item: Pointer): Boolean;
begin
  Result := False;
  { Check field types }
  if not (PRecordData(Item).RecordType in FilterTypes) then
    Exit;
  { Check master-detail link }
  if (FilterFieldCount > 0) and (CompareRecord(PRecordData(Item), FilterBuffer,
    FFilterFields, FFilterFieldCount) <> 0) then
    Exit;
  Result := True;
end;

{ Extract field from string and put field number into list }
procedure TSqlBuffer.ProcessFieldList(Fields: string;
  var FieldList: TFieldList; var FieldCount: Integer);
var
  I: Integer;
  Field: string;
  Found: Boolean;
begin
  FieldCount := 0;
  while (Fields <> '') and (FieldCount < MAX_FIELD_COUNT) do
  begin
    Field := UpperCase(Trim(StrTokEx(Fields,',;')));
    if (Field <> '') and IsDigit(Field[1]) then
    begin
      I := StrToIntDef(Field, -1);
      if (I >= 0) or (I < SqlFields.Count) then
      begin
        FieldList[FieldCount] := I;
        Inc(FieldCount);
      end else
        DatabaseError(Format('Unknown field %s', [Field]));
    end
    else
    begin
      DeleteQuotesEx(Field);
      Found := False;
      for I := 0 to SqlFields.Count-1 do
        if StrCaseCmp(SqlFields[I].Alias, Field) then
        begin
          Found := True;
          FieldList[FieldCount] := I;
          Inc(FieldCount);
          Break;
        end;
      if not Found then
        DatabaseError(Format('Unknown field %s', [Field]));
    end;
  end;
end;

{ Compare two records according field list }
function TSqlBuffer.CompareRecord(Item1, Item2: PRecordData;
  var FieldList: TFieldList; var FieldCount: Integer): Integer;
var
  I: Integer;
  FieldDesc: PFieldDesc;
  Value1, Value2: Pointer;
  DoubleRes: Double;
  CurrRes: System.Currency;
begin
  Result := 0;
  for I := 0 to FieldCount - 1 do
  begin
    FieldDesc := SqlFields[FieldList[I]];
    { Check null fields }
    if PRecordData(Item1).Bytes[FieldDesc.Offset] = 1 then
      Result := -1;
    if PRecordData(Item2).Bytes[FieldDesc.Offset] = 1 then
    begin
      Inc(Result);
      Break;
    end;
    if Result <> 0 then Break;
    { Obtain field buffers }
    Value1 := @PRecordData(Item1).Bytes[FieldDesc.Offset + 1];
    Value2 := @PRecordData(Item2).Bytes[FieldDesc.Offset + 1];
    { Process compation }
    case FieldDesc.FieldType of
      ftString:
        Result := AnsiStrComp(Value1, Value2);
{$IFNDEF VER100}
      ftLargeInt:
        Result := PInt64(Value1)^ - PInt64(Value2)^;
{$ENDIF}
      ftBCD:
        begin
          CurrRes := PCurrency(Value1)^ - PCurrency(Value2)^;
          if CurrRes < 0 then Result := -1
          else if CurrRes > 0 then Result := 1
          else Result := 0;
        end;
      ftInteger, ftAutoInc:
        Result := PInteger(Value1)^ - PInteger(Value2)^;
      ftSmallInt:
        Result := PSmallInt(Value1)^ - PSmallInt(Value2)^;
      ftFloat, ftCurrency:
        begin
          DoubleRes := PDouble(Value1)^ - PDouble(Value2)^;
          if DoubleRes < 0 then Result := -1
          else if DoubleRes > 0 then Result := 1
          else Result := 0;
        end;
      ftBoolean:
        Result := PByte(Value1)^ - PByte(Value2)^;
      ftTime:
        Result := PLongInt(Value1)^ - PLongInt(Value2)^;
      ftDateTime:
        begin
          DoubleRes := PDateTime(Value1)^ - PDateTime(Value2)^;
          if DoubleRes < -1000 then Result := -1
          else if DoubleRes > 1000 then Result := 1
          else Result := 0;
        end;
      ftDate:
        Result := PLongInt(Value1)^ - PLongInt(Value2)^;
    end;
  end;
  { Correct result according sorting type }
  if SortType = stDescending then
    Result := -Result;
end;

{ Sort records }
function TSqlBuffer.SortRecord(Item1, Item2: Pointer): Integer;
begin
  Result := CompareRecord(PRecordData(Item1), PRecordData(Item2),
    FSortFields, FSortFieldCount);
end;

{ Set sorting fields }
procedure TSqlBuffer.SetSort(Fields: string; SortType: TSortType);
begin
  FSortType := SortType;
  FIsSortInverse := False;
  ProcessFieldList(Fields, FSortFields, FSortFieldCount);
  if SortFieldCount > 0 then Sort
  else ClearSort;
end;

{ Inverse sorting fields }
procedure TSqlBuffer.SortInverse;
var
  Index1, Index2: Integer;
begin
  Index1 := 0;
  Index2 := Count - 1;
  while (Index2 - Index1) > 1 do
  begin
    Exchange(Index1, Index2);
    Inc(Index1);
    Dec(Index2);
  end;
  IsSortInverse := not IsSortInverse;
end;

{ Record sorting }
procedure TSqlBuffer.SortRestore;
begin
  if SortFieldCount > 0 then
    Sort;
  if IsSortInverse then
  begin
    SortInverse;
    IsSortInverse := True;
  end;
end;

{ Invoke a progress event }
procedure TSqlBuffer.DoProgress(Stage: Integer; Proc: Integer; Position, Max: Integer);
var
  Dataset: TZDataset;
  Cancel: Boolean;
begin
  Dataset := TZDataset(Self.Dataset);
  if Assigned(Dataset.OnProgress) then
  begin
    Cancel := False;
    Dataset.OnProgress(Dataset, TZProgressStage(Stage), TZProgressProc(Proc),
      Position, Max, Cancel);
  end;
end;

end.