jvcsvdata.pas

East make Tray Icon in delphi

  FieldValue: string;
  //stillVisible : Integer;
  //m: TBookmark;
begin
  // m := GetBookmark;
  FieldRec := FCsvColumns.FindByName(FieldName);
  // stillVisible := 0;
  if not Assigned(FieldRec) then
    Exit;
  FieldIndex := FieldRec^.FPhysical;
  ValueLen := Length(Pattern); // if valuelen is zero then we are searching for blank or nulls
  Pattern := UpperCase(Pattern); // make value case insensitive.

  // Now check if field value matches given pattern for this row.
  for I := 0 to FData.Count - 1 do
  begin
    PRow := PCsvRow(FData[I]);
    if not PRow^.Filtered then
    begin
      FieldValue := FData.GetARowItem(I, FieldIndex);
      if (Length(FieldValue) > 0) and (FieldValue[1] = '"') then
        FieldValue := _Dequote(FieldValue); // remove quotes.
      if ValueLen = 0 then
      begin
        if FieldValue <> '' then // if not empty, hide row.
          PRow^.Filtered := True;
      end
      else
      begin
        FieldValue := UpperCase(FieldValue);
        if JvCsvWildcardMatch(FieldValue, Pattern) then // hide row if not same prefix
        begin
          // Inc(stillVisible)   // count the number that are still visible.
        end
        else
          PRow^.Filtered := True
      end;
    end
  end;
  FIsFiltered := True;
  if Active then
    First;
end;

procedure TJvCustomCsvDataSet._ClearFilter; // Clear Previous Filtering.
var
  I: Integer;
  PRow: PCsvRow;
begin
  for I := 0 to FData.Count - 1 do
  begin
    PRow := PCsvRow(FData[I]);
    if Assigned(PRow) then
      PRow^.Filtered := False; // clear all filter bits.
  end;
  FIsFiltered := False;
end;

procedure TJvCustomCsvDataSet.ClearFilter; // Clear Previous Filtering.
var
  M: TBookmark;
begin
  M := GetBookmark;
  _ClearFilter;
  // Update screen.
  if Active then
    if Assigned(M) then
      GotoBookmark(M)
    else
      First;
end;

function TJvCustomCsvDataSet.BookmarkValid(Bookmark: TBookmark): Boolean;
begin
  Result := (Bookmark <> nil) and (PInteger(Bookmark)^ >= 0) and (PInteger(Bookmark)^ < FData.Count);
end;

function TJvCustomCsvDataSet.AllocRecordBuffer: PChar;
var
  RowPtr: PCsvRow;
begin
  RowPtr := AllocMem(FBufferSize); {SizeOf(TJvCsvRow)}
  //  Trace('AllocRecordBuffer Result=$'+IntToHex(Integer(Pointer(RowPtr)),8));
  Result := PChar(RowPtr);
end;

{ calc fields support }

procedure TJvCustomCsvDataSet.ClearCalcFields(Buffer: PChar);
begin
  // Assumes that our buffer is a TJvCsvRow followed by
  // a dynamically resized buffer used for calculated field
  // storage:
  FillChar(Buffer[SizeOf(TJvCsvRow)], CalcFieldsSize, 0);
end;

{ calc fields support and buffer support }

function TJvCustomCsvDataSet.GetActiveRecordBuffer: PChar;
begin
  case State of
    dsBrowse:
      if IsEmpty then
        Result := nil
      else
        Result := ActiveBuffer;
    dsCalcFields:
      Result := CalcBuffer;
    dsFilter:
      Result := FFilterBuffer;
    dsEdit, dsInsert:
      Result := ActiveBuffer;
  else
    Result := nil;
  end;
end;

procedure TJvCustomCsvDataSet.SetCsvFieldDef(const Value: string);
begin
  if FCsvFieldDef <> Value then
  begin
    CheckInactive;
    FCsvFieldDef := Value;
    FHeaderRow := '';
    FieldDefs.Clear; // Clear VCL Database field definitions
    FCsvColumns.Clear; // Clear our own CSV related field Data
    FData.Clear; // Clear out Data
  end;
end;

