jvcsvdata.pas

East make Tray Icon in delphi

procedure JvCsvDatabaseError(const TableName, Msg: string);
begin
  // (rom) no OutputDebugString in production code
  {$IFDEF DEBUGINFO_ON}
  OutputDebugString(PChar('JvCsvDatabaseError in ' + TableName + ': ' + Msg));
  {$ENDIF DEBUGINFO_ON}
  raise EJvCsvDataSetError.CreateResFmt(@RsECsvErrFormat, [TableName, Msg]);
end;

// note that file is not being locked!

constructor TJvCustomCsvDataSet.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FSeparator := ',';
  FCreatePaths := True; // Creates subdirectories automatically when saving.

  FInitialWorkingDirectory := GetCurrentDir; // from SysUtils;

  FTempBuffer := AllocMem(MAXLINELENGTH + 1); // AllocMem fills with zeros

  // FRecordSize = size of a csv text buffer and the indexes pointing
  //               into that buffer:

  FRecordSize := SizeOf(TJvCsvRow) - SizeOf(TJvCsvBookmark);

  // FBuffer size includes CSV Text buffer, and the bookmark Data, followed
  // by space for storing the binary form of a calculated-field:

  // initial FBufferSize size: My theory is that we should pick a conservative
  // estimate plus a margin for error:

  FBufferSize := SizeOf(TJvCsvRow) + MaxCalcDataOffset; //;128; {CalcFieldsSize}
  //; // our regular record + calculated field Data.

  FReadOnly := False;
  FCursorOpen := False;
  FRecordPos := ON_BOF_CRACK;
  FLoadsFromFile := True;
  FSavesChanges := True;
  FHasHeaderRow := True;
  FValidateHeaderRow := True;

  { Additional initialization }
  FCsvColumns := TJvCsvColumns.Create;
  FData := TJvCsvRows.Create;
  FData.EnquoteBackslash := FEnquoteBackslash;
end;

destructor TJvCustomCsvDataSet.Destroy;
begin
  InternalClearFileStrings; // delete file strings
  FreeMem(FTempBuffer); // Free the memory we allocated.
  FTempBuffer := nil;

  try
    if FCursorOpen then
      InternalClose;
  except
  end;
  if Assigned(FCsvColumns) then
  begin
    FCsvColumns.Clear;
    FCsvColumns.Free;
  end;
  if Assigned(FData) then
  begin
    FData.Clear;
    FData.Free;
  end;
  inherited Destroy;
end;

// Each ROW Record has an internal Data pointer (similar to the
// user-accessible 'Data: Pointer' stored in treeviews, etc)

function TJvCustomCsvDataSet.GetRowUserData: Pointer;
var
  RecNo: Integer;
begin
  RecNo := GetRecNo;
  Result := FData.GetUserData(RecNo);
end;

procedure TJvCustomCsvDataSet.SetRowUserData(UserData: Pointer);
var
  RecNo: Integer;
begin
  RecNo := GetRecNo;
  FData.SetUserData(RecNo, UserData);
end;

function TJvCustomCsvDataSet.GetRowTag: Integer;
var
  RecNo: Integer;
begin
  RecNo := GetRecNo;
  Result := FData.GetUserTag(RecNo);
end;

procedure TJvCustomCsvDataSet.SetRowTag(TagValue: Integer);
var
  RecNo: Integer;
begin
  RecNo := GetRecNo;
  FData.SetUserTag(RecNo, TagValue);
end;

function _WildcardsMatchBoolOp(const Data, Pattern: string; BoolOp: Char): Boolean;
var
  SubPattern: array [0..20] of string;
  I, Count: Integer;
begin
  Count := StrSplit(Pattern, BoolOp, {Chr(0)=No Quoting} Chr(0), SubPattern, 20);
  if Count > 0 then
  begin
    for I := 0 to Count - 1 do
    begin
      Result := JvCsvWildcardMatch(Data, SubPattern[I]);
      // If ANY OR True return True;
      // if ANY AND False return False;
      if (BoolOp = '|') = Result then
        Exit;
    end;
  end
  else
  begin // split failed...
    Result := False;
    Exit;
  end;
  // if we get here, no short circuit was possible.
  if BoolOp = '|' then
    Result := False // NONE of the OR conditions were met!
  else
    Result := True; // ALL of the AND condition were met!
end;

procedure TJvCustomCsvDataSet.SetAllUserTags(TagValue: Integer);
var
  I: Integer;
begin
  FData.SetUserTag(FData.Count - 1, TagValue);
  for I := 0 to FData.Count - 2 do
    FData.SetUserTag(I, TagValue);
end;

procedure TJvCustomCsvDataSet.SetAllUserData(Data: Pointer);
var
  I: Integer;
begin
  FData.SetUserData(FData.Count - 1, Data); // Optimization. Ensures we only call SetLength ONCE!
  for I := 0 to FData.Count - 2 do
    FData.SetUserData(I, Data);
end;

function TJvCustomCsvDataSet.GetUserTag(RecNo: Integer): Integer;
begin
  Result := FData.GetUserTag(RecNo);
end;

procedure TJvCustomCsvDataSet.SetUserTag(RecNo, NewValue: Integer);
begin
  FData.SetUserTag(RecNo, NewValue);
end;

function TJvCustomCsvDataSet.GetUserData(RecNo: Integer): Pointer;
begin
  Result := FData.GetUserData(RecNo);
end;

procedure TJvCustomCsvDataSet.SetUserData(RecNo: Integer; NewValue: Pointer);
begin
  FData.SetUserData(RecNo, NewValue);
end;

// Recursive wildcard matching function

function JvCsvWildcardMatch(Data, Pattern: string): Boolean;
var
  I: Integer;
  FirstWildcard: Integer;
  DataLength, PatternLength, DataPosition, PatternPosition: Integer;
  FirstBoolCondition: Integer;
begin
  Result := True;
  PatternLength := Length(Pattern);
  if PatternLength = 0 then
    Exit;
  // no Data?
  DataLength := Length(Data);
  if DataLength = 0 then
  begin
    Result := (Pattern = '%') or (Pattern = '');
    Exit; // definitely no match.
  end;
  // replace all '%%' -> '%' (don't put duplicate wildcards in)
  I := 1;
  while I < PatternLength do
    if (Pattern[I] = '%') and (Pattern[I + 1] = '%') then
    begin
      Pattern := Copy(Pattern, 1, I) + Copy(Pattern, I + 2, PatternLength);
      PatternLength := Length(Pattern);
    end
    else
      Inc(I);
  // find any | and split into two or more strings, and run ORs on them
  FirstBoolCondition := Pos('&', Pattern);
  if FirstBoolCondition > 0 then
  begin
    Result := _WildcardsMatchBoolOp(Data, Pattern, '&');
    Exit;
  end;
  FirstBoolCondition := Pos('|', Pattern);
  if FirstBoolCondition > 0 then
  begin
    Result := _WildcardsMatchBoolOp(Data, Pattern, '|');
    Exit;
  end;

  FirstWildcard := Pos('%', Pattern); // wildcards?
  if FirstWildcard = 0 then
    FirstWildcard := Pos('?', Pattern); // other wildcard.

  if FirstWildcard <= 0 then
  begin // no wildcard case.
    if Data = Pattern then
      Result := True
    else
      Result := False;
    Exit; // simple match returns immediately.
  end;
  // wildcard tail?
  if (FirstWildcard = PatternLength) and (Pattern[1] <> '?') then
  begin // prefix match
    if Copy(Data, 1, PatternLength - 1) = Copy(Pattern, 1, PatternLength - 1) then
      Result := True
    else
      Result := False;
    Exit; // tail case is easy!
  end;
  // match literal characters until we hit wildcards,
  // then search for a wildcard resync, which continues
  // recursively.
  Result := True;
  DataPosition := 1;
  PatternPosition := 1;
  while (DataPosition <= DataLength) and (PatternPosition <= PatternLength) do
  begin
    // WILDCARD HANDLER
    if Pattern[PatternPosition] = '?' then
    begin // match any one character or nothing.
      Inc(PatternPosition);
      Inc(DataPosition);
    end
    else
    if Pattern[PatternPosition] = '%' then
    begin
      if PatternPosition = PatternLength then
      begin // last byte!
        Result := True;
        Exit;
      end;
       // Resync after %:
      I := Pos(Pattern[PatternPosition + 1], Data);
      while I > 0 do
      begin // possible resync point!
        Result := JvCsvWildcardMatch(Copy(Data, I, Length(Data)),
          Copy(Pattern, PatternPosition + 1, PatternLength));
        if Result then
          Exit; // found a resync, and rest of strings match
        Data := Copy(Data, I + 1, DataLength);
        DataLength := Length(Data);
        // DataPosition := 0;
        if DataLength = 0 then
        begin
          Result := False;
          Exit;
        end;
        I := Pos(Pattern[PatternPosition + 1], Data);
      end;
      // failed to resync
      Result := False;
      Exit;
    end
    else
    begin // NORMAL CHARACTER
      if Data[DataPosition] <> Pattern[PatternPosition] then
      begin
        Result := False; // failed.
        Exit;
      end;
      Inc(DataPosition);
      Inc(PatternPosition);
    end;
  end;
  if (DataPosition <= DataLength) and (PatternPosition <= PatternLength) then
    Result := False; // there is pattern left over, or Data left over.
end;

// NEW: TJvCustomCsvDataSet.SetFilter
//
// XXX Simplest possible filtering routine. Not very flexible.
// XXX Todo: Make this more flexible.
// XXX Users can also subclass and write their own filter.
// XXX Perhaps a OnFilter event should be provided, and SetCustomFilter
// XXX method would allow us to do a row by row filtering scan, and then
// XXX hide rows that the user sets HideRow := True in the event handler.
// XXX

{ New: Custom Filtering }

procedure TJvCustomCsvDataSet.CustomFilter(FilterCallback: TJvCustomCsvDataSetFilterFunction);
var
  I: Integer;
  PRow: PCsvRow;
begin
  Assert(Assigned(FilterCallback));
  // Now check if field value matches given pattern for this row.
  for I := 0 to FData.Count - 1 do
  begin
    PRow := PCsvRow(FData[I]);
    Assert(Assigned(PRow));
    // if custom function returns False, hide the row.
    PRow^.Filtered  := not FilterCallback(I);
  end;
  FIsFiltered := True;
  if Active then
    First;
end;


procedure TJvCustomCsvDataSet.SetFilterOnNull(const FieldName: string; NullFlag: Boolean);
var
  I: Integer;
  PRow: PCsvRow;
  FieldRec: PCsvColumn;
  FieldIndex: Integer;
  FieldValue: string;
begin
  FieldRec := FCsvColumns.FindByName(FieldName);

  if not Assigned(FieldRec) then
    Exit;
  FieldIndex := FieldRec^.FPhysical;

  // Now filter out if IsNull matches NullFlag
  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) = NullFlag then
        PRow^.Filtered := True;
    end;
  end;
  FIsFiltered := True;
  if Active then
    First;
end;

// Make Rows Visible Only if they match filterString

procedure TJvCustomCsvDataSet.SetFilter(const FieldName: string; Pattern: string);
var
  ValueLen, I: Integer;
  PRow: PCsvRow;
  FieldRec: PCsvColumn;
  FieldIndex: Integer;