1{ 2 This file is part of the Free Pascal run time library. 3 Copyright (c) 1999-2014 by Michael Van Canneyt, member of the 4 Free Pascal development team 5 6 CSV Dataset implementation. 7 8 See the file COPYING.FPC, included in this distribution, 9 for details about the copyright. 10 11 This program is distributed in the hope that it will be useful, 12 but WITHOUT ANY WARRANTY; without even the implied warranty of 13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 14 15 **********************************************************************} 16unit csvdataset; 17 18{$mode objfpc}{$H+} 19 20interface 21 22uses 23 Classes, SysUtils, bufdataset, csvreadwrite, db, sqldb; 24 25Type 26 27 28 { TCSVOptions } 29 30 TCSVOptions = Class(TCSVHandler) 31 private 32 FDefaultFieldLength: Word; 33 FFirstLineAsFieldNames: Boolean; 34 Public 35 Constructor Create; override; 36 Procedure Assign(Source : TPersistent); override; 37 Published 38 // Does first line of the file contain the field names to use ? 39 property FirstLineAsFieldNames : Boolean Read FFirstLineAsFieldNames Write FFirstLineAsFieldNames; 40 // Default is to create all fields as strings with the same length. Default string field length. 41 // If the CSV dataset has field defs prior to loading, this is ignored. 42 property DefaultFieldLength : Word Read FDefaultFieldLength Write FDefaultFieldLength; 43 // Field delimiter 44 property Delimiter; 45 // Character used to quote "problematic" data 46 // (e.g. with delimiters or spaces in them) 47 // A common quotechar is " 48 property QuoteChar; 49 // String at the end of the line of data (e.g. CRLF) 50 property LineEnding; 51 // Ignore whitespace between delimiters and field data 52 property IgnoreOuterWhitespace; 53 // Use quotes when outer whitespace is found 54 property QuoteOuterWhitespace; 55 end; 56 57 { TCSVDataPacketReader } 58 59 TCSVDataPacketReader = class(TDataPacketReader) 60 private 61 FOptions: TCSVOptions; 62 FOwnsOptions: Boolean; 63 FParser : TCSVParser; 64 FBuilder : TCSVBuilder; 65 FLine : TStringList; 66 FCurrentRow : Integer; 67 FEOF : Boolean; 68 FCreateFieldDefs : TFieldDefs; 69 // Read next row in Fline 70 Protected 71 Procedure ReadNextRow;virtual; 72 procedure SetCreateFieldDefs(AValue: TFieldDefs);virtual; 73 public 74 constructor Create(ADataSet: TCustomBufDataset; AStream : TStream); override; 75 constructor Create(ADataSet: TCustomBufDataset; AStream : TStream; AOptions : TCSVOptions); 76 Destructor Destroy; override; 77 procedure LoadFieldDefs(var AnAutoIncValue : integer); override; 78 procedure StoreFieldDefs(AnAutoIncValue : integer); override; 79 function GetRecordRowState(out AUpdOrder : Integer) : TRowState; override; 80 procedure FinalizeStoreRecords; override; 81 function GetCurrentRecord : boolean; override; 82 procedure GotoNextRecord; override; 83 procedure InitLoadRecords; override; 84 procedure RestoreRecord; override; 85 procedure StoreRecord(ARowState : TRowState; AUpdOrder : integer = 0); override; 86 class function RecognizeStream(AStream : TStream) : boolean; override; 87 Property Options : TCSVOptions Read FOptions; 88 Property CreateFieldDefs : TFieldDefs read FCreateFieldDefs Write SetCreateFieldDefs; 89 end; 90 91 { TCustomCSVDataset } 92 93 TCustomCSVDataset = Class(TBufDataset) 94 private 95 FCSVOptions: TCSVOptions; 96 procedure SetCSVOptions(AValue: TCSVOptions); 97 Protected 98 class function DefaultReadFileFormat : TDataPacketFormat; override; 99 class function DefaultWriteFileFormat : TDataPacketFormat; override; 100 class function DefaultPacketClass : TDataPacketReaderClass ; override; 101 function CreateDefaultPacketReader(aStream : TStream): TDataPacketReader ; override; 102 function GetPacketReader(const Format: TDataPacketFormat; const AStream: TStream): TDataPacketReader; override; 103 procedure LoadBlobIntoBuffer(FieldDef: TFieldDef;ABlobBuf: PBufBlobField); override; 104 procedure InternalInitFieldDefs; override; 105 Public 106 Constructor Create(AOwner : TComponent); override; 107 Destructor Destroy; override; 108 { If FieldDefs is filled prior to calling one of the load functions, 109 the fielddefs definitions will be checked against file contents 110 as far as possible: count and names if names are on first line} 111 procedure LoadFromCSVStream(AStream : TStream); 112 procedure LoadFromCSVFile(Const AFileName: string); 113 procedure SaveToCSVStream(AStream : TStream); 114 procedure SaveToCSVFile(AFileName: string = ''); 115 Protected 116 Property CSVOptions : TCSVOptions Read FCSVOptions Write SetCSVOptions; 117 end; 118 119 TCSVDataset = Class(TCustomCSVDataset) 120 Published 121 Property CSVOptions; 122 end; 123 124implementation 125 126{ TCSVDataPacketReader } 127 128procedure TCSVDataPacketReader.ReadNextRow; 129 130 131begin 132 FLine.Clear; 133 if not FEOF then 134 begin 135 if (FCurrentRow>0) then 136 FLine.Add(FParser.CurrentCellText); 137 Repeat 138 FEOF:=Not FParser.ParseNextCell; 139 if (not FEOF) and (FParser.CurrentRow=FCurrentRow) then 140 FLine.Add(FParser.CurrentCellText); 141 until FEOF or (FParser.CurrentRow>FCurrentRow); 142 end; 143 FCurrentRow:=FParser.CurrentRow; 144end; 145 146procedure TCSVDataPacketReader.SetCreateFieldDefs(AValue: TFieldDefs); 147begin 148 if FCreateFieldDefs=AValue then Exit; 149 if (FCreateFieldDefs=Nil) then 150 FCreateFieldDefs:=TFieldDefs.Create(AValue.Dataset); 151 FCreateFieldDefs.Assign(AValue); 152end; 153 154constructor TCSVDataPacketReader.Create(ADataSet: TCustomBufDataset; AStream: TStream); 155begin 156 inherited Create(ADataSet,AStream); 157 if FOptions=Nil then 158 begin 159 FOptions:=TCSVOptions.Create; 160 FOptions.FFirstLineAsFieldNames:=True; 161 FOwnsOptions:=True; 162 end; 163 FLine:=TStringList.Create; 164end; 165 166constructor TCSVDataPacketReader.Create(ADataSet: TCustomBufDataset; AStream: TStream; AOptions: TCSVOptions); 167begin 168 FOptions:=AOptions; 169 Create(ADataset,AStream); 170 FOwnsOptions:=AOptions=Nil; 171end; 172 173destructor TCSVDataPacketReader.Destroy; 174begin 175 FreeAndNil(FCreateFieldDefs); 176 If FOwnsOptions then 177 FreeAndNil(FOPtions); 178 FreeAndNil(Fline); 179 FreeAndNil(FParser); 180 inherited Destroy; 181end; 182 183procedure TCSVDataPacketReader.LoadFieldDefs(var AnAutoIncValue: integer); 184Var 185 FN : String; 186 I : Integer; 187 188begin 189 FParser:=TCSVParser.Create; 190 FParser.Assign(FOptions); 191 FParser.SetSource(Stream); 192 FCurrentRow:=0; 193 ReadNextRow; 194 If Assigned(CreateFieldDefs) then 195 begin 196 if (CreateFieldDefs.Count<>Fline.Count) then 197 DatabaseErrorFmt('CSV File Field count (%d) does not match dataset field count (%d).',[Fline.Count,CreateFieldDefs.Count],Dataset.FieldDefs.Dataset); 198 If FOptions.FirstLineAsFieldNames then 199 For I:=0 to FLine.Count-1 do 200 If (CompareText(FLine[i],CreateFieldDefs[i].Name)<>0) then 201 DatabaseErrorFmt('CSV File field %d: name "%s" does not match dataset field name "%s".',[I,FLine[i],CreateFieldDefs[i].Name],Dataset.FieldDefs.Dataset); 202 Dataset.FieldDefs.Assign(CreateFieldDefs); 203 end 204 else if (FLine.Count>0) then 205 For I:=0 to FLine.Count-1 do 206 begin 207 If FOptions.FirstLineAsFieldNames then 208 FN:=FLine[i] 209 else 210 FN:=Format('Column%d',[i+1]); 211 Dataset.FieldDefs.Add(FN,ftString,Foptions.DefaultFieldLength); 212 end; 213 if FOptions.FirstLineAsFieldNames then 214 ReadNextRow; 215end; 216 217procedure TCSVDataPacketReader.StoreFieldDefs(AnAutoIncValue: integer); 218 219Var 220 I : Integer; 221 222begin 223 FBuilder:=TCSVBuilder.Create; 224 FBuilder.Assign(FOptions); 225 FBuilder.SetOutput(Stream); 226 if FOptions.FirstLineAsFieldNames then 227 begin 228 For I:=0 to Dataset.FieldDefs.Count-1 do 229 FBuilder.AppendCell(Dataset.FieldDefs[i].Name); 230 FBuilder.AppendRow; 231 end; 232end; 233 234function TCSVDataPacketReader.GetRecordRowState(out AUpdOrder: Integer 235 ): TRowState; 236begin 237 AUpdOrder:=0; 238 Result:=[]; 239end; 240 241procedure TCSVDataPacketReader.FinalizeStoreRecords; 242begin 243 244end; 245 246function TCSVDataPacketReader.GetCurrentRecord: boolean; 247begin 248 Result:=Fline.Count>0; 249end; 250 251procedure TCSVDataPacketReader.GotoNextRecord; 252begin 253 ReadNextRow; 254end; 255 256procedure TCSVDataPacketReader.InitLoadRecords; 257begin 258 // Do nothing 259end; 260 261procedure TCSVDataPacketReader.RestoreRecord; 262 263Var 264 I : integer; 265 266begin 267 For I:=0 to Fline.Count-1 do 268 Dataset.Fields[i].AsString:=Copy(FLine[i],1,Dataset.Fields[i].Size) 269end; 270 271procedure TCSVDataPacketReader.StoreRecord(ARowState: TRowState; AUpdOrder: integer); 272Var 273 I : integer; 274 275begin 276 For I:=0 to Dataset.Fields.Count-1 do 277 FBuilder.AppendCell(Dataset.Fields[i].AsString); 278 FBuilder.AppendRow; 279end; 280 281class function TCSVDataPacketReader.RecognizeStream(AStream: TStream): boolean; 282begin 283 Result:=False; 284end; 285 286{ TCSVOptions } 287 288Constructor TCSVOptions.Create; 289begin 290 inherited Create; 291 DefaultFieldLength:=255; 292end; 293 294Procedure TCSVOptions.Assign(Source: TPersistent); 295begin 296 if (Source is TCSVOptions) then 297 begin 298 FFirstLineAsFieldNames:=TCSVOptions(Source).FirstLineAsFieldNames; 299 FDefaultFieldLength:=TCSVOptions(Source).FDefaultFieldLength 300 end; 301 inherited Assign(Source); 302end; 303 304{ TCustomCSVDataset } 305 306procedure TCustomCSVDataset.SetCSVOptions(AValue: TCSVOptions); 307begin 308 if (FCSVOptions=AValue) then Exit; 309 FCSVOptions.Assign(AValue); 310end; 311 312class function TCustomCSVDataset.DefaultReadFileFormat: TDataPacketFormat; 313begin 314 Result:=dfDefault; 315end; 316 317class function TCustomCSVDataset.DefaultWriteFileFormat: TDataPacketFormat; 318begin 319 Result:=dfDefault; 320end; 321 322class function TCustomCSVDataset.DefaultPacketClass: TDataPacketReaderClass; 323begin 324 Result:=TCSVDataPacketReader; 325end; 326 327function TCustomCSVDataset.CreateDefaultPacketReader(aStream: TStream): TDataPacketReader; 328begin 329 Result:=TCSVDataPacketReader.Create(Self,AStream,FCSVOptions) 330end; 331 332function TCustomCSVDataset.GetPacketReader(const Format: TDataPacketFormat; 333 const AStream: TStream): TDataPacketReader; 334begin 335 If (Format in [dfAny,dfDefault]) then 336 Result:=CreateDefaultPacketReader(AStream) 337 else 338 Result:=Inherited GetPacketReader(Format,AStream); 339end; 340 341procedure TCustomCSVDataset.LoadBlobIntoBuffer(FieldDef: TFieldDef; 342 ABlobBuf: PBufBlobField); 343begin 344 // Do nothing 345end; 346 347procedure TCustomCSVDataset.InternalInitFieldDefs; 348begin 349 // Do nothing 350end; 351 352constructor TCustomCSVDataset.Create(AOwner: TComponent); 353begin 354 inherited Create(AOwner); 355 FCSVOptions:=TCSVOptions.Create; 356end; 357 358destructor TCustomCSVDataset.Destroy; 359begin 360 // We must close here, before freeing the options. 361 Active:=False; 362 FreeAndNil(FCSVOptions); 363 inherited Destroy; 364end; 365 366procedure TCustomCSVDataset.LoadFromCSVStream(AStream: TStream); 367 368Var 369 P : TCSVDataPacketReader; 370 371begin 372 CheckInactive; 373 P:=TCSVDataPacketReader.Create(Self,AStream,FCSVOptions); 374 try 375 if FieldDefs.Count>0 then 376 P.CreateFieldDefs:=FieldDefs; 377 SetDatasetPacket(P); 378 finally 379 P.Free; 380 end; 381end; 382 383procedure TCustomCSVDataset.LoadFromCSVFile(const AFileName: string); 384 385Var 386 F : TFileStream; 387 388begin 389 F:=TFileStream.Create(AFileName,fmOpenRead or fmShareDenyWrite); 390 try 391 LoadFromCSVStream(F); 392 finally 393 F.Free; 394 end; 395end; 396 397procedure TCustomCSVDataset.SaveToCSVStream(AStream: TStream); 398 399Var 400 P : TCSVDataPacketReader; 401 402begin 403 First; 404 MergeChangeLog; 405 P:=TCSVDataPacketReader.Create(Self,AStream,FCSVOptions); 406 try 407 GetDatasetPacket(P); 408 finally 409 P.Free; 410 end; 411end; 412 413procedure TCustomCSVDataset.SaveToCSVFile(AFileName: string); 414Var 415 F : TFileStream; 416 417begin 418 F:=TFileStream.Create(AFileName, fmCreate); 419 try 420 SaveToCSVStream(F); 421 finally 422 F.Free; 423 end; 424end; 425 426end. 427 428