procedure TJvCustomCsvDataSet.FreeRecordBuffer(var Buffer: PChar);
//var
//  RowPtr: PCsvRow;
begin
  //Trace( 'FreeRecordBuffer '+IntToHex(Integer(Buffer),8) );
// try
  if Buffer <> nil then
    FreeMem(Buffer);
// except
     //Trace( 'FreeRecordBuffer - Exception freeing '+IntToHex(Integer(Buffer),8) );
//  end;
//  //Trace('TJvCustomCsvDataSet.FreeRecordBuffer');

end;

{ called after the record is allocated }

procedure TJvCustomCsvDataSet.InternalInitRecord(Buffer: PChar);
var
  RowPtr: PCsvRow;
begin
  //Trace( 'InternalInitRecord '+IntToHex(Integer(Buffer),8) );

  FillChar(Buffer^, FBufferSize, 0);
  RowPtr := PCsvRow(Buffer); // Zero out the buffer.
  CsvRowInit(RowPtr);
end;

// CsvRowInit
//
// Internal handy dandy function to set up a new csv row.
// which is intially full of just commas.
//

procedure TJvCustomCsvDataSet.CsvRowInit(RowPtr: PCsvRow);
var
  I: Integer;
  ColCount: Integer;
begin
  RowPtr^.Index := -1; // Not Yet Indexed
  RowPtr^.IsDirty := False;
  RowPtr^.Bookmark.Flag := bfEOF;
  RowPtr^.Bookmark.Data := ON_BOF_CRACK; // no index into FData yet.
  CsvRowSetColumnMarker(RowPtr, {column} 0, {marker value} 0);

  ColCount := FCsvColumns.Count;
  if ColCount <= 0 then
    ColCount := 10;

  for I := 1 to ColCount do
  begin // create an empty line of just commas
    if I < ColCount then
      RowPtr^.Text[I - 1] := FSeparator
    else
      RowPtr^.Text[I - 1] := Chr(0);
    RowPtr^.Text[I] := Chr(0);
    CsvRowSetColumnMarker(RowPtr, {column} I - 1, {marker value} I - 1);
    CsvRowSetColumnMarker(RowPtr, {column} I, {marker value} COLUMN_ENDMARKER);
  end;
end;

function TJvCustomCsvDataSet.IsKeyUnique: Boolean;
  // Checks current row's key uniqueness. Note that FCsvKeyDef MUST be set!
begin
  Result := False; // not yet implemented! XXX
end;


function TJvCustomCsvDataSet.GetFieldValueAsVariant(CsvColumnData: PCsvColumn;
  Field: TField; RecordIndex: Integer): Variant;
var
  RowPtr: PCsvRow;
  {ActiveRowPtr: PCsvRow;}
  TempString: string;
  PhysicalLocation: Integer;
  L: Integer;
begin
  Assert(Assigned(FCsvColumns));

  if not Assigned(CsvColumnData) then
  begin
    JvCsvDatabaseError(FTableName, Format(RsEUnableToLocateCSVFileInfo, [Field.Name]));
    Exit;
  end;

  PhysicalLocation := CsvColumnData^.FPhysical;

  if (PhysicalLocation < 0) and FPendingCsvHeaderParse then
  begin
    FPendingCsvHeaderParse := False;
    ProcessCsvHeaderRow;
    PhysicalLocation := CsvColumnData^.FPhysical;
  end;

  if PhysicalLocation < 0 then
  begin
    JvCsvDatabaseError(FTableName, Format(RsEPhysicalLocationOfCSVField, [Field.FieldName]));
    Exit;
  end;

  RowPtr := FData[RecordIndex];

  TempString := GetCsvRowItem(RowPtr, PhysicalLocation);

  // Strip quotes first!
  if Field.DataType = ftString then
  begin
    L := Length(TempString);
    if L >= 2 then
      if (TempString[1] = '"') and (TempString[L] = '"') then
        TempString := _Dequote(TempString); // quoted string!
  end;

  try
    case Field.DataType of
      ftString:
        Result := TempString;
      ftInteger:
        Result := StrToInt(TempString);
      ftFloat:
        Result := StrToFloatUS(TempString);
      ftBoolean:
        if StrToIntDef(TempString, 0) <> 0 then
          Result := True
        else
          Result := False;
      ftDateTime:
         { one of three different datetime formats}
         if Length(TempString) > 0 then
           case CsvColumnData^.FFlag of
             jcsvAsciiDateTime:
               Result := TimeTAsciiToDateTime(TempString);
             jcsvGMTDateTime:
               Result := TimeTHexToDateTime(TempString,0);
             jcsvTZDateTime:
               Result := TimeTHexToDateTime(TempString, FTimeZoneCorrection);
           end;
    end;
  except
    Result := Unassigned; // No value.
  end;
end;

// Auto-increment

function TJvCustomCsvDataSet.GetAutoincrement(const FieldName: string): Integer;
var
  RecIndex: Integer;
  FieldLookup: TField;
  CsvColumnData: PCsvColumn;
  Max, Value: Integer;
  RowPtr: PCsvRow;
begin
  Result := -1; // failed.
  FieldLookup := FieldByName(FieldName);
  if FieldLookup.DataType <> ftInteger then
      Exit; // failed. Can only auto increment on integer fields!

  if not Assigned(FieldLookup) then
      Exit; //failed.

  CsvColumnData := FCsvColumns.FindByFieldNo(FieldLookup.FieldNo);
  Max := -1;
  for RecIndex := 0 to Self.FData.Count - 1 do
    try
       // skip filtered rows:
       RowPtr := FData[RecIndex];
       Assert(Assigned(RowPtr)); // FData should never contain nils!
       if RowPtr^.Filtered then
            Continue; // skip filtered row!

      Value := GetFieldValueAsVariant(CsvColumnData, FieldLookup, RecIndex);
      if Value > Max then
          Max := Value; // keep maximum.
    except
      on E: EVariantError do
        Exit; // failed.
    end;
  if Max < 0 then
    Result := 0 // autoincrement starts at zero
  else
    Result := Max + 1; // count upwards.
end;


// XXX TODO: REMOVE HARD CODED LIMIT OF 20 FIELDS SEARCHABLE!!!
function TJvCustomCsvDataSet.Locate(const KeyFields: string; const KeyValues: Variant;
  Options: TLocateOptions): Boolean; // override;
  // Options is    [loCaseInsensitive]
  //              or [loPartialKey]
  //              or [loPartialKey,loCaseInsensitive]
  //              or [] {none}
var
  KeyFieldArray: array [0..20] of string;
  FieldLookup: array [0..20] of TField;
  CsvColumnData: array [0..20] of PCsvColumn;
  FieldIndex: array [0..20] of Integer;
  RecIndex, I, Lo, Hi, Count, VarCount: Integer;
  Value: Variant;
  MatchCount: Integer;
  StrValueA, StrValueB: string;
  CompareResult: Boolean;
begin
  Result := False;
  Lo := -1;
//  Hi := -1;  // Value is never used

  if not Active then
    Exit;
  if Pos(',', KeyFields) > 0 then
    Count := StrSplit(KeyFields, ',', Chr(0), KeyFieldArray, 20)
  else
    Count := StrSplit(KeyFields, ';', Chr(0), KeyFieldArray, 20);

  (* Single value need not be an array type! *)
  if (VarType(KeyValues) and VarArray) > 0 then
  begin
    Lo := VarArrayLowBound(KeyValues, 1);
    Hi := VarArrayHighBound(KeyValues, 1);
    VarCount := (Hi - Lo) + 1;
  end
  else
    VarCount := 1;
  if VarCount <> Count then
    Exit;
  if Count = 0 then
    Exit;
  if KeyFieldArray[0] = '' then
    Exit;
  for I := 0 to 20 do
  begin
    if I < Count then
    begin
      FieldLookup[I] := FieldByName(KeyFieldArray[I]);
      CsvColumnData[I] := FCsvColumns.FindByFieldNo(FieldLookup[I].FieldNo);
      if not Assigned(FieldLookup[I]) then
        Exit;
      FieldIndex[I] := FieldLookup[I].Index;
    end
    else