unit CSVReader;

interface

uses
  Windows, Classes, SysUtils;

type
  TTextLines        = pointer;
  TProgressEvent      = procedure(Progress:integer) of object;

  TCSVDataSet   = class(TObject)
  private
    FDecChar  : Char;
    FFileLines: TTextLines;
    FFileName : string;
    FRowCount : integer;
    FColCount : integer;
    FOnProgress : TProgressEvent;
    (* TODO: create hash table, store at least 100 strings *)
    FCachedLine : record
      Number  : integer;
      Data  : TStringList;
    end;
    function  RowInCache(Row:integer):TStringList;
    function  CacheLine(Row:integer):TStringList;
    function  GetColCount:integer;
    function  GetRowCount:integer;
    function  GetCellData(Col,Row:integer):string;
    function  GetCellValue(Col,Row:integer):Extended;
    procedure SetOnProgress(Progress:TProgressEvent);
    function  GetOnProgress:TProgressEvent;
  public
    constructor Create;
    destructor  Destroy;override;
    procedure Free;
    function  SetData(FileName:string):Boolean;
    property  OnProgress:TProgressEvent read GetOnProgress write SetOnProgress;
    property  Cells[ACol,ARow:integer]:string read GetCellData;
    property  Values[ACol,ARow:integer]:Extended read GetCellValue;
    property  RowCount:integer read GetRowCount;
    property  ColCount:integer read GetColCount;
  end;


implementation

type
  TTextIndexingCallback = procedure(Progress:integer;Sender:TObject);stdcall;

function  textOpen(FileName:PChar;Progress:TTextIndexingCallback;Sender:TObject):TTextLines;stdcall;external 'txtlines.dll';
function  textLineCount(Lines:TTextLines):integer;stdcall;external 'txtlines.dll';
function  textLineLen(Lines:TTextLines;LineNumber:integer):integer;stdcall;external 'txtlines.dll';
function  textLine(Lines:TTextLines;LineNumber:integer;Buffer:PChar;BufferLen:integer):integer;stdcall;external 'txtlines.dll';
procedure textClose(Lines:TTextLines);stdcall;external 'txtlines.dll';

function  TCSVDataSet.RowInCache(Row:integer):TStringList;
begin
  if Row=FCachedLine.Number then
    Result:=FCachedLine.Data
  else
    Result:=nil;
end;

function  TCSVDataSet.CacheLine(Row:integer):TStringList;
var
  Buffer  : PChar;
  Ptr     : PChar;
  Trail   : PChar;
  Len     : integer;
  Token   : string;
begin
  FCachedLine.Data.Clear;
  Len:=textLineLen(FFileLines,Row)+4;
  GetMem(Buffer,Len);
  Len:=textLine(FFileLines,Row,Buffer,Len);
  Ptr:=Buffer;
  Trail:=Buffer+Len;
  (* Parse all values *)
  while Ptr < Trail do
  begin
    (* Skip leading whitespace *)
    while ((Ord(Ptr^) <= 32) or (Ptr^=';')) and (Ptr<=Trail) do
      Ptr:=Ptr+1;
    (* Extract next token *)
    if (Ptr^='.') or (Ptr^=FDecChar) then
      Token:='0'
    else
      Token:='';
    while ((Ord(Ptr^) > 32) and (Ptr^<>';')) and (Ptr<=Trail) do
    begin
      if Ptr^='.' then
        Token:=Token+FDecChar
      else
        Token:=Token+Ptr^;
      Ptr:=Ptr+1;
    end;
    if Length(Token)>0 then
      FCachedLine.Data.Add(Token);
  end;
  Result:=FCachedLine.Data;
  FCachedLine.Number:=Row;
  RowInCache(Row);
end;

function TCSVDataSet.GetRowCount:integer;
begin
  Result:=FRowCount;
end;

function TCSVDataSet.GetColCount:integer;
begin
  Result:=FColCount;
end;

function TCSVDataSet.GetCellData(Col,Row:integer):string;
var
  List  : TStringList;
begin
  if (Col>FColCount) or (Row>FRowCount) then
  begin
    Result:='';       (* TODO: throw exception *)
    Exit;
  end;
  List:=RowInCache(Row);
  if List=nil then    (* Cache miss; load data from disk *)
    List:=CacheLine(Row);
  if List=nil then    (* Wrong line number ? *)
    Result:=''        (* TODO: throw exception *)
  else
    Result:=List.Strings[Col];
end;

function TCSVDataSet.GetCellValue(Col,Row:integer):Extended;
begin
  Result:=StrToFloat(GetCellData(Col,Row));
end;

procedure TCSVDataSet.SetOnProgress(Progress:TProgressEvent);
begin
  FOnProgress:=Progress;
end;

function  TCSVDataSet.GetOnProgress:TProgressEvent;
begin
  Result:=FOnProgress;
end;

constructor TCSVDataSet.Create;
var
  FloatStr : string;
begin
  inherited Create;
  FFileLines:=nil;
  FFileName:='';
  FRowCount:=-1;
  FColCount:=-1;
  FOnProgress:=nil;
  FCachedLine.Number:=-1;
  FloatStr:=FloatToStr(0.1);
  FDecChar:=FloatStr[2];
  FCachedLine.Data:=TStringList.Create;
end;

destructor  TCSVDataSet.Destroy;
begin
  if FFileLines<>nil then
    textClose(FFileLines);
  FCachedLine.Data.Free;
  inherited Destroy;
end;

procedure TCSVDataSet.Free;
begin
  if Self<>nil then
    Destroy;
end;

procedure ProgressCallBack(Value:integer;Sender:TObject);stdcall;
var
  Self    : TCSVDataSet;
begin
  Self:=Sender as TCSVDataSet;
  Self.OnProgress(Value);
end;

function  TCSVDataSet.SetData(FileName:string):Boolean;
var
  FirstRow : TStringList;
begin
  if FFileLines<>nil then
  begin
    textClose(FFileLines);
    FFileLines:=nil;
  end;
  if @FOnProgress<>nil then
    FFileLines:=textOpen(PChar(FileName),ProgressCallback,Self)
  else
    FFileLines:=textOpen(PChar(FileName),nil,nil);
  if FFileLines<>nil then
  begin
    FirstRow:=CacheLine(0);
    if FirstRow<>nil then
    begin
      FFileName:=FileName;
      FRowCount:=textLineCount(FFileLines);
      FColCount:=FirstRow.Count;
      Result:=True;
      Exit;
    end;
  end;
  Result:=False;
  if FFileLines<>nil then
  begin
    textClose(FFileLines);
    FFileLines:=nil;
  end;
end;

end.
