Jelajahi Sumber

Add forgotten files

Reinier Olislagers 11 tahun lalu
induk
melakukan
d1851f4e04
4 mengubah file dengan 2301 tambahan dan 0 penghapusan
  1. 1105 0
      csvdocument.pas
  2. 507 0
      fileimport.pas
  3. 324 0
      importtable.lfm
  4. 365 0
      importtable.pas

+ 1105 - 0
csvdocument.pas

@@ -0,0 +1,1105 @@
+{
+  CSV Parser, Builder and Document classes.
+  Version 0.5 2012-09-20
+
+  Copyright (C) 2010-2012 Vladimir Zhirov <[email protected]>
+
+  Contributors:
+    Luiz Americo Pereira Camara
+    Mattias Gaertner
+    Reinier Olislagers
+
+  This library is free software; you can redistribute it and/or modify it
+  under the terms of the GNU Library General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or (at your
+  option) any later version with the following modification:
+
+  As a special exception, the copyright holders of this library give you
+  permission to link this library with independent modules to produce an
+  executable, regardless of the license terms of these independent modules,and
+  to copy and distribute the resulting executable under terms of your choice,
+  provided that you also meet, for each linked independent module, the terms
+  and conditions of the license of that module. An independent module is a
+  module which is not derived from or based on this library. If you modify
+  this library, you may extend this exception to your version of the library,
+  but you are not obligated to do so. If you do not wish to do so, delete this
+  exception statement from your version.
+
+  This program is distributed in the hope that it will be useful, but WITHOUT
+  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+  FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
+  for more details.
+
+  You should have received a copy of the GNU Library General Public License
+  along with this library; if not, write to the Free Software Foundation,
+  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+
+unit CsvDocument;
+
+{$IFDEF FPC}
+  {$MODE DELPHI}
+{$ENDIF}
+
+interface
+
+uses
+  Classes, SysUtils, Contnrs, StrUtils;
+
+type
+  {$IFNDEF FPC}
+  TFPObjectList = TObjectList;
+  {$ENDIF}
+
+  TCSVChar = Char;
+
+  TCSVHandler = class(TObject)
+  private
+    procedure SetDelimiter(const AValue: TCSVChar);
+    procedure SetQuoteChar(const AValue: TCSVChar);
+    procedure UpdateCachedChars;
+  protected
+    // special chars
+    FDelimiter: TCSVChar;
+    FQuoteChar: TCSVChar;
+    FLineEnding: String;
+    // cached values to speed up special chars operations
+    FSpecialChars: TSysCharSet;
+    FDoubleQuote: String;
+    // parser settings
+    FIgnoreOuterWhitespace: Boolean;
+    // builder settings
+    FQuoteOuterWhitespace: Boolean;
+    // document settings
+    FEqualColCountPerRow: Boolean;
+  public
+    constructor Create;
+    procedure AssignCSVProperties(ASource: TCSVHandler);
+    // Delimiter that separates the field, e.g. comma, semicolon, tab
+    property Delimiter: TCSVChar read FDelimiter write SetDelimiter;
+    // Character used to quote "problematic" data
+    // (e.g. with delimiters or spaces in them)
+    // A common quotechar is "
+    property QuoteChar: TCSVChar read FQuoteChar write SetQuoteChar;
+    // String at the end of the line of data (e.g. CRLF)
+    property LineEnding: String read FLineEnding write FLineEnding;
+    // Ignore whitespace between delimiters and field data
+    property IgnoreOuterWhitespace: Boolean read FIgnoreOuterWhitespace write FIgnoreOuterWhitespace;
+    // Use quotes when outer whitespace is found
+    property QuoteOuterWhitespace: Boolean read FQuoteOuterWhitespace write FQuoteOuterWhitespace;
+    // When reading and writing: make sure every line has the same column count, create empty cells in the end of row if required
+    property EqualColCountPerRow: Boolean read FEqualColCountPerRow write FEqualColCountPerRow;
+  end;
+
+  // Sequential input from CSV stream
+  TCSVParser = class(TCSVHandler)
+  private
+    // fields
+    FSourceStream: TStream;
+    FStrStreamWrapper: TStringStream;
+    // parser state
+    EndOfFile: Boolean;
+    EndOfLine: Boolean;
+    FCurrentChar: TCSVChar;
+    FCurrentRow: Integer;
+    FCurrentCol: Integer;
+    FMaxColCount: Integer;
+    // output buffers
+    FCellBuffer: String;
+    FWhitespaceBuffer: String;
+    procedure ClearOutput;
+    // basic parsing
+    procedure SkipEndOfLine;
+    procedure SkipDelimiter;
+    procedure SkipWhitespace;
+    procedure NextChar;
+    // complex parsing
+    procedure ParseCell;
+    procedure ParseQuotedValue;
+    // simple parsing
+    procedure ParseValue;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    // Source data stream
+    procedure SetSource(AStream: TStream); overload;
+    // Source data string
+    procedure SetSource(const AString: String); overload;
+    // Rewind to beginning of data
+    procedure ResetParser;
+    // Read next cell data; return false if end of file reached
+    function  ParseNextCell: Boolean;
+    // Current row (0 based)
+    property CurrentRow: Integer read FCurrentRow;
+    // Current column (0 based); -1 if invalid/before beginning of file
+    property CurrentCol: Integer read FCurrentCol;
+    // Data in current cell
+    property CurrentCellText: String read FCellBuffer;
+    // The maximum number of columns found in the stream:
+    property MaxColCount: Integer read FMaxColCount;
+  end;
+
+  // Sequential output to CSV stream
+  TCSVBuilder = class(TCSVHandler)
+  private
+    FOutputStream: TStream;
+    FDefaultOutput: TMemoryStream;
+    FNeedLeadingDelimiter: Boolean;
+    function GetDefaultOutputAsString: String;
+  protected
+    procedure AppendStringToStream(const AString: String; AStream: TStream);
+    function  QuoteCSVString(const AValue: String): String;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    // Set output/destination stream.
+    // If not called, output is sent to DefaultOutput
+    procedure SetOutput(AStream: TStream);
+    // If using default stream, reset output to beginning.
+    // If using user-defined stream, user should reposition stream himself
+    procedure ResetBuilder;
+    // Add a cell to the output with data AValue
+    procedure AppendCell(const AValue: String);
+    // Write end of row to the output, starting a new row
+    procedure AppendRow;
+    // Default output as memorystream (if output not set using SetOutput)
+    property DefaultOutput: TMemoryStream read FDefaultOutput;
+    // Default output in string format (if output not set using SetOutput)
+    property DefaultOutputAsString: String read GetDefaultOutputAsString;
+  end;
+
+  // Random access to CSV document. Reads entire document into memory.
+  TCSVDocument = class(TCSVHandler)
+  private
+    FRows: TFPObjectList;
+    FParser: TCSVParser;
+    FBuilder: TCSVBuilder;
+    // helpers
+    procedure ForceRowIndex(ARowIndex: Integer);
+    function  CreateNewRow(const AFirstCell: String = ''): TObject;
+    // property getters/setters
+    function  GetCell(ACol, ARow: Integer): String;
+    procedure SetCell(ACol, ARow: Integer; const AValue: String);
+    function  GetCSVText: String;
+    procedure SetCSVText(const AValue: String);
+    function  GetRowCount: Integer;
+    function  GetColCount(ARow: Integer): Integer;
+    function  GetMaxColCount: Integer;
+  public
+    constructor Create;
+    destructor  Destroy; override;
+
+    // Input/output
+
+    // Load document from file AFileName
+    procedure LoadFromFile(const AFilename: String);
+    // Load document from stream AStream
+    procedure LoadFromStream(AStream: TStream);
+    // Save document to file AFilename
+    procedure SaveToFile(const AFilename: String);
+    // Save document to stream AStream
+    procedure SaveToStream(AStream: TStream);
+
+    // Row and cell operations
+
+    // Add a new row and a cell with content AFirstCell
+    procedure AddRow(const AFirstCell: String = '');
+    // Add a cell at row ARow with data AValue
+    procedure AddCell(ARow: Integer; const AValue: String = '');
+    // Insert a row at row ARow with first cell data AFirstCell
+    // If there is no row ARow, insert row at end
+    procedure InsertRow(ARow: Integer; const AFirstCell: String = '');
+    // Insert a cell at specified position with data AValue
+    procedure InsertCell(ACol, ARow: Integer; const AValue: String = '');
+    // Remove specified row
+    procedure RemoveRow(ARow: Integer);
+    // Remove specified cell
+    procedure RemoveCell(ACol, ARow: Integer);
+    // Indicates if there is a row at specified position
+    function  HasRow(ARow: Integer): Boolean;
+    // Indicates if there is a cell at specified position
+    function  HasCell(ACol, ARow: Integer): Boolean;
+    
+    // Search
+    
+    // Return column for cell data AString at row ARow
+    function  IndexOfCol(const AString: String; ARow: Integer): Integer;
+    // Return row for cell data AString at coloumn ACol
+    function  IndexOfRow(const AString: String; ACol: Integer): Integer;
+
+    // Utils
+
+    // Remove all data
+    procedure Clear;
+    // Copy entire row ARow to row position AInsertPos.
+    // Adds empty rows if necessary
+    procedure CloneRow(ARow, AInsertPos: Integer);
+    // Exchange contents of the two specified rows
+    procedure ExchangeRows(ARow1, ARow2: Integer);
+    // Rewrite all line endings within cell data to LineEnding
+    procedure UnifyEmbeddedLineEndings;
+    // Remove empty cells at end of rows from entire document
+    procedure RemoveTrailingEmptyCells;
+
+    // Properties
+
+    // Cell data at column ACol, row ARow.
+    property Cells[ACol, ARow: Integer]: String read GetCell write SetCell; default;
+    // Number of rows
+    property RowCount: Integer read GetRowCount;
+    // Number of columns for row ARow
+    property ColCount[ARow: Integer]: Integer read GetColCount;
+    // Maximum number of columns found in all rows in document
+    property MaxColCount: Integer read GetMaxColCount;
+    // Document formatted as CSV text
+    property CSVText: String read GetCSVText write SetCSVText;
+  end;
+
+implementation
+
+const
+  CsvCharSize = SizeOf(TCSVChar);
+  CR    = #13;
+  LF    = #10;
+  HTAB  = #9;
+  SPACE = #32;
+  WhitespaceChars = [HTAB, SPACE];
+  LineEndingChars = [CR, LF];
+
+// The following implementation of ChangeLineEndings function originates from
+// Lazarus CodeTools library by Mattias Gaertner. It was explicitly allowed
+// by Mattias to relicense it under modified LGPL and include into CsvDocument.
+
+function ChangeLineEndings(const AString, ALineEnding: String): String;
+var
+  I: Integer;
+  Src: PChar;
+  Dest: PChar;
+  DestLength: Integer;
+  EndingLength: Integer;
+  EndPos: PChar;
+begin
+  if AString = '' then
+    Exit(AString);
+  EndingLength := Length(ALineEnding);
+  DestLength := Length(AString);
+
+  Src := PChar(AString);
+  EndPos := Src + DestLength;
+  while Src < EndPos do
+  begin
+    if (Src^ = CR) then
+    begin
+      Inc(Src);
+      if (Src^ = LF) then
+      begin
+        Inc(Src);
+        Inc(DestLength, EndingLength - 2);
+      end else
+        Inc(DestLength, EndingLength - 1);
+    end else
+    begin
+      if (Src^ = LF) then
+        Inc(DestLength, EndingLength - 1);
+      Inc(Src);
+    end;
+  end;
+
+  SetLength(Result, DestLength);
+  Src := PChar(AString);
+  Dest := PChar(Result);
+  EndPos := Dest + DestLength;
+  while (Dest < EndPos) do
+  begin
+    if Src^ in LineEndingChars then
+    begin
+      for I := 1 to EndingLength do
+      begin
+        Dest^ := ALineEnding[I];
+        Inc(Dest);
+      end;
+      if (Src^ = CR) and (Src[1] = LF) then
+        Inc(Src, 2)
+      else
+        Inc(Src);
+    end else
+    begin
+      Dest^ := Src^;
+      Inc(Src);
+      Inc(Dest);
+    end;
+  end;
+end;
+
+{ TCSVHandler }
+
+procedure TCSVHandler.SetDelimiter(const AValue: TCSVChar);
+begin
+  if FDelimiter <> AValue then
+  begin
+    FDelimiter := AValue;
+    UpdateCachedChars;
+  end;
+end;
+
+procedure TCSVHandler.SetQuoteChar(const AValue: TCSVChar);
+begin
+  if FQuoteChar <> AValue then
+  begin
+    FQuoteChar := AValue;
+    UpdateCachedChars;
+  end;
+end;
+
+procedure TCSVHandler.UpdateCachedChars;
+begin
+  FDoubleQuote := FQuoteChar + FQuoteChar;
+  FSpecialChars := [CR, LF, FDelimiter, FQuoteChar];
+end;
+
+constructor TCSVHandler.Create;
+begin
+  inherited Create;
+  FDelimiter := ',';
+  FQuoteChar := '"';
+  FLineEnding := CR + LF;
+  FIgnoreOuterWhitespace := False;
+  FQuoteOuterWhitespace := True;
+  FEqualColCountPerRow := True;
+  UpdateCachedChars;
+end;
+
+procedure TCSVHandler.AssignCSVProperties(ASource: TCSVHandler);
+begin
+  FDelimiter := ASource.FDelimiter;
+  FQuoteChar := ASource.FQuoteChar;
+  FLineEnding := ASource.FLineEnding;
+  FIgnoreOuterWhitespace := ASource.FIgnoreOuterWhitespace;
+  FQuoteOuterWhitespace := ASource.FQuoteOuterWhitespace;
+  FEqualColCountPerRow := ASource.FEqualColCountPerRow;
+  UpdateCachedChars;
+end;
+
+{ TCSVParser }
+
+procedure TCSVParser.ClearOutput;
+begin
+  FCellBuffer := '';
+  FWhitespaceBuffer := '';
+  FCurrentRow := 0;
+  FCurrentCol := -1;
+  FMaxColCount := 0;
+end;
+
+procedure TCSVParser.SkipEndOfLine;
+begin
+  // treat LF+CR as two linebreaks, not one
+  if (FCurrentChar = CR) then
+    NextChar;
+  if (FCurrentChar = LF) then
+    NextChar;
+end;
+
+procedure TCSVParser.SkipDelimiter;
+begin
+  if FCurrentChar = FDelimiter then
+    NextChar;
+end;
+
+procedure TCSVParser.SkipWhitespace;
+begin
+  while FCurrentChar = SPACE do
+    NextChar;
+end;
+
+procedure TCSVParser.NextChar;
+begin
+  if FSourceStream.Read(FCurrentChar, CsvCharSize) < CsvCharSize then
+  begin
+    FCurrentChar := #0;
+    EndOfFile := True;
+  end;
+  EndOfLine := FCurrentChar in LineEndingChars;
+end;
+
+procedure TCSVParser.ParseCell;
+begin
+  FCellBuffer := '';
+  if FIgnoreOuterWhitespace then
+    SkipWhitespace;
+  if FCurrentChar = FQuoteChar then
+    ParseQuotedValue
+  else
+    ParseValue;
+end;
+
+procedure TCSVParser.ParseQuotedValue;
+var
+  QuotationEnd: Boolean;
+begin
+  NextChar; // skip opening quotation char
+  repeat
+    // read value up to next quotation char
+    while not ((FCurrentChar = FQuoteChar) or EndOfFile) do
+    begin
+      if EndOfLine then
+      begin
+        AppendStr(FCellBuffer, FLineEnding);
+        SkipEndOfLine;
+      end else
+      begin
+        AppendStr(FCellBuffer, FCurrentChar);
+        NextChar;
+      end;
+    end;
+    // skip quotation char (closing or escaping)
+    if not EndOfFile then
+      NextChar;
+    // check if it was escaping
+    if FCurrentChar = FQuoteChar then
+    begin
+      AppendStr(FCellBuffer, FCurrentChar);
+      QuotationEnd := False;
+      NextChar;
+    end else
+      QuotationEnd := True;
+  until QuotationEnd;
+  // read the rest of the value until separator or new line
+  ParseValue;
+end;
+
+procedure TCSVParser.ParseValue;
+begin
+  while not ((FCurrentChar = FDelimiter) or EndOfLine or EndOfFile) do
+  begin
+    AppendStr(FWhitespaceBuffer, FCurrentChar);
+    NextChar;
+  end;
+  // merge whitespace buffer
+  if FIgnoreOuterWhitespace then
+    RemoveTrailingChars(FWhitespaceBuffer, WhitespaceChars);
+  AppendStr(FCellBuffer, FWhitespaceBuffer);
+  FWhitespaceBuffer := '';
+end;
+
+constructor TCSVParser.Create;
+begin
+  inherited Create;
+  ClearOutput;
+  FStrStreamWrapper := nil;
+  EndOfFile := True;
+end;
+
+destructor TCSVParser.Destroy;
+begin
+  FreeAndNil(FStrStreamWrapper);
+  inherited Destroy;
+end;
+
+procedure TCSVParser.SetSource(AStream: TStream);
+begin
+  FSourceStream := AStream;
+  ResetParser;
+end;
+
+procedure TCSVParser.SetSource(const AString: String); overload;
+begin
+  FreeAndNil(FStrStreamWrapper);
+  FStrStreamWrapper := TStringStream.Create(AString);
+  SetSource(FStrStreamWrapper);
+end;
+
+procedure TCSVParser.ResetParser;
+begin
+  ClearOutput;
+  FSourceStream.Seek(0, soFromBeginning);
+  EndOfFile := False;
+  NextChar;
+end;
+
+// Parses next cell; returns True if there are more cells in the input stream.
+function TCSVParser.ParseNextCell: Boolean;
+var
+  LineColCount: Integer;
+begin
+  if EndOfLine or EndOfFile then
+  begin
+    // Having read the previous line, adjust column count if necessary:
+    LineColCount := FCurrentCol + 1;
+    if LineColCount > FMaxColCount then
+      FMaxColCount := LineColCount;
+  end;
+
+  if EndOfFile then
+    Exit(False);
+
+  // Handle line ending
+  if EndOfLine then
+  begin
+    SkipEndOfLine;
+    if EndOfFile then
+      Exit(False);
+    FCurrentCol := 0;
+    Inc(FCurrentRow);
+  end else
+    Inc(FCurrentCol);
+
+  // Skipping a delimiter should be immediately followed by parsing a cell
+  // without checking for line break first, otherwise we miss last empty cell.
+  // But 0th cell does not start with delimiter unlike other cells, so
+  // the following check is required not to miss the first empty cell:
+  if FCurrentCol > 0 then
+    SkipDelimiter;
+  ParseCell;
+  Result := True;
+end;
+
+{ TCSVBuilder }
+
+function TCSVBuilder.GetDefaultOutputAsString: String;
+var
+  StreamSize: Integer;
+begin
+  Result := '';
+  StreamSize := FDefaultOutput.Size;
+  if StreamSize > 0 then
+  begin
+    SetLength(Result, StreamSize);
+    FDefaultOutput.ReadBuffer(Result[1], StreamSize);
+  end;
+end;
+
+procedure TCSVBuilder.AppendStringToStream(const AString: String; AStream: TStream);
+var
+  StrLen: Integer;
+begin
+  StrLen := Length(AString);
+  if StrLen > 0 then
+    AStream.WriteBuffer(AString[1], StrLen);
+end;
+
+function TCSVBuilder.QuoteCSVString(const AValue: String): String;
+var
+  I: Integer;
+  ValueLen: Integer;
+  NeedQuotation: Boolean;
+begin
+  ValueLen := Length(AValue);
+
+  NeedQuotation := (AValue <> '') and FQuoteOuterWhitespace
+    and ((AValue[1] in WhitespaceChars) or (AValue[ValueLen] in WhitespaceChars));
+
+  if not NeedQuotation then
+    for I := 1 to ValueLen do
+    begin
+      if AValue[I] in FSpecialChars then
+      begin
+        NeedQuotation := True;
+        Break;
+      end;
+    end;
+
+  if NeedQuotation then
+  begin
+    // double existing quotes
+    Result := FDoubleQuote;
+    Insert(StringReplace(AValue, FQuoteChar, FDoubleQuote, [rfReplaceAll]),
+      Result, 2);
+  end else
+    Result := AValue;
+end;
+
+constructor TCSVBuilder.Create;
+begin
+  inherited Create;
+  FDefaultOutput := TMemoryStream.Create;
+  FOutputStream := FDefaultOutput;
+end;
+
+destructor TCSVBuilder.Destroy;
+begin
+  FreeAndNil(FDefaultOutput);
+  inherited Destroy;
+end;
+
+procedure TCSVBuilder.SetOutput(AStream: TStream);
+begin
+  if Assigned(AStream) then
+    FOutputStream := AStream
+  else
+    FOutputStream := FDefaultOutput;
+
+  ResetBuilder;
+end;
+
+procedure TCSVBuilder.ResetBuilder;
+begin
+  if FOutputStream = FDefaultOutput then
+    FDefaultOutput.Clear;
+
+  // Do not clear external FOutputStream because it may be pipe stream
+  // or something else that does not support size and position.
+  // To clear external output is up to the user of TCSVBuilder.
+
+  FNeedLeadingDelimiter := False;
+end;
+
+procedure TCSVBuilder.AppendCell(const AValue: String);
+var
+  CellValue: String;
+begin
+  if FNeedLeadingDelimiter then
+    FOutputStream.WriteBuffer(FDelimiter, CsvCharSize);
+
+  CellValue := ChangeLineEndings(AValue, FLineEnding);
+  CellValue := QuoteCSVString(CellValue);
+  AppendStringToStream(CellValue, FOutputStream);
+
+  FNeedLeadingDelimiter := True;
+end;
+
+procedure TCSVBuilder.AppendRow;
+begin
+  AppendStringToStream(FLineEnding, FOutputStream);
+  FNeedLeadingDelimiter := False;
+end;
+
+//------------------------------------------------------------------------------
+
+type
+  TCSVCell = class
+  public
+    // Value (contents) of cell in string form
+    Value: String;
+  end;
+
+  TCSVRow = class
+  private
+    FCells: TFPObjectList;
+    procedure ForceCellIndex(ACellIndex: Integer);
+    function  CreateNewCell(const AValue: String): TCSVCell;
+    function  GetCellValue(ACol: Integer): String;
+    procedure SetCellValue(ACol: Integer; const AValue: String);
+    function  GetColCount: Integer;
+  public
+    constructor Create;
+    destructor  Destroy; override;
+    // cell operations
+    // Add cell with value AValue to row
+    procedure AddCell(const AValue: String = '');
+    // Insert cell with value AValue at specified column
+    procedure InsertCell(ACol: Integer; const AValue: String);
+    // Remove cell from specified column
+    procedure RemoveCell(ACol: Integer);
+    // Indicates if specified column contains a cell/data
+    function  HasCell(ACol: Integer): Boolean;
+    // utilities
+    // Copy entire row
+    function  Clone: TCSVRow;
+    // Remove all empty cells at the end of the row
+    procedure TrimEmptyCells;
+    // Replace various line endings in data with ALineEnding
+    procedure SetValuesLineEnding(const ALineEnding: String);
+    // properties
+    // Value/data of cell at column ACol
+    property CellValue[ACol: Integer]: String read GetCellValue write SetCellValue;
+    // Number of columns in row
+    property ColCount: Integer read GetColCount;
+  end;
+
+{ TCSVRow }
+
+procedure TCSVRow.ForceCellIndex(ACellIndex: Integer);
+begin
+  while FCells.Count <= ACellIndex do
+    AddCell();
+end;
+
+function TCSVRow.CreateNewCell(const AValue: String): TCSVCell;
+begin
+  Result := TCSVCell.Create;
+  Result.Value := AValue;
+end;
+
+function TCSVRow.GetCellValue(ACol: Integer): String;
+begin
+  if HasCell(ACol) then
+    Result := TCSVCell(FCells[ACol]).Value
+  else
+    Result := '';
+end;
+
+procedure TCSVRow.SetCellValue(ACol: Integer; const AValue: String);
+begin
+  ForceCellIndex(ACol);
+  TCSVCell(FCells[ACol]).Value := AValue;
+end;
+
+function TCSVRow.GetColCount: Integer;
+begin
+  Result := FCells.Count;
+end;
+
+constructor TCSVRow.Create;
+begin
+  inherited Create;
+  FCells := TFPObjectList.Create;
+end;
+
+destructor TCSVRow.Destroy;
+begin
+  FreeAndNil(FCells);
+  inherited Destroy;
+end;
+
+procedure TCSVRow.AddCell(const AValue: String = '');
+begin
+  FCells.Add(CreateNewCell(AValue));
+end;
+
+procedure TCSVRow.InsertCell(ACol: Integer; const AValue: String);
+begin
+  FCells.Insert(ACol, CreateNewCell(AValue));
+end;
+
+procedure TCSVRow.RemoveCell(ACol: Integer);
+begin
+  if HasCell(ACol) then
+    FCells.Delete(ACol);
+end;
+
+function TCSVRow.HasCell(ACol: Integer): Boolean;
+begin
+  Result := (ACol >= 0) and (ACol < FCells.Count);
+end;
+
+function TCSVRow.Clone: TCSVRow;
+var
+  I: Integer;
+begin
+  Result := TCSVRow.Create;
+  for I := 0 to ColCount - 1 do
+    Result.AddCell(CellValue[I]);
+end;
+
+procedure TCSVRow.TrimEmptyCells;
+var
+  I: Integer;
+  MaxCol: Integer;
+begin
+  MaxCol := FCells.Count - 1;
+  for I := MaxCol downto 0 do
+  begin
+    if (TCSVCell(FCells[I]).Value = '') then
+    begin
+      if (FCells.Count > 1) then
+        FCells.Delete(I);
+    end else
+      break; // We hit the first non-empty cell so stop
+  end;
+end;
+
+procedure TCSVRow.SetValuesLineEnding(const ALineEnding: String);
+var
+  I: Integer;
+begin
+  for I := 0 to FCells.Count - 1 do
+    CellValue[I] := ChangeLineEndings(CellValue[I], ALineEnding);
+end;
+
+{ TCSVDocument }
+
+procedure TCSVDocument.ForceRowIndex(ARowIndex: Integer);
+begin
+  while FRows.Count <= ARowIndex do
+    AddRow();
+end;
+
+function TCSVDocument.CreateNewRow(const AFirstCell: String): TObject;
+var
+  NewRow: TCSVRow;
+begin
+  NewRow := TCSVRow.Create;
+  if AFirstCell <> '' then
+    NewRow.AddCell(AFirstCell);
+  Result := NewRow;
+end;
+
+function TCSVDocument.GetCell(ACol, ARow: Integer): String;
+begin
+  if HasRow(ARow) then
+    Result := TCSVRow(FRows[ARow]).CellValue[ACol]
+  else
+    Result := '';
+end;
+
+procedure TCSVDocument.SetCell(ACol, ARow: Integer; const AValue: String);
+begin
+  ForceRowIndex(ARow);
+  TCSVRow(FRows[ARow]).CellValue[ACol] := AValue;
+end;
+
+function TCSVDocument.GetCSVText: String;
+var
+  StringStream: TStringStream;
+begin
+  StringStream := TStringStream.Create('');
+  try
+    SaveToStream(StringStream);
+    Result := StringStream.DataString;
+  finally
+    FreeAndNil(StringStream);
+  end;
+end;
+
+procedure TCSVDocument.SetCSVText(const AValue: String);
+var
+  StringStream: TStringStream;
+begin
+  StringStream := TStringStream.Create(AValue);
+  try
+    LoadFromStream(StringStream);
+  finally
+    FreeAndNil(StringStream);
+  end;
+end;
+
+function TCSVDocument.GetRowCount: Integer;
+begin
+  Result := FRows.Count;
+end;
+
+function TCSVDocument.GetColCount(ARow: Integer): Integer;
+begin
+  if HasRow(ARow) then
+    Result := TCSVRow(FRows[ARow]).ColCount
+  else
+    Result := 0;
+end;
+
+// Returns maximum number of columns in the document
+function TCSVDocument.GetMaxColCount: Integer;
+var
+  I, CC: Integer;
+begin
+  // While calling MaxColCount in TCSVParser could work,
+  // we'd need to adjust for any subsequent changes in
+  // TCSVDocument
+  Result := 0;
+  for I := 0 to RowCount - 1 do
+  begin
+    CC := ColCount[I];
+    if CC > Result then
+      Result := CC;
+  end;
+end;
+
+constructor TCSVDocument.Create;
+begin
+  inherited Create;
+  FRows := TFPObjectList.Create;
+  FParser := nil;
+  FBuilder := nil;
+end;
+
+destructor TCSVDocument.Destroy;
+begin
+  FreeAndNil(FBuilder);
+  FreeAndNil(FParser);
+  FreeAndNil(FRows);
+  inherited Destroy;
+end;
+
+procedure TCSVDocument.LoadFromFile(const AFilename: String);
+var
+  FileStream: TFileStream;
+begin
+  FileStream := TFileStream.Create(AFilename, fmOpenRead or fmShareDenyNone);
+  try
+    LoadFromStream(FileStream);
+  finally
+    FileStream.Free;
+  end;
+end;
+
+procedure TCSVDocument.LoadFromStream(AStream: TStream);
+var
+  I, J, MaxCol: Integer;
+begin
+  Clear;
+
+  if not Assigned(FParser) then
+    FParser := TCSVParser.Create;
+
+  FParser.AssignCSVProperties(Self);
+  with FParser do
+  begin
+    SetSource(AStream);
+    while ParseNextCell do
+      Cells[CurrentCol, CurrentRow] := CurrentCellText;
+  end;
+
+  if FEqualColCountPerRow then
+  begin
+    MaxCol := MaxColCount - 1;
+    for I := 0 to RowCount - 1 do
+      for J := ColCount[I] to MaxCol do
+        Cells[J, I] := '';
+  end;
+end;
+
+procedure TCSVDocument.SaveToFile(const AFilename: String);
+var
+  FileStream: TFileStream;
+begin
+  FileStream := TFileStream.Create(AFilename, fmCreate);
+  try
+    SaveToStream(FileStream);
+  finally
+    FileStream.Free;
+  end;
+end;
+
+procedure TCSVDocument.SaveToStream(AStream: TStream);
+var
+  I, J, MaxCol: Integer;
+begin
+  if not Assigned(FBuilder) then
+    FBuilder := TCSVBuilder.Create;
+
+  FBuilder.AssignCSVProperties(Self);
+  with FBuilder do
+  begin
+    if FEqualColCountPerRow then
+      MaxCol := MaxColCount - 1;
+
+    SetOutput(AStream);
+    for I := 0 to RowCount - 1 do
+    begin
+      if not FEqualColCountPerRow then
+        MaxCol := ColCount[I] - 1;
+      for J := 0 to MaxCol do
+        AppendCell(Cells[J, I]);
+      AppendRow;
+    end;
+  end;
+end;
+
+procedure TCSVDocument.AddRow(const AFirstCell: String = '');
+begin
+  FRows.Add(CreateNewRow(AFirstCell));
+end;
+
+procedure TCSVDocument.AddCell(ARow: Integer; const AValue: String = '');
+begin
+  ForceRowIndex(ARow);
+  TCSVRow(FRows[ARow]).AddCell(AValue);
+end;
+
+procedure TCSVDocument.InsertRow(ARow: Integer; const AFirstCell: String = '');
+begin
+  if HasRow(ARow) then
+    FRows.Insert(ARow, CreateNewRow(AFirstCell))
+  else
+    AddRow(AFirstCell);
+end;
+
+procedure TCSVDocument.InsertCell(ACol, ARow: Integer; const AValue: String);
+begin
+  ForceRowIndex(ARow);
+  TCSVRow(FRows[ARow]).InsertCell(ACol, AValue);
+end;
+
+procedure TCSVDocument.RemoveRow(ARow: Integer);
+begin
+  if HasRow(ARow) then
+    FRows.Delete(ARow);
+end;
+
+procedure TCSVDocument.RemoveCell(ACol, ARow: Integer);
+begin
+  if HasRow(ARow) then
+    TCSVRow(FRows[ARow]).RemoveCell(ACol);
+end;
+
+function TCSVDocument.HasRow(ARow: Integer): Boolean;
+begin
+  Result := (ARow >= 0) and (ARow < FRows.Count);
+end;
+
+function TCSVDocument.HasCell(ACol, ARow: Integer): Boolean;
+begin
+  if HasRow(ARow) then
+    Result := TCSVRow(FRows[ARow]).HasCell(ACol)
+  else
+    Result := False;
+end;
+
+function TCSVDocument.IndexOfCol(const AString: String; ARow: Integer): Integer;
+var
+  CC: Integer;
+begin
+  CC := ColCount[ARow];
+  Result := 0;
+  while (Result < CC) and (Cells[Result, ARow] <> AString) do
+    Inc(Result);
+  if Result = CC then
+    Result := -1;
+end;
+
+function TCSVDocument.IndexOfRow(const AString: String; ACol: Integer): Integer;
+var
+  RC: Integer;
+begin
+  RC := RowCount;
+  Result := 0;
+  while (Result < RC) and (Cells[ACol, Result] <> AString) do
+    Inc(Result);
+  if Result = RC then
+    Result := -1;
+end;
+
+procedure TCSVDocument.Clear;
+begin
+  FRows.Clear;
+end;
+
+procedure TCSVDocument.CloneRow(ARow, AInsertPos: Integer);
+var
+  NewRow: TObject;
+begin
+  if not HasRow(ARow) then
+    Exit;
+  NewRow := TCSVRow(FRows[ARow]).Clone;
+  if not HasRow(AInsertPos) then
+  begin
+    ForceRowIndex(AInsertPos - 1);
+    FRows.Add(NewRow);
+  end else
+    FRows.Insert(AInsertPos, NewRow);
+end;
+
+procedure TCSVDocument.ExchangeRows(ARow1, ARow2: Integer);
+begin
+  if not (HasRow(ARow1) and HasRow(ARow2)) then
+    Exit;
+  FRows.Exchange(ARow1, ARow2);
+end;
+
+procedure TCSVDocument.UnifyEmbeddedLineEndings;
+var
+  I: Integer;
+begin
+  for I := 0 to FRows.Count - 1 do
+    TCSVRow(FRows[I]).SetValuesLineEnding(FLineEnding);
+end;
+
+procedure TCSVDocument.RemoveTrailingEmptyCells;
+var
+  I: Integer;
+begin
+  for I := 0 to FRows.Count - 1 do
+    TCSVRow(FRows[I]).TrimEmptyCells;
+end;
+
+end.

+ 507 - 0
fileimport.pas

@@ -0,0 +1,507 @@
+unit fileimport;
+
+{ CSV/tab separated/semicolon separated text file and spreadsheet file import
+  useful for database import etc.
+
+  Copyright (c) 2014 Reinier Olislagers
+
+  Permission is hereby granted, free of charge, to any person obtaining a copy
+  of this software and associated documentation files (the "Software"), to
+  deal in the Software without restriction, including without limitation the
+  rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
+  sell copies of the Software, and to permit persons to whom the Software is
+  furnished to do so, subject to the following conditions:
+
+  The above copyright notice and this permission notice shall be included in
+  all copies or substantial portions of the Software.
+
+  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+  IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+  FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+  AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+  LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+  FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
+  IN THE SOFTWARE.
+}
+
+// Future plans:
+// - look into replacing array mapping with more efficient implementation
+// - spreadsheet support
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, {laz_fpspreadsheet,} csvdocument;
+
+type
+  TMap = record
+    SourceField: string;
+    SourceFieldIndex: integer; //0-based
+    DestinationField: string;
+  end;
+
+  { TFileImport }
+
+  TFileImport = class(TObject)
+  private
+    // Stream backing CSV file. Always open once filename assigned; otherwise nil
+    FCSVStream: TFileStream;
+    // Source CSV file parser
+    FCSVParser: TCSVParser;
+    FDelimiter: char;
+    FDestinationFields: TStringList;
+    // End of file marker
+    FEOF: boolean;
+    // Maps file/source field to db field
+    FMapping: array of TMap;
+    FRow: integer; //current row (0-based)
+    FRowCount: integer; //Cached row count
+    FRowData: TStringList; //data in fields being read. Ordered in order of FMapping
+    FSourceFields: TStringList;
+    FSourceFile: string;
+    // Try to automatically map source/file fields to database fields
+    procedure AutoMap;
+    // Retrieve single source=>destination mapping
+    // Calls automap if no mapping exists yet -
+    // which obviously requires DestinationFields to be filled
+    function GetMapping(i: integer): TMap;
+    // Checks if source field number SourceIndex is mapped; returns
+    // map number or -1 if not mapped
+    function GetMappingIndex(SourceIndex: integer): integer;
+    // Checks if destination field is mapped; returns
+    // map number or -1 if not mapped
+    function GetMappingIndex(DestinationField: string): integer;
+    // Number of mapped items
+    function GetMappingCount: integer;
+    function GetSourceFields: TStringlist;
+    // Indicates if field mapping already exists for this field
+    function MappingExists(SourceField, DestinationField: string): boolean;
+    // Extracts likely delimiters from text file
+    procedure GuessDelimiter();
+    // Read in source fields into FSourceFields.
+    // Used in Automap as well as GetSourceFields
+    procedure ReadSourceFields;
+    // Moves back to beginning of CSV file
+    procedure ResetCSVParser;
+    procedure SetDelimiter(AValue: char);
+    procedure SetSourceFile(AValue: string);
+    // Initialize CSV parser with file, delimiter,
+    procedure SetupCSVParser;
+  public
+    // Adds mapping from source/file field to db/destination field
+    // if it doesn't already exist. Returns true if mapping added
+    function AddMapping(SourceField, DestinationField: string): boolean;
+    // Delete mapping number specified. Mapping and listbox numbers match
+    // if -1 specified: delete entire mapping array
+    // Returns true if one or more mappings were deleted
+    function DeleteMapping(Item: integer): boolean;
+    // After calling readrow, getdata returns data in the field mapped to
+    // DestinationField or empty if nothing found
+    function GetData(DestinationField: string): string;
+    // After calling readrow, getdata returns data in the field with the
+    // specified mapping or empty if nothing found
+    function GetData(MapIndex: integer): string;
+    // Reads file and counts number of rows
+    // Returns 0 if invalid/empty
+    function GetRowCount: integer;
+    // Reads a row of data. Returns false if last row read (end of file)
+    // Data in fields can be retrieved by calling GetData
+    function ReadRow: boolean;
+
+    // For delimited text files: delimiter that separates fields, such as ;
+    property Delimiter: char read FDelimiter write SetDelimiter;
+    // Field names of destination/target dataset. Required.
+    property DestinationFields: TStringList read FDestinationFields;
+    // Source file name. Required.
+    property FileName: string read FSourceFile write SetSourceFile;
+    // Mapping from source to destination field
+    // 0 based.
+    property Mapping[i: integer]: TMap read GetMapping;
+    // Number of mappings
+    property MappingCount: integer read GetMappingCount;
+    // Row number (0-based)
+    property Row: integer read FRow;
+    // Field names (or field content in first line) in input/source file.
+    property SourceFields: TStringlist read GetSourceFields;
+    //property SpreadsheetParser: to do implement spreadsheet support
+    constructor Create;
+    destructor Destroy; override;
+  end;
+implementation
+
+
+{ TFileImport }
+
+function TFileImport.AddMapping(SourceField, DestinationField: string): boolean;
+var
+  SourceIndex: integer;
+begin
+  result:=false;
+  SourceIndex:=FSourceFields.IndexOf(SourceField);
+  if SourceIndex=-1 then
+    raise Exception.CreateFmt('Source field %s does not exist in file.',[SourceField]);
+  if not MappingExists(SourceField,DestinationField) then
+  begin
+    // Enlarge array by 1 more item
+    SetLength(Fmapping,High(FMapping)+2);
+    FMapping[high(FMapping)].SourceField:=SourceField;
+    FMapping[high(FMapping)].SourceFieldIndex:=SourceIndex;
+    FMapping[high(FMapping)].DestinationField:=DestinationField;
+    while FRowData.Count<Length(FMapping) do
+    begin
+      FRowData.Add(''); //reserve space for data
+    end;
+    result:=true;
+  end;
+end;
+
+procedure TFileImport.AutoMap;
+var
+  DestFields: integer;
+  DestField: string; //database field name
+  FileField: string; //source field
+  FileFieldNo: integer; // source field number
+begin
+  SetLength(FMapping,0);
+
+  GuessDelimiter;
+  ReadSourceFields;
+
+  // Try to use header/first row field names...
+  for FileFieldNo := 0 to FSourceFields.Count-1 do
+  begin
+    FileField:=FSourceFields[FileFieldNo];
+    // This is a bit clunky but it works
+    for DestFields:=0 to FDestinationFields.Count -1 do
+    begin
+      DestField:=FDestinationFields[DestFields];
+      // Add mapping if it doesn't already exist
+      if trim(lowercase(FileField)) = trim(lowercase(DestField)) then
+      begin
+        AddMapping(FileField, DestField);
+      end;
+    end;
+  end;
+end;
+
+constructor TFileImport.Create;
+begin
+  FCSVParser:=nil;
+  FCSVStream:=nil;
+  FRowData:=TStringList.Create;
+  FDelimiter:=',';
+  FDestinationFields:=TStringList.Create;
+  FSourceFields:=TStringList.Create;
+end;
+
+function TFileImport.DeleteMapping(Item: integer): boolean;
+var
+  i:integer;
+begin
+  result:=false;
+  // Clear entire mapping array?
+  if Item=-1 then
+  begin
+    SetLength(FMapping,0);
+    FRowData.Clear;
+    result:=true;
+  end
+  else
+  begin
+    if Item>High(FMapping) then
+      exit(false); //can't delete item that doesn't exist
+    // Delete item, move everything down
+    for i:=Item to High(FMapping)-1 do
+    begin
+      FMapping[i].SourceField:=FMapping[i+1].SourceField;
+      FMapping[i].SourceFieldIndex:=FMapping[i+1].SourceFieldIndex;
+      FMapping[i].DestinationField:=FMapping[i+1].DestinationField;
+    end;
+    FRowData.Delete(Item);
+    // Release last array item
+    SetLength(FMapping,High(FMapping));
+  end;
+end;
+
+destructor TFileImport.Destroy;
+begin
+  FRowData.Free;
+  FDestinationFields.Free;
+  FSourceFields.Free;
+  if assigned(FCSVParser) then FCSVParser.Free;
+  if assigned(FCSVStream) then FCSVStream.Free;
+  inherited Destroy;
+end;
+
+function TFileImport.GetData(MapIndex: integer): string;
+begin
+  if (MapIndex>=0) and (MapIndex<FRowData.Count) then
+    result:=FRowData[MapIndex]
+  else
+    result:=''; //invalid data
+end;
+
+function TFileImport.GetData(DestinationField: string): string;
+var
+  MapIndex: integer;
+begin
+  MapIndex:=GetMappingIndex(DestinationField);
+  if MapIndex>-1 then
+    result:=FRowData[MapIndex]
+  else
+    result:='';
+end;
+
+function TFileImport.GetMapping(i: integer): TMap;
+begin
+  if (length(FMapping)=0) then
+  begin
+    AutoMap;
+  end;
+  result:=FMapping[i];
+end;
+
+function TFileImport.GetMappingCount: integer;
+begin
+  if (length(FMapping)=0) then
+  begin
+    AutoMap;
+  end;
+  result:=length(FMapping); //1-based
+end;
+
+function TFileImport.GetMappingIndex(SourceIndex: integer): integer;
+var
+  i:integer;
+begin
+  result:=-1;
+  for i:=low(FMapping) to high(FMapping) do
+  begin
+    if FMapping[i].SourceFieldIndex=SourceIndex then
+      exit(i);
+  end;
+end;
+
+function TFileImport.GetMappingIndex(DestinationField: string): integer;
+var
+  i:integer;
+begin
+  result:=-1;
+  for i:=low(FMapping) to high(FMapping) do
+  begin
+    if FMapping[i].DestinationField=DestinationField then
+      exit(i);
+  end;
+end;
+
+function TFileImport.GetRowCount: integer;
+begin
+  // Return cached value if possible:
+  if FRowCount>-1 then exit(FRowCount);
+  // Check for existing file file
+  if assigned(FCSVStream) then
+  begin
+    if not(assigned(FCSVParser)) then
+      SetupCSVParser;
+    ResetCSVParser;
+    while FCSVParser.ParseNextCell do
+    begin
+      // just loop
+    end;
+    FRowCount:=FCSVParser.CurrentRow+1;
+    ResetCSVParser;
+  end
+  else
+  begin
+    FRowCount:=-1; //invalidate cache
+  end;
+  result:=FRowCount;
+end;
+
+function TFileImport.GetSourceFields: TStringlist;
+begin
+  // Create fields if they don't exist
+  if assigned(FCSVStream) then
+  begin
+    if FSourceFields.Count=0 then
+      ReadSourceFields;
+  end
+  else
+  begin
+    FSourceFields.Clear;
+  end;
+  result:=FSourceFields;
+end;
+
+function TFileImport.MappingExists(SourceField, DestinationField: string): boolean;
+var
+  i: integer;
+begin
+  result := false;
+  for i:= low(FMapping) to high(FMapping) do
+  begin
+    if (lowercase(FMapping[i].SourceField)=lowercase(SourceField)) and
+      (lowercase(FMapping[i].DestinationField)=lowercase(DestinationField)) then
+    begin
+      result:= true;
+      break;
+    end;
+  end;
+end;
+
+procedure TFileImport.ReadSourceFields;
+var
+  ColCount: integer;
+begin
+  if not(assigned(FCSVStream)) then
+    raise Exception.Create('CSVStream must exist.');
+  if not(assigned(FCSVParser)) then
+    SetupCSVParser
+  else
+    ResetCSVParser; //go to first row
+  FSourceFields.Clear;
+
+  ColCount:=0;
+  while FCSVParser.CurrentRow<1 do
+  begin
+    FCSVParser.ParseNextCell;
+    if FCSVParser.CurrentRow<1 then
+      FSourceFields.Add(FCSVParser.CurrentCellText);
+    inc(ColCount);
+  end;
+  ResetCSVParser;
+end;
+
+procedure TFileImport.ResetCSVParser;
+begin
+  FCSVParser.ResetParser; //rewind to beginning of file
+  FEOF:=false;
+  FRow:=FCSVParser.CurrentRow;
+end;
+
+procedure TFileImport.SetupCSVParser;
+begin
+  if assigned(FCSVParser) then
+    FreeAndNil(FCSVParser);
+  FCSVStream.Position:=0;
+  FCSVParser:=TCSVParser.Create;
+  FEOF:=false;
+  FCSVParser.SetSource(FCSVStream);
+  FCSVParser.Delimiter:=FDelimiter;
+end;
+
+function TFileImport.ReadRow: boolean;
+var
+  i: integer;
+  MapIndex: integer;
+begin  
+  result:=false;
+  // At end of file; there's nothing left...
+  if FEOF then exit;
+
+  if assigned(FCSVStream) then
+  begin
+    if not(assigned(FCSVParser)) then
+      SetupCSVParser;
+
+    // Remove any previous data
+    for i:=0 to FRowData.Count-1 do
+    begin
+      FRowData[i]:='';
+    end;
+
+    // FRow should still be set to last row we read here
+    FRow:=FCSVParser.CurrentRow;
+    while (FCSVParser.CurrentRow=FRow) do
+    begin
+      MapIndex:=GetMappingIndex(FCSVParser.CurrentCol);
+      if MapIndex>-1 then
+        FRowData[MapIndex]:=FCSVParser.CurrentCellText;
+
+      // Move to the next cell; check if at end of file
+      if not(FCSVParser.ParseNextCell) then
+      begin
+        // End of file
+        FEOF:=true; //remember for next ReadRow run
+        FRow:=FCSVParser.CurrentRow;
+        FRowCount:=FCSVParser.CurrentRow+1;
+        break;
+      end;
+    end;
+    result:=true;
+  end
+  else
+  begin
+    raise Exception.Create('ReadRow: input file is not assigned.');
+  end;
+end;
+
+procedure TFileImport.SetDelimiter(AValue: char);
+begin
+  if FDelimiter=AValue then Exit;
+  FDelimiter:=AValue;
+  if assigned(FCSVParser) then
+    FCSVParser.Delimiter:=FDelimiter;
+end;
+
+procedure TFileImport.GuessDelimiter();
+var
+  Byte: char;
+  FoundDelims: string;
+begin
+  FDelimiter := ',';
+
+  try
+    if not(assigned(FCSVStream)) then
+      raise Exception.Create('ReadFirstLineFields: CSVStream must exist.');
+
+    // Only read 1st line to avoid this becoming EXTREMELY slow for large files
+    // as everything will need to be loaded into memory.
+    FCSVStream.Position:=0;
+    Byte:=#0;
+    FoundDelims:='';
+    try
+      while (Byte<>#13) and (Byte<>#10) do
+      begin
+        Byte:=Char(FCSVStream.ReadByte);
+        if (Byte in [#9, ';', '|', ',']) and (pos(byte,FoundDelims)=0) then
+          FoundDelims:=FoundDelims+Byte;
+      end;
+    except
+      // end of file etc
+    end;
+
+    // Only replace existing delimiter if it is invalid
+    if FoundDelims<>'' then
+    begin
+      if (FDelimiter='') or
+        (pos(FDelimiter,FoundDelims)=0) then
+        FDelimiter:=FoundDelims[1];
+    end;
+  except
+    // File access error etc
+  end;
+end;
+
+procedure TFileImport.SetSourceFile(AValue: string);
+begin
+  if FSourceFile=AValue then Exit;
+  FSourceFile:=AValue;
+  if assigned(FCSVParser) then
+    FreeAndNil(FCSVParser);
+  if assigned(FCSVStream) then
+    FreeAndNil(FCSVStream);
+  if AValue<>'' then
+    FCSVStream:=TFileStream.Create(FSourceFile,fmOpenRead and fmShareDenyNoneFlags);
+  // We do not create the csv parser as we want to do things with the stream first
+  FRowCount:=-1; //invalidate cache
+  FSourceFields.Clear;
+  DeleteMapping(-1);
+  if AValue<>'' then
+    GuessDelimiter(); //process delimiters etc
+end;
+
+end.
+

+ 324 - 0
importtable.lfm

@@ -0,0 +1,324 @@
+object fmImportTable: TfmImportTable
+  Left = 318
+  Height = 509
+  Top = 114
+  Width = 610
+  Caption = 'Import'
+  ClientHeight = 509
+  ClientWidth = 610
+  OnCreate = FormCreate
+  OnDestroy = FormDestroy
+  Position = poScreenCenter
+  LCLVersion = '1.2.6.0'
+  object bbImport: TBitBtn
+    Left = 360
+    Height = 49
+    Top = 448
+    Width = 115
+    Anchors = [akLeft, akBottom]
+    Caption = 'Import'
+    Glyph.Data = {
+      36100000424D3610000000000000360000002800000020000000200000000100
+      2000000000000010000064000000640000000000000000000000FFFFFF00FFFF
+      FF00FFFFFF007D7D7E007D7D7E007D7D7E000000000100000001808080028080
+      8002808080025555550340404004666666056666660555555506555555065555
+      5506666666058080800455555503808080028080800280808002000000010000
+      00017D7D7E007D7D7E007D7D7E00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+      FF00FFFFFF007D7D7E000000000180808002666666054D4D4D0A5B5B5B0E5A5A
+      5A115555551259595914555555185252521C5858581D5555551E5555551E5555
+      551E5858581D5858581A55555515515151135A5A5A115555550F5555550C4949
+      490755555503000000017D7D7E00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+      FF00FFFFFF007E7E7F00808080026D6D6D0755555512555555215757572F5757
+      57385959593C63636352737373907A7A7BCA7B7B7CDC7D7D7EF57D7D7EF57B7B
+      7CDC7A7A7BCB72727392646465535858583D595959395A5A5A33575757265555
+      55185D5D5D0B4040400400000001FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+      FF00FFFFFF007F7F8000555555035D5D5D0B5858581D575757355858584B6767
+      6876777778BD878788FFA4A2A4FFC1BBBFFFCAC4C9FFD8CDD4FFDBCDD5FFCFC2
+      CAFFC8BBC5FFA9A1A7FF898789FF777778BE67676879585858515656563E5757
+      5726555555125555550600000001FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+      FF00FFFFFF0081818100808080026D6D6D0755555512555555217B7B7B9D8787
+      87FFB4B3B4FFD4D1D3FFD1CDD0FFCAC4C8FFC5BCC1FFC5B8BFFFCBB9C4FFD0BA
+      C8FFDAC1D0FFE3CBDCFFE5D1DFFFBEB3BBFF888788FF7B7B7B9F575757265555
+      55185D5D5D0B4040400400000001FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+      FF00FFFFFF00828283000000000180808002666666058181829799999AFFCFCE
+      CFFFCDCACCFFC4C2C4FFC0BEC1FFBEBABFFFBDB7BBFFC0B7BDFFC5B7C0FFCBB7
+      C5FFD1B8CBFFD9BDD3FFD8C2D3FFDCCAD7FFDBCED8FF9D999CFF818182984949
+      4907555555030000000182828300FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+      FF00FFFFFF0084848500848485008484850084848593A3A2A3FFD0CED0FFC7C7
+      C8FFC0C0C2FFC0BFC2FFBFBFC2FFBDBEC2FFBDBABEFFBEBAC0FFC2BAC2FFC9B9
+      C6FFD4BDD1FFD4BFD2FFCFBFCEFFCDBFCBFFD1C7D0FFD7CED5FFA5A2A5FF8484
+      85937BE4FE008484850084848500FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+      FF00FFFFFF008585860085858600858586879B9A9BFFD1CFD0FFC9C7C9FFC3C2
+      C4FFC1C1C4FFC0C1C4FFBEC1C4FFBEBFC4FFBDBDC2FFBEBCC3FFC2BCC6FFC9BC
+      CBFFD5C0D6FFCFC0D1FFCAC1CCFFC8C1CAFFC7C1C8FFCDC7CCFFD3CFD3FF9C9A
+      9CFF858586878585860085858600FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+      FF00FFFFFF00878788008787882D8E8E8FFFCECCCDFFCDCACCFFC5C4C6FFC3C3
+      C6FFC1C3C6FFBFC2C6FFBDC2C6FFBDC2C7FFBBBFC5FFBEBEC7FFC3BECBFFCBBF
+      D1FFD0C1D6FFCAC2D0FFC6C2CCFFC4C2CAFFC4C3C8FFC5C3C8FFCDCACDFFCFCC
+      CEFF8F8F90FF8787882D87878800FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+      FF00FFFFFF0089898A0089898A96B5B3B4FFD1CED0FFC9C6C9FFC7C5C9FFC4C5
+      C8FFC1C4C8FFBFC4C8FFBEC4C8FFBCC3C9FFBCC2CAFFC0C1CDFFC4C0D0FFCBC2
+      D5FFCCC3D6FFC6C3D1FFC3C4CDFFC2C4CAFFC2C4C9FFC4C5C8FFC6C5C8FFCFCE
+      CFFFB4B3B4FF89898A9689898A00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+      FF00FFFFFF008B8B8C1B939293FFD3CFD1FFD0CBCEFFCBC8CBFFC8C7CBFFC5C7
+      CBFFC2C6CAFFC0C6CAFFBFC8CEFFC5CED6FFCDD6DFFFD2DBE5FFD4DBE8FFD4D6
+      E6FFCDCEDDFFC6C7D4FFC1C5CEFFC1C6CCFFC2C6CAFFC4C7CAFFC5C7CAFFCBCB
+      CDFFD1CFD1FF939293FF8B8B8C1BFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+      FF00FFFFFF008D8D8E78AEADAEFFD4CFD2FFCECACDFFCCC9CDFFC9C9CDFFC5C8
+      CDFFC2C8CCFFC2CAD0FFC7D2D8FFBCC7CDFFABAEB2FF969798FF969798FFADAE
+      B4FFC0C6D0FFCAD1DDFFC1C9D2FFC0C7CDFFC1C8CCFFC3C8CCFFC6C9CBFFC9C9
+      CBFFD0CFD0FFADADAEFF8D8D8E78FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+      FF00FFFFFF00909090BAC2BFC1FFD4CFD2FFD0CCCFFFCDCBCFFFCACBCFFFC6CA
+      CFFFC3C9CEFFC5CFD5FFBAC3C8FF9B9C9EFF909090669090901C9090901C9090
+      90669C9C9EFFBAC2CAFFC4CED7FFBFC9CFFFC2C9CEFFC4CACDFFC7CBCDFFCACB
+      CDFFD0CFD0FFC1BFC0FF909090BAFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+      FF00FFFFFF00929292E4CFCCCEFFD5D1D3FFD1CFD2FFCFCED2FFCCCED2FFC8CD
+      D1FFC4CCD1FFC7D0D7FFA8ABAEFF929292667BE4FE007BE4FE007BE4FE007BE4
+      FE0092929266A8AAAFFFC4D0D8FFC1CBD1FFC3CCD1FFC7CDD1FFCACED0FFCDCE
+      D0FFD1D1D2FFCECCCDFF929292E4FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+      FF00FFFFFF00949495F9D5D3D4FFD5D2D4FFD3D2D4FFD1D1D4FFCDD0D4FFCAD0
+      D4FFC7CFD4FFC4CED5FF9A9B9CFF9494951C7BE4FE007BE4FE007BE4FE007BE4
+      FD009494951C9A9B9CFFC2CED5FFC3CED4FFC6CFD4FFCAD0D4FFCDD0D4FFD1D1
+      D4FFD2D2D3FFD4D3D4FF949495F9FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+      FF00FFFFFF00969697F9D6D4D5FFE5E4E4FFE4E3E4FFE2E2E4FFE0E2E4FFDEE2
+      E4FFDCE1E4FFDCE2E7FFBFBFC0FFEDEDED6BFDFFFF5AFDFFFF5AFFFFFF59FFFF
+      FF59EDEDED6BBFBFC0FFDAE2E7FFDAE0E4FFDBE1E4FFDEE2E4FFE0E2E4FFE2E2
+      E4FFE4E4E5FFD7D4D5FF969697F9FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+      FF00FFFFFF00989899E4D2D0D1FFE6E5E5FFE5E4E5FFE3E4E5FFE1E4E5FFDFE3
+      E5FFDDE2E6FFDFE4E9FFCBCDCFFFD3D3D39BFDFFFF5AFDFFFF5AFFFFFF59FFFF
+      FF59D3D3D39BCACCCFFFDCE4E8FFDBE2E6FFDDE2E6FFE0E3E6FFE2E4E6FFE4E4
+      E6FFE7E6E7FFD9D6D7FF989899E4FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+      FF00FFFFFF009B9B9BBDC9C8C9FFE5E5E5FFE6E6E6FFE5E5E6FFE3E5E6FFE1E4
+      E6FFE0E4E7FFE1E6EAFFD9DEE2FFC4C4C6FFD3D4D49DECEDED6DEEEEEE6BD4D4
+      D49BC4C4C6FFD6DDE0FFDDE5E9FFDDE4E6FFE0E4E7FFE2E4E7FFE4E5E7FFE6E5
+      E7FFE9E8E9FFCFCDCEFF9B9B9BBDFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+      FF00FFFFFF009D9D9D78BBBBBBFFE6E5E6FFE8E8E8FFE7E8E8FFE6E7E8FFE4E6
+      E8FFE2E6E9FFE2E6EAFFE5EAEDFFDCE0E5FFCFD0D2FFC3C4C4FFC4C4C5FFCFD1
+      D3FFD9E0E4FFE0E9ECFFDFE6E9FFE0E6E8FFE2E6E8FFE4E6E9FFE6E7E9FFE8E8
+      E9FFEBEAEBFFBDBCBCFF9D9D9D78FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+      FF00FFFFFF009F9F9F21A8A8A8FFE3E2E3FFEBEBEBFFEAE9EAFFE8E8EAFFE6E8
+      EAFFE5E8EAFFE5E8EAFFE6E8ECFFE8E9EEFFE8E8EEFFE7EBF0FFE6EDF2FFE5EB
+      EFFFE1E9EDFFE1E8EAFFE1E7EAFFE3E8EAFFE4E8EAFFE7E8EAFFE8E8EAFFECEB
+      EBFFE9E7E8FFA8A8A8FF9F9F9F21FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+      FF00FFFFFF00A1A1A100A1A1A19FCBCACBFFEDECEDFFEBEAEBFFEAEAEBFFE9EA
+      EBFFE8EAEBFFE8E9EBFFE9E9EDFFEAE6EBFFE7E4E9FFE5E5EAFFE4E8ECFFE3E8
+      EBFFE3E8EBFFE3E8EBFFE4E9EBFFE6E9EBFFE8EAEBFFE9EAEBFFEAEAEBFFEFEE
+      EFFFCFCFCFFFA1A1A19FA1A1A100FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+      FF00FFFFFF00A3A3A300A3A3A336AAAAAAFFE8E6E7FFEFEEEFFFECEBECFFECEB
+      ECFFEBEBECFFEBEBEDFFECEAEDFFEBE6EBFFE9E4E9FFE8E7EAFFE7EAEDFFE6EA
+      ECFFE6EAECFFE6EAECFFE7EAEBFFE8EBEBFFEAEBECFFEBEBECFFEFEEEFFFECEB
+      EBFFAAAAAAFFA3A3A336A3A3A300FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+      FF00FFFFFF00A4A4A400A4A4A400A4A4A48ABAB9BAFFF1EFEFFFF1EFEFFFEFED
+      EDFFEFEDEEFFEFECEEFFEFEBEEFFEEE6EAFFEAE6E8FFE9E6E9FFEAEBEDFFEAEB
+      EDFFEAEBEDFFEAECEDFFEAECEDFFEBECEDFFECEDEDFFEFEFEFFFF1F1F1FFBDBC
+      BCFFA4A4A48AFFFFFF00A4A4A400FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+      FF00FFFFFF00A6A6A600A6A6A600FFFFFF00A6A6A696C7C5C5FFF4F1F1FFF3F0
+      F1FFF2EDEFFFF2EDEFFFF1EBEDFFEFE6E8FFEDE6E8FFEBE7EAFFECEBEDFFEBED
+      EEFFECEDEDFFECEDEDFFEDEDEDFFEDEDEDFFF1F0F0FFF3F3F3FFCACACAFFA6A6
+      A696FFFFFF00FFFFFF00A6A6A600FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+      FF00FFFFFF00A7A7A800A7A7A800FFFFFF00A7A7A806A7A7A896BFBDBEFFF2F0
+      F2FFF6F3F4FFF5EFF1FFF3EAEBFFF1E7E9FFEFE7E9FFEDE7E8FFEFEDEEFFEFEF
+      EFFFEFEFEFFFEFEFEFFFF1F0F0FFF3F3F3FFF2F1F1FFC1C0C1FFA7A7A896A7A7
+      A806FFFFFF00FFFFFF00A7A7A800FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+      FF00FFFFFF00A9A9A900A9A9A900FFFFFF00FFFFFF00FFFFFF00A9A9A98AB1B1
+      B1FFDAD7D8FFF8F3F3FFF9F2F3FFF5EDEFFFF3EAEBFFF1EAEBFFF1EDEEFFF3F1
+      F2FFF4F3F3FFF6F4F4FFF5F4F4FFDADADAFFB1B1B1FFA9A9A98AFFFFFF00FFFF
+      FF00FFFFFF00FFFFFF00A9A9A900FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+      FF00FFFFFF00AAAAAA00AAAAAA00FFFFFF00FFFFFF00FFFFFF00FFFFFF00AAAA
+      AA33AAAAAA9CB2B2B2FFCBC9CAFFE4E0E1FFEAE6E7FFF7F2F3FFF7F4F5FFEAE9
+      EAFFE3E2E2FFCAC9C9FFB2B2B2FFAAAAAA9CAAAAAA33FFFFFF00FFFFFF00FFFF
+      FF00FFFFFF00FFFFFF00AAAAAA00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+      FF00FFFFFF00ABABAB00ABABAB00ABABAB00ABABAB00ABABAB00ABABAB00ABAB
+      AB00ABABAB00ABABAB1BABABAB6CABABABB7ABABABCCABABABFCABABABFCABAB
+      ABCCABABABB7ABABAB6CABABAB1BABABAB00ABABAB00ABABAB00ABABAB00ABAB
+      AB00ABABAB00ABABAB00ABABAB00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+      FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+      FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+      FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+      FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+      FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+      FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+      FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+      FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+      FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+      FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+      FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+      FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+      FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+      FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+      FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+      FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00
+    }
+    OnClick = bbImportClick
+    TabOrder = 2
+  end
+  object bbClose: TBitBtn
+    Left = 488
+    Height = 49
+    Top = 448
+    Width = 114
+    Anchors = [akLeft, akBottom]
+    Caption = '&Close'
+    Kind = bkClose
+    OnClick = bbCloseClick
+    TabOrder = 3
+  end
+  object SourcePanel: TPanel
+    Left = 8
+    Height = 138
+    Top = 16
+    Width = 594
+    ClientHeight = 138
+    ClientWidth = 594
+    TabOrder = 0
+    object edSourceFile: TEdit
+      Left = 80
+      Height = 21
+      Top = 16
+      Width = 228
+      OnEditingDone = edSourceFileEditingDone
+      TabOrder = 0
+    end
+    object Label1: TLabel
+      Left = 8
+      Height = 13
+      Top = 24
+      Width = 50
+      Caption = 'Source file'
+      ParentColor = False
+    end
+    object btnSourceFileOpen: TButton
+      Left = 324
+      Height = 25
+      Hint = 'Select source file'
+      Top = 16
+      Width = 75
+      Caption = '...'
+      OnClick = btnSourceFileOpenClick
+      ParentShowHint = False
+      ShowHint = True
+      TabOrder = 1
+    end
+    object Label2: TLabel
+      Left = 8
+      Height = 13
+      Top = 72
+      Width = 41
+      Caption = 'Delimiter'
+      ParentColor = False
+    end
+    object edDelimiter: TEdit
+      Left = 80
+      Height = 21
+      Top = 64
+      Width = 228
+      OnEditingDone = edDelimiterEditingDone
+      TabOrder = 2
+    end
+    object chkTabDelimiter: TCheckBox
+      Left = 324
+      Height = 17
+      Top = 64
+      Width = 38
+      Caption = 'Tab'
+      OnEditingDone = chkTabDelimiterEditingDone
+      TabOrder = 3
+    end
+    object chkSkipFirstRow: TCheckBox
+      Left = 8
+      Height = 17
+      Hint = 'Ignore the first row of the file when importing?'
+      Top = 104
+      Width = 104
+      Caption = 'Skip past first line'
+      ParentShowHint = False
+      ShowHint = True
+      TabOrder = 4
+    end
+  end
+  object MappingPanel: TPanel
+    Left = 8
+    Height = 248
+    Top = 192
+    Width = 592
+    Caption = 'MappingPanel'
+    ClientHeight = 248
+    ClientWidth = 592
+    TabOrder = 1
+    object cbSourceField: TComboBox
+      Left = 11
+      Height = 21
+      Top = 16
+      Width = 181
+      ItemHeight = 13
+      TabOrder = 0
+    end
+    object Label5: TLabel
+      Left = 208
+      Height = 13
+      Top = 24
+      Width = 84
+      Caption = '== maps to ==>'
+      ParentColor = False
+    end
+    object cbDestField: TComboBox
+      Left = 320
+      Height = 21
+      Top = 16
+      Width = 181
+      ItemHeight = 13
+      TabOrder = 1
+    end
+    object btnAddMapping: TButton
+      Left = 512
+      Height = 25
+      Hint = 'Add mapping between source and destination field to list of mappings'
+      Top = 12
+      Width = 75
+      Caption = 'Add'
+      ParentShowHint = False
+      ShowHint = True
+      TabOrder = 2
+    end
+    object MappingGrid: TStringGrid
+      Left = 11
+      Height = 184
+      Top = 48
+      Width = 490
+      AutoFillColumns = True
+      ColCount = 0
+      FixedCols = 0
+      FixedRows = 0
+      RowCount = 0
+      TabOrder = 3
+    end
+    object btnDeleteMapping: TButton
+      Left = 512
+      Height = 25
+      Hint = 'Delete selected mapping'
+      Top = 88
+      Width = 75
+      Caption = 'Delete'
+      ParentShowHint = False
+      ShowHint = True
+      TabOrder = 4
+    end
+  end
+  object btnPrepare: TButton
+    Left = 200
+    Height = 25
+    Hint = 'Prepares mapping between source and destination fields'
+    Top = 160
+    Width = 91
+    Caption = 'Prepare import'
+    OnClick = btnPrepareClick
+    ParentShowHint = False
+    ShowHint = True
+    TabOrder = 4
+  end
+  object dlgSourceOpen: TOpenDialog
+    Options = [ofFileMustExist, ofEnableSizing, ofViewDetail]
+    left = 472
+    top = 40
+  end
+end

+ 365 - 0
importtable.pas

@@ -0,0 +1,365 @@
+unit importtable;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
+  StdCtrls, Buttons, ExtCtrls, Grids, SynEdit, SynHighlighterSQL, sqldb,
+  turbocommon, fileimport;
+
+type
+
+  { TfmImportTable }
+
+  TfmImportTable = class(TForm)
+    bbImport: TBitBtn;
+    bbClose: TBitBtn;
+    btnAddMapping: TButton;
+    btnDeleteMapping: TButton;
+    btnPrepare: TButton;
+    btnSourceFileOpen: TButton;
+    chkSkipFirstRow: TCheckBox;
+    chkTabDelimiter: TCheckBox;
+    dlgSourceOpen: TOpenDialog;
+    edSourceFile: TEdit;
+    edDelimiter: TEdit;
+    Label1: TLabel;
+    Label2: TLabel;
+    Label5: TLabel;
+    MappingGrid: TStringGrid;
+    MappingPanel: TPanel;
+    cbSourceField: TComboBox;
+    cbDestField: TComboBox;
+    SourcePanel: TPanel;
+    procedure bbImportClick(Sender: TObject);
+    procedure bbCloseClick(Sender: TObject);
+    procedure btnPrepareClick(Sender: TObject);
+    procedure btnSourceFileOpenClick(Sender: TObject);
+    procedure chkTabDelimiterEditingDone(Sender: TObject);
+    procedure edDelimiterEditingDone(Sender: TObject);
+    procedure edSourceFileEditingDone(Sender: TObject);
+    procedure FormCreate(Sender: TObject);
+    procedure FormDestroy(Sender: TObject);
+  private
+    FDestinationQuery: TSQLQuery;
+    FImporter: TFileImport;
+    FDestDB: string; //destination database
+    FDestTable: string; //destination table
+    FDestIndex: Integer; //index of destination database
+    // Load source and destination fields in mapping comboboxes
+    procedure LoadMappingCombos;
+    // Opens destination table query
+    procedure OpenDestinationTable;
+    // Load/update mapping grid
+    procedure UpdateMappingGrid;
+    { private declarations }
+  public
+    { public declarations }
+    procedure Init(DestinationIndex: Integer; DestinationTableName: string);
+  end; 
+
+var
+  fmImportTable: TfmImportTable;
+
+implementation
+
+{ TfmImportTable }
+
+uses main, SysTables, EnterPass, Reg;
+
+
+procedure TfmImportTable.edSourceFileEditingDone(Sender: TObject);
+begin
+  if edSourceFile.Text='' then exit;
+  try
+    FImporter.FileName:=edSourceFile.Text;
+    if FImporter.Delimiter = #9 then //tab
+    begin
+      chkTabDelimiter.Checked:=true;
+      edDelimiter.Text:='<TAB>';
+      edDelimiter.Enabled:=false;
+    end
+    else
+    begin
+      edDelimiter.Text:=FImporter.Delimiter;
+      edDelimiter.Enabled:=true;
+    end;
+  except
+    edDelimiter.Enabled:=true;
+    edDelimiter.Text:='';
+    chkTabDelimiter.Checked:=false;
+  end;
+end;
+
+procedure TfmImportTable.FormCreate(Sender: TObject);
+begin
+  FImporter:=TFileImport.Create;
+end;
+
+procedure TfmImportTable.FormDestroy(Sender: TObject);
+begin
+  FImporter.Free;
+  if assigned(FDestinationQuery) then
+    FreeAndNil(FDestinationQuery);
+end;
+
+procedure TfmImportTable.LoadMappingCombos;
+var
+  i: integer;
+begin
+  cbSourceField.Clear;
+  cbDestField.Clear;
+  for i:=0 to FImporter.SourceFields.Count-1 do
+  begin
+    cbSourceField.Items.Add(FImporter.SourceFields[i]);
+  end;
+  if cbSourceField.Items.Count > -1 then
+    cbSourceField.ItemIndex := 0;
+
+  if assigned(FDestinationQuery) then
+  begin
+    if not(FDestinationQuery.Active) then FDestinationQuery.Open;
+    for i:=0 to FDestinationQuery.FieldCount-1 do
+    begin
+      cbDestField.Items.Add(FDestinationQuery.Fields[i].FieldName);
+    end;
+  end;
+  if cbDestField.Items.Count > -1 then
+    cbDestField.ItemIndex := 0;
+end;
+
+procedure TfmImportTable.OpenDestinationTable;
+var
+  i: Integer;
+  Statement: string;
+  Num: Integer;
+begin
+  // Enter password if it is not saved
+  with fmMain.RegisteredDatabases[FDestIndex] do
+  begin
+    // todo: detect embedded - this won't need a password
+    if IBConnection.Password = '' then
+    begin
+      if fmEnterPass.ShowModal = mrOk then
+      begin
+        if fmReg.TestConnection(RegRec.DatabaseName, fmEnterPass.edUser.Text, fmEnterPass.edPassword.Text,
+          RegRec.Charset) then
+          with fmMain do
+          begin
+            RegisteredDatabases[FDestIndex].RegRec.UserName:= fmEnterPass.edUser.Text;
+            RegisteredDatabases[FDestIndex].RegRec.Password:= fmEnterPass.edPassword.Text;
+            RegisteredDatabases[FDestIndex].RegRec.Role:= fmEnterPass.cbRole.Text;
+          end
+          else
+          begin
+            Exit;
+          end;
+      end
+    end;
+
+    if not(assigned(FDestinationQuery)) then
+      FDestinationQuery:=TSQLQuery.Create(nil);
+    FDestinationQuery.Close;
+    FDestinationQuery.DataBase:=IBConnection;
+    FDestinationQuery.Transaction:=SQLTrans;
+    FDestinationQuery.SQL.Text:='select * from '+FDestTable;
+    FDestinationQuery.Open;
+  end;
+end;
+
+procedure TfmImportTable.UpdateMappingGrid;
+var
+  i: integer;
+  MappingCount: integer;
+begin
+
+  // MappingCount will map fields if necessary so we need destination fields
+  if FImporter.DestinationFields.Count=0 then
+  begin
+    if not(assigned(FDestinationQuery)) then
+      raise Exception.Create('Cannot update mapping info without valid destination query.');
+    MappingCount := FDestinationQuery.Fields.Count;
+    for i := 0 to MappingCount - 1 do
+    begin
+      FImporter.DestinationFields.Add(FDestinationQuery.Fields[i].FieldName);
+    end;
+  end;
+
+  MappingGrid.Clear; //remove any existing mapping GUI
+  MappingCount := FImporter.MappingCount;
+  // Required to avoid index out of bounds error in InsertRowWithValues
+  while MappingGrid.Columns.Count<2 do
+    MappingGrid.Columns.Add;
+
+  for i := 0 to MappingCount-1 do
+  begin
+    MappingGrid.InsertRowWithValues(0,
+      [FImporter.Mapping[i].SourceField,
+      FImporter.Mapping[i].DestinationField]);
+  end;
+end;
+
+procedure TfmImportTable.bbCloseClick(Sender: TObject);
+begin
+  Close;
+end;
+
+procedure TfmImportTable.btnPrepareClick(Sender: TObject);
+begin
+  // Only try if valid import file specified
+  if (FImporter.FileName<>'') and
+    (FImporter.Delimiter<>#0) then
+  begin
+    OpenDestinationTable;
+    LoadMappingCombos;
+    UpdateMappingGrid;
+  end;
+end;
+
+procedure TfmImportTable.btnSourceFileOpenClick(Sender: TObject);
+begin
+  if dlgSourceOpen.Execute then
+    edSourceFile.Text:=dlgSourceOpen.FileName;
+  // Process delimiters etc
+  edSourceFileEditingDone(Sender);
+end;
+
+procedure TfmImportTable.chkTabDelimiterEditingDone(Sender: TObject);
+begin
+  if chkTabDelimiter.Checked then
+  begin
+    edDelimiter.Text:='<TAB>';
+    edDelimiter.Enabled:=false;
+    FImporter.Delimiter:=#9;
+  end
+  else
+  begin
+    edDelimiter.Enabled:=true;
+    FImporter.Delimiter:=#0; //more or less a placeholder
+  end;
+end;
+
+procedure TfmImportTable.edDelimiterEditingDone(Sender: TObject);
+begin
+  case length(edDelimiter.Text) of
+    0: FImporter.Delimiter:=#0; //placeholder
+    1: FImporter.Delimiter:=edDelimiter.Text[1];
+    else
+    begin
+      ShowMessage('Delimiter must be 1 character only.');
+      exit;
+    end;
+  end;
+end;
+
+procedure TfmImportTable.bbImportClick(Sender: TObject);
+var
+  DestColumn: string;
+  i: Integer;
+  Statement: string;
+  Values: string;
+  SQLTarget: TSQLQuery;
+  Num: Integer;
+begin
+  Values:= '';
+  if not(assigned(FDestinationQuery)) and (FDestinationQuery.Active=false) then
+    exit; //no destination fields
+
+  // Get field names
+  //todo: rewrite using regular select and use auto-generated insert query; just post field contents
+  Statement:= 'insert into '+FDestTable+' (';
+  for i:=0 to FDestinationQuery.FieldCount - 1 do
+  begin
+    Statement:= Statement + UpperCase(FDestinationQuery.Fields[i].FieldName) + ',';
+    Values:= Values + ':' + UpperCase(FDestinationQuery.Fields[i].FieldName) + ',';
+    Next;
+  end;
+  Delete(Statement, Length(Statement), 1);
+  Delete(Values, Length(Values), 1);
+  Statement:= Statement + ') values (' + Values + ')';
+
+  // Skip first row if necessary
+  if chkSkipFirstRow.Checked then
+  begin
+    if not(FImporter.ReadRow) then
+      exit; //error: end of file?
+  end;
+
+  // Enter password if it is not saved... and we're not connected to an embedded
+  // database
+  with fmMain.RegisteredDatabases[FDestIndex] do
+  begin
+    if (IBConnection.HostName<>'') and (IBConnection.Password = '') then
+    begin
+      if fmEnterPass.ShowModal = mrOk then
+      begin
+        if fmReg.TestConnection(RegRec.DatabaseName, fmEnterPass.edUser.Text, fmEnterPass.edPassword.Text,
+          RegRec.Charset) then
+          with fmMain do
+          begin
+            RegisteredDatabases[FDestIndex].RegRec.UserName:= fmEnterPass.edUser.Text;
+            RegisteredDatabases[FDestIndex].RegRec.Password:= fmEnterPass.edPassword.Text;
+            RegisteredDatabases[FDestIndex].RegRec.Role:= fmEnterPass.cbRole.Text;
+          end
+          else
+          begin
+            Exit;
+          end;
+      end
+    end;
+
+    SQLTarget:=TSQLQuery.Create(nil);
+    try
+      SQLTarget.DataBase:=IBConnection;
+      SQLTarget.Transaction:=SQLTrans;
+      SQLTarget.SQL.Text:=Statement;
+
+      // Start import
+      try
+        while FImporter.ReadRow do
+        begin
+          for I := 0 to FImporter.MappingCount-1 do
+          begin
+            DestColumn := FImporter.Mapping[I].DestinationField;
+            // Note: csv import sees everything as strings so let the db convert if possible
+            SQLTarget.Params.ParamByName(DestColumn).Value:=FImporter.GetData(i);
+          end;
+          SQLTarget.ExecSQL;
+          Inc(Num);
+          Next;
+        end;
+        SQLTrans.Commit;
+        ShowMessage(IntToStr(Num) + ' record(s) have been imported');
+        Close;
+      except
+        on E: Exception do
+        begin
+          MessageDlg('Error while copy: ' + e.Message, mtError, [mbOk], 0);
+          SQLTrans.Rollback;
+        end;
+      end;
+    finally
+      SQLTarget.Free;
+    end;
+  end;
+  FDestinationQuery.Close;
+end;
+
+procedure TfmImportTable.Init(DestinationIndex: Integer; DestinationTableName: string);
+var
+  i: Integer;
+  Count: Integer;
+begin
+  FDestIndex:=DestinationIndex;
+  FDestDB:=fmMain.RegisteredDatabases[FDestIndex].RegRec.Title;
+  FDestTable:=DestinationTableName;
+  Caption:='Import '+FDestTable;
+end;
+
+initialization
+  {$I ImportTable.lrs}
+
+end.
+