jvqcsvdata.pas

East make Tray Icon in delphi

    end;
  end;

  // Now search
  // First;
  for RecIndex := 0 to Self.FData.Count - 1 do
  begin
    MatchCount := 0;
    for I := 0 to Count - 1 do
    begin
      Value := GetFieldValueAsVariant(CsvColumnData[I], FieldLookup[I], RecIndex);
      if Lo < 0 then // non-vararray!
        CompareResult := (Value = KeyValues)
      else // vararray!
        CompareResult := Value = KeyValues[I + Lo];

      if CompareResult then
        Inc(MatchCount)
      else
      if Options <> [] then
      begin
        if VarIsStr(Value) then
        begin
          StrValueA := Value;
          StrValueB := KeyValues[I + Lo];
          if loCaseInsensitive in Options then
          begin
            StrValueA := UpperCase(StrValueA);
            StrValueB := UpperCase(StrValueB);
          end;
          if StrValueA = StrValueB then
            Inc(MatchCount)
          else
          begin
            if loPartialKey in Options then
              if Pos(StrValueB, StrValueA) = 1 then
                Inc(MatchCount);
          end;
        end;
      end;
    end;
    if MatchCount = Count then
    begin
      RecNo := RecIndex; // Move cursor position.
      Result := True;
      Exit;
    end;
   // Next;
  end;
end;

function TJvCustomCsvDataSet.InternalSkipFiltered(DefaultResult: TGetResult;
  ForwardBackwardMode: Boolean): TGetResult;
var
  LimitReached: Boolean;
  RowPtr: PCsvRow;
begin
  Result := DefaultResult;
  if FRecordPos < 0 then
    Exit;
  LimitReached := False; // hit BOF or EOF?
  while not LimitReached do
  begin
    { no skippage required }
    RowPtr := PCsvRow(FData.GetRowPtr(FRecordPos));
    if not RowPtr^.Filtered then
      Exit;
    { skippage ensues }
    if ForwardBackwardMode then
    begin // ForwardSkip mode
      Inc(FRecordPos);
      if FRecordPos >= FData.Count then
      begin
        FRecordPos := ON_EOF_CRACK;
        Result := grEOF;
        Exit;
      end;
    end
    else
    begin // BackwardSkip mode
      Dec(FRecordPos);
      if FRecordPos < 0 then
      begin // hit BOF_CRACK
        FRecordPos := ON_BOF_CRACK;
        Result := grBOF;
        Exit;
      end;
    end;
  end;
end;


function TJvCustomCsvDataSet.GetRecord(Buffer: PChar; GetMode: TGetMode;
  DoCheck: Boolean): TGetResult;
var
  RowPtr: PCsvRow;
begin
  Buffer[0] := Chr(0);
  Result := grEOF;
  if FData.Count < 1 then
  begin
    //Trace(' GetRecord - called when Data buffer empty.');
    Exit;
  end;
  case GetMode of
    gmPrior:
      begin
        //Trace(' GetRecord( Buffer, gmPrior, DoCheck)');
        if FRecordPos = ON_BOF_CRACK then
          Result := grBOF
        else
        if FRecordPos = ON_EOF_CRACK then
        begin
          FRecordPos := FData.Count - 1;

          // NEW FILTERING
          if FIsFiltered then
            Result := InternalSkipFiltered(grOK, False) // skipping backwards.
          else
            Result := grOK;
        end
        else
        if FRecordPos > 0 then
        begin
          Dec(FRecordPos);

          // NEW FILTERING
          if FIsFiltered then
            Result := InternalSkipFiltered(grOK, False) // skipping backwards.
          else
            Result := grOK;
        end
        else
          Result := grBOF;
      end;
    gmCurrent:
      begin
         //Trace(' GetRecord( Buffer, gmCurrent, DoCheck)');
        if FRecordPos < 0 then // BOF Crack or EOF Crack?
          Result := grError
        else
          Result := grOK;

        // NEW FILTERING
        if FIsFiltered then
          Result := InternalSkipFiltered(Result, True); // skipping forwards.
      end;
    gmNext:
      begin
         //Trace(' GetRecord( Buffer, gmNext, DoCheck)');
        if FRecordPos = ON_EOF_CRACK then
          Result := grEOF
        else
        begin
          Inc(FRecordPos);

          if FRecordPos >= FData.Count then
          begin
            FRecordPos := ON_EOF_CRACK;
            Result := grEOF
          end
          else
          begin
            // NEW FILTERING
            if FIsFiltered then
              Result := InternalSkipFiltered(grOK, True) // skipping forwards.
            else
              Result := grOK;
          end;
        end;
      end;
  else
    JvCsvDatabaseError(FTableName, RsEGetMode);
  end;

  if Result = grOK then
  begin
    //Trace( ' GetRecord FRecordPos='+IntToStr(FRecordPos)+'Result=grOk' );
    try
      { get a record into a buffer }
      RowPtr := PCsvRow(Buffer); // Cast to a Row Data Structure to our own type.
      Move(FData.GetRowPtr(FRecordPos)^, RowPtr^, SizeOf(TJvCsvRow));
      RowPtr^.Bookmark.Flag := bfCurrent;
      RowPtr^.Bookmark.Data := FRecordPos;

      // Update calculated fields for this row:
      ClearCalcFields(Buffer);
      GetCalcFields(Buffer);
    except
      on E: EJvCsvDataSetError do
        raise; // pass our error through.
      on E: Exception do
        JvCsvDatabaseError(FTableName, Format(RsEProblemReadingRow, [FRecordPos]) +' ' + E.Message);
    end;
  end
  else
  begin
    // fudge: Get bookmark into a record for BOF and EOF records:
    { if RowPtr <> NIL then
        RowPtr^.bookmark.Data := FRecordPos;}

    if (Result = grError) and DoCheck then
      JvCsvDatabaseError(FTableName, RsENoRecord);
  end;

//    if (Result = grError) then
          //Trace(' GetRecord Result = grError');
//    if (Result = grEof) then
          //Trace(' GetRecord Result = grEof');
//     if (Result = grBof) then
          //Trace(' GetRecord Result = grBof');
end;

// puts whole string in quotes, escapes embedded commas and quote characters!
// Can optionally deal with newlines also.

function TJvCustomCsvDataSet._Enquote(const StrVal: string): string;
var
  S: string;
  I, L: Integer;
  Ch: Char;
  LocalEnquoteBackslash: Boolean;
begin
  LocalEnquoteBackslash := FEnquoteBackslash; // can force on, or let it turn on automatically.

  if Pos(StrVal, Cr) > 0 then // we are going to need to enquote the backslashes
    LocalEnquoteBackslash := True; // absolutely need it in just this case.
  if Pos(StrVal, Lf) > 0 then
    LocalEnquoteBackslash := True; // absolutely need it in just this case.

  S := '"';
  L := Length(StrVal);
  for I := 1 to L do
  begin
    Ch := StrVal[I];
    if Ch = Cr then
      // slighlty unstandard csv behavior, hopefully transparently interoperable with other apps that read CSVs
      S := S + '\r'
    else
    if Ch = Lf then // replace linefeed with \n. slightly nonstandard csv behavior.
      S := S + '\n'
    else
    if LocalEnquoteBackslash and (Ch = '\') then
    begin // it would be ambiguous not to escape this in this case!
      S := S + '\\';
      FEnquoteBackslash := True; // XXX This is a lurking bug. Some day we'll get bit by it.
    end
    else
    if Ch = '"' then // always escape quotes by doubling them, since this is standard CSV behaviour
      S := S + '""'
    else
    if Ch = Tab then
      S := S + Ch // keep tabs! NEW Sept 2004! WP.
    else
    if Ch >= ' ' then // strip any other low-ascii-unprintables!
      S := S + Ch;
  end;
  S := S + '"'; // end quote.
  Result := S;
end;

function TJvCustomCsvDataSet.GetRecordSize: Word;
begin
 // In create:
 //    FRecordSize := SizeOf(TJvCsvRow) - SizeOf(TJvCsvBookmark);
  Result := FRecordSize;
end;

procedure TJvCustomCsvDataSet.SetFieldData(Field: TField; Buffer: Pointer);
var
  RowPtr: PCsvRow;
  NewVal: string;
  CP, PhysicalLocation: Integer;
  PDestination: PChar;
  CsvColumnData: PCsvColumn;
  DT: TDateTime;
begin
  //Trace( 'SetFieldData '+Field.FieldName );
  PDestination := GetActiveRecordBuffer;
  RowPtr := PCsvRow(PDestination);

  // Dynamic CSV Column Ordering: If we didn't start by
  // assigning column orders when we opened the table,
  // we've now GOT to assume a physical ordering:
  if FHeaderRow = '' then
  begin
    FHeaderRow := GetColumnsAsString;
    ProcessCsvHeaderRow; // process FHeaderRow
  end;

  // If this is a calculated field or lookup field then...
  if (Field.FieldKind = fkCalculated) or (Field.FieldKind = fkLookup) then
  begin
    if (Field.Offset < 0) or (Field.Offset + Field.DataSize > MaxCalcDataOffset) then
    begin
      // (rom) no OutputDebugString in production code
      {$IFDEF DEBUGINFO_ON}
      OutputDebugString(PChar('JvCsvData.pas: ' + Name + '.SetFieldData(Field=' +
        Field.FieldName + ',...): Invalid field.Offset in Calculated or Lookup field. '));
      {$ENDIF DEBUGINFO_ON}
      Exit;
    end;
    Inc(PDestination, SizeOf(TJvCsvRow) + Field.Offset);
    PDestination[0] := Char(Ord(Buffer <> nil));
    if PDestination[0] <> #0 then
      CopyMemory(@PDestination[1], Buffer, Field.DataSize);
    //Result := True; {there is no return value, oops}
    Exit;
  end;

  // If we get here, we are dealing with a physical record:

  // Set a field Data, taking the physical to logical ordering translation into
  // account:
  CsvColumnData := FCsvColumns.FindByFieldNo(Field.FieldNo);
  if not Assigned(CsvColumnData) then
    Exit;

  PhysicalLocation := CsvColumnData^.FPhysical;
  // ----- BUG FIX FEB 2004 WP (Location #1 of 2)
  if (PhysicalLocation < 0) and FPendingCsvHeaderParse then
  begin
    FPendingCsvHeaderParse := False; // Just-in-time-CSV-header-parsing fixes a long standing bug.
    ProcessCsvHeaderRow;
    PhysicalLocation := CsvColumnData^.FPhysical;
  end;
  // ----- end

  if PhysicalLocation < 0 then
    Exit;

  if Buffer = nil then
    NewVal := ''
  else
    case Field.DataType of
      ftString:
        begin
            // Copy 0 to Field.Size bytes into NewVal (delphi String)
          if PChar(Buffer)[0] = Chr(0) then
            CP := -1
          else
            for CP := 1 to Field.Size - 1 do
              if PChar(Buffer)[CP] = Chr(0) then
                Break;
          if CP > Field.Size - 1 then
            CP := Field.Size - 1;
          NewVal := Copy(PChar(Buffer), 1, CP + 1);
          //----------------------------------------------------------------------------------------------------
          // NEW RULE: If user displayed value contains a comma, a backslash, or a double quote character
          // then we MUST encode the whole string as a string literal in quotes with the embeddded quotes
          // and backslashes preceded by a backslash character.
          //----------------------------------------------------------------------------------------------------
          if (Pos(Separator, NewVal) > 0) or  (Pos(Cr, NewVal) > 0) or
            (Pos(Lf, NewVal) > 0) or (Pos('"', NewVal) > 0) or
            ((Pos('\', NewVal) > 0) and FEnquoteBackslash) then
            NewVal := _Enquote(NewVal); // puts whole string in quotes, escapes embedded commas and quote characters!
        end;
      ftInteger:
        NewVal := IntToStr(PInteger(Buffer)^);
      ftFloat:
        NewVal := FloatToStr(PDouble(Buffer)^);
      ftBoolean:
        NewVal := IntToStr(Ord(PWordBool(Buffer)^)); // bugfix May 26, 2003 - WP
      // There are two ways of handling date and time:
      ftDateTime:
        case CsvColumnD