{*********************************************************} {* FlashFiler: Import/Export unit *} {*********************************************************} (* ***** BEGIN LICENSE BLOCK ***** * Version: MPL 1.1 * * The contents of this file are subject to the Mozilla Public License Version * 1.1 (the "License"); you may not use this file except in compliance with * the License. You may obtain a copy of the License at * http://www.mozilla.org/MPL/ * * Software distributed under the License is distributed on an "AS IS" basis, * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License * for the specific language governing rights and limitations under the * License. * * The Original Code is TurboPower FlashFiler * * The Initial Developer of the Original Code is * TurboPower Software * * Portions created by the Initial Developer are Copyright (C) 1996-2002 * the Initial Developer. All Rights Reserved. * * Contributor(s): * * ***** END LICENSE BLOCK ***** *) {$I ffdefine.inc} unit ffclimex; interface uses Windows, DB, DBConsts, Forms, SysUtils, Classes, IniFiles, TypInfo, ffsrbde, ffdbbase, ffdb, ffstdate, ffconst, ffclbase, fflldate, ffllexcp, ffconvff, ffclintf, ffllbase, fflldict; const DefDateMask = 'MM/DD/YYYY'; DefDblDelims = False; DefDelimitor = '"'; DefError = 'ERROR'; DefExt = '.SCH'; DefMaxLineLength = 8*1024; { Max line length assumed by ASCII import routines } DefSeparator = ','; DefEpoch : Integer = 1969; {!!.05} DefYieldInterval = 1; type TffieFileType = (ftCSV, ftASCII, ftBINARY, ftBTF, ftVARBTF); TffieNativeFieldType = (nftUnknown, nftChar, nftASCIIFloat, nftASCIINumber, nftASCIIBool, nftASCIILongInt, nftASCIIAutoInc, nftASCIIDate, nftASCIITime, nftASCIITimestamp, nftInt8, nftInt16, nftInt32, nftUInt8, nftUInt16, nftUInt32, nftAutoInc8, nftAutoInc16, nftAutoInc32, nftReal, nftSingle, nftDouble, nftExtended, nftComp, nftCurrency, nftBoolean, nftDateTime1, nftDateTime2, nftStDate, nftStTime, nftLString, nftZString, nftUnicode, nftBinary); {===== Schema File Classes =====} TffieFieldItem = class fiTargetFieldNo: SmallInt; fiFieldName: TffDictItemName; fiNativeTypeDesc: string[20]; fiNativeType: TffieNativeFieldType; fiNativeSize: SmallInt; fiNativeDecPl: SmallInt; fiNativeOffset: SmallInt; fiDateMask: string[25]; end; TffSchemaFieldList = class(TffObject) private FList : TList; function GetCount: Integer; protected function GetFieldItem(aIndex: Integer): TffieFieldItem; public constructor Create; destructor Destroy; override; procedure Add(aFieldItem : TffieFieldItem); property Count : Integer read GetCount; property Items[aIndex: Integer]: TffieFieldItem read GetFieldItem; end; TffSchemaFile = class(TIniFile) protected {private} FFilename: TFileName; FFields: TffSchemaFieldList; FMainSection: string; FRecLength: LongInt; FBTFDelFlag: Boolean; function GetDateMask: string; function GetDblDelims: Boolean; function GetDelimiter: AnsiChar; function GetFileType: TffieFileType; function GetSeparator: AnsiChar; procedure LoadFields; procedure SetDateMask(aValue: string); procedure SetDblDelims(aValue: Boolean); procedure SetDelimiter(aValue: AnsiChar); procedure SetFileType(aValue: TffieFileType); procedure SetRecLength(aValue: LongInt); procedure SetSeparator(aValue: AnsiChar); public constructor Create(aFileName: string); destructor Destroy; override; procedure BindDictionary(aDictionary: TffDataDictionary); function GetSourceFieldPtr(aBufPtr: Pointer; aFieldNo: Integer): Pointer; procedure MakeIntoDictionary(aDictionary: TffDataDictionary); property BTFDelFlag: Boolean read FBTFDelFlag; property DateMask: string read GetDateMask write SetDateMask; property DblDelims: Boolean read GetDblDelims write SetDblDelims; property Delimiter: AnsiChar read GetDelimiter write SetDelimiter; property Fields: TffSchemaFieldList read FFields; property FileType: TffieFileType read GetFileType write SetFileType; property RecordLength: LongInt read FRecLength write SetRecLength; property Section: string read FMainSection; property Separator: AnsiChar read GetSeparator write SetSeparator; end; {===== Stream Classes for File I/O =====} TffFileStream = class(TFileStream) protected protected function GetNumRecords: LongInt; virtual; abstract; function GetPercentCompleted: Word; virtual; function GetRecordLength: LongInt; virtual; abstract; public function Read(var Buffer; Count: LongInt): LongInt; override; function ReadRec(var Rec): Boolean; virtual; abstract; property NumRecords: LongInt read GetNumRecords; property PercentCompleted: Word read GetPercentCompleted; property RecordLength: LongInt read GetRecordLength; end; TffFixedFileStream = class(TffFileStream) protected {private} FRecLength: LongInt; FNumRecs: LongInt; protected function GetNumRecords: LongInt; override; function GetRecordLength: LongInt; override; public constructor Create(const aFileName: string; aMode: Word; aRecLength: LongInt); function ReadRec(var Rec): Boolean; override; end; TffFixedASCIIStream = class(TffFixedFileStream) protected {private} protected CRLF: Boolean; public function ReadRec(var Rec): Boolean; override; end; TffFixedBTFStream = class(TffFixedFileStream) protected {private} FNumSkipped: LongInt; DelFieldAvail: Boolean; protected public constructor Create(const aFileName: string; aMode: Word; aDelFlag: Boolean); function ReadRec(var Rec): Boolean; override; property NumSkipped: LongInt read FNumSkipped; end; TffVaryingFileStream = class(TffFileStream) protected public function ReadRec(var Rec): Boolean; override; end; {===== Field Conversion Classes to Parse Records =====} TffFieldConverter = class protected { private } FBuffer: Pointer; FBufLen: LongInt; FSchema: TffSchemaFile; FDict: TffDataDictionary; public procedure Init(aFieldBuf: Pointer; aBufLen: LongInt; aSchema: TffSchemaFile; aDictionary: TffDataDictionary); procedure AdjustMaskAndValue(aMask, aValue: TffShStr; var aDateMask, aDateValue, aTimeMask, aTimeValue: TffShStr); { Translates a FF date/time mask into one suitable for SysTools conversion routines (expands token characters out to the correct number of digitis for each element) } function ConvertField(aSourcePtr: Pointer; aSourceType: TffieNativeFieldType; aSourceSize: Integer; aTargetFFType: TffFieldType; aTargetSize: Integer; aDateMask: TffShStr): TffResult; end; {===== Engine Classes =====} TffieProgressPacket = record ppNumRecs: DWORD; ppTotalRecs: DWORD; end; TffieYieldEvent = procedure(aProgressPacket: TffieProgressPacket) of object; TffInOutEngine = class protected {private} FDataFile: TffFullFileName; FLogFile: TextFile; FLogFilename: TFileName; FLogCount: LongInt; FSchema: TffSchemaFile; FStream: TffFileStream; FTerminated: Boolean; FYieldInterval: Word; FImportFilename: TFileName; FOnYield: TffieYieldEvent; protected public constructor Create(const aFileName: TffFullFileName; aMode: Word); destructor Destroy; override; procedure PostLog(S: string); procedure Terminate; property LogFilename: TFilename read FLogFilename; property LogCount: LongInt read FLogCount; property Schema: TffSchemaFile read FSchema; property Stream: TffFileStream read FStream; property Terminated: Boolean read FTerminated; property YieldInterval: Word read FYieldInterval write FYieldInterval; property OnYield: TffieYieldEvent read FOnYield write FOnYield; end; TffExportEngine = class(TffInOutEngine) protected public end; TffImportEngine = class(TffInOutEngine) protected FieldConverter: TffFieldConverter; public constructor Create(const aFileName: TffFullFileName); { Creates the import engine. aFilename is the full path and filename for the file to import. } destructor Destroy; override; procedure Import(aTable: TffTable; aBlockInserts: Word); { Loads the import file into the given table. Importing only works with an existing table. If the import is aborted, the partially loaded table remains. } end; implementation function StripQuotes(S: TffShStr): TffShStr; begin S := FFShStrTrim(S); if Copy(S, 1, 1) = '"' then Delete(S, 1, 1); if COpy(S, Length(S), 1) = '"' then Delete(S, Length(S), 1); Result := S; end; { TffSchemaFieldList } procedure TffSchemaFieldList.Add(aFieldItem: TffieFieldItem); begin FList.Add(aFieldItem); end; constructor TffSchemaFieldList.Create; begin FList := TList.Create; end; destructor TffSchemaFieldList.Destroy; begin FList.Free; end; function TffSchemaFieldList.GetCount: Integer; begin Result := FList.Count; end; function TffSchemaFieldList.GetFieldItem(aIndex: Integer): TffieFieldItem; begin Result := TffieFieldItem(FList.Items[aIndex]); end; { TffSchemaFile } constructor TffSchemaFile.Create(aFileName: string); var Dir: string; FCB: TextFile; Rec: TffShStr; begin if not FileExists(aFileName) then FFRaiseException(EffClientException, ffStrResClient, ffccImport_NoSchemaFile, [aFilename]); { TIniFile will look in the WINDOWS directory if no path is given } if ExtractFilePath(aFileName) = '' then begin GetDir(0, Dir); aFileName := Dir + '\' + aFileName; end; FFileName := aFileName; inherited Create(FFileName); {FMainSection := ChangeFileExt(ExtractFileName(aFileName), '');} { Get section header } FMainSection := ''; AssignFile(FCB, FFileName); Reset(FCB); try repeat ReadLn(FCB, Rec); Rec := FFShStrTrim(Rec); until Rec <> ''; if (Length(Rec) > 2) and (Rec[1] = '[') and (Rec[Length(Rec)] = ']') then FMainSection := Copy(Rec, 2, Length(Rec) - 2) else FFRaiseException(EffClientException, ffStrResClient, ffccImport_BadSchemaHeader, [Rec]); finally CloseFile(FCB); end; FFields := TffSchemaFieldList.Create; LoadFields; { Check to see if the first field of a BTF file is the delete flag } with Fields.Items[0] do FBTFDelFlag := (FileType in [ftBTF, ftVARBTF]) and (Uppercase(fiFieldName) = 'DELFLAG') and (fiNativeType = nftInt32); { Get the record length of a fixed ASCII file } FRecLength := 0; if FileType in [ftASCII, ftBINARY] then begin FRecLength := ReadInteger(FMainSection, 'RECLENGTH', 0); if FRecLength = 0 then begin { reclength required for typed binary files } if FileType = ftBinary then FFRaiseExceptionNoData(EffClientException, ffStrResClient, ffccImport_RECLENGTHRequired); { For fixed ASCII, reclength defined by size and position of last field with an assumed CRLF } with FFields.Items[FFields.Count - 1] do FRecLength := fiNativeOffset + fiNativeSize + 2; end; end; end; destructor TffSchemaFile.Destroy; var I: Integer; begin if Assigned(FFields) then for I := 0 to FFields.Count - 1 do FFields.Items[I].Free; FFields.Free; inherited Destroy; end; procedure TffSchemaFile.BindDictionary(aDictionary: TffDataDictionary); var I: Integer; NoMatches: Boolean; begin NoMatches := True; for I := 0 to FFields.Count - 1 do if not ((I = 0) and BTFDelFlag) then with FFields.Items[I] do begin fiTargetFieldNo := aDictionary.GetFieldFromName(fiFieldName); if fiTargetFieldNo <> -1 then NoMatches := False; end; if NoMatches then FFRaiseExceptionNoData(EffClientException, ffStrResClient, ffccImport_NoMatchingFields); end; function TffSchemaFile.GetDateMask: string; begin Result := ReadString(FMainSection, 'DATEMASK', DefDateMask); end; function TffSchemaFile.GetDblDelims: Boolean; begin Result := ReadBool(FMainSection, 'DBLDELIMS', DefDblDelims); end; function TffSchemaFile.GetDelimiter: AnsiChar; begin Result := ReadString(FMainSection, 'DELIMITER', DefDelimitor)[1]; end; function TffSchemaFile.GetFileType: TffieFileType; var S: string; begin S := ReadString(FMainSection, 'FILETYPE', ''); if S = '' then FFRaiseExceptionNoData(EffClientException, ffStrResClient, ffccImport_FILETYPEMissing); Result := TffieFileType(GetEnumValue(TypeInfo(TffieFileType), 'ft' + S)); if Ord(Result) = -1 then FFRaiseExceptionNoData(EffClientException, ffStrResClient, ffccImport_FILETYPEInvalid); end; function TffSchemaFile.GetSeparator: AnsiChar; begin Result := ReadString(FMainSection, 'SEPARATOR', DefSeparator)[1]; end; procedure TffSchemaFile.LoadFields; function BuildField(FieldEntry: TffShStr): TffieFieldItem; var FieldID: TffShStr; Temp: TffShStr; begin { Parse the FIELD string from the schema file } Result := TffieFieldItem.Create; with Result do begin fiTargetFieldNo := -1; { Field ID } FFShStrSplit(FieldEntry, '=', Temp, FieldEntry); FieldID := FFShStrTrim(Temp); { Field name } FFShStrSplit(FieldEntry, ',', Temp, FieldEntry); fiFieldName := FFShStrTrim(Temp); if fiFieldName = '' then FFRaiseException(EffClientException, ffStrResClient, ffccImport_BadFieldName, [FieldID, fiFieldName]); { Import datatype } FFShStrSplit(FieldEntry, ',', Temp, FieldEntry); fiNativeTypeDesc := Uppercase(FFShStrTrim(Temp)); { Import field size } FFShStrSplit(FieldEntry, ',', Temp, FieldEntry); try fiNativeSize := StrToInt(FFShStrTrim(Temp)); except FFRaiseException(EffClientException, ffStrResClient, ffccImport_BadSize, [FieldID, Temp]); end; { Import decimal places } FFShStrSplit(FieldEntry, ',', Temp, FieldEntry); try fiNativeDecPl := StrToInt(FFShStrTrim(Temp)); except FFRaiseException(EffClientException, ffStrResClient, ffccImport_BadDecPl, [FieldID, Temp]); end; { Import offset } FFShStrSplit(FieldEntry, ',', Temp, FieldEntry); try fiNativeOffset := StrToInt(FFShStrTrim(Temp)); except FFRaiseException(EffClientException, ffStrResClient, ffccImport_BadOffset, [FieldID, Temp]); end; fiDateMask := ''; { The following tokens are valid for any import filetype } if fiNativeTypeDesc = 'CHAR' then fiNativeType := nftChar else if fiNativeTypeDesc = 'DATE' then begin fiNativeType := nftASCIIDate; fiDateMask := StripQuotes(FieldEntry); end else if fiNativeTypeDesc = 'TIME' then begin fiNativeType := nftASCIITime; fiDateMask := StripQuotes(FieldEntry); end else if fiNativeTypeDesc = 'TIMESTAMP' then begin fiNativeType := nftASCIITimeStamp; fiDateMask := StripQuotes(FieldEntry); end { The following tokens are valid only for ASCII import files } else if FileType in [ftASCII, ftCSV] then begin if fiNativeTypeDesc = 'BOOL' then fiNativeType := nftASCIIBool else if fiNativeTypeDesc = 'FLOAT' then fiNativeType := nftASCIIFloat else if fiNativeTypeDesc = 'NUMBER' then fiNativeType := nftASCIINumber else if fiNativeTypeDesc = 'LONGINT' then fiNativeType := nftASCIILongInt else if fiNativeTypeDesc = 'AUTOINC' then fiNativeType := nftASCIIAutoInc else FFRaiseException(EffClientException, ffStrResClient, ffccImport_BadFieldtype, [FieldID, fiNativeTypeDesc]); end { The following datatype tokens only apply to Binary and BTF files } else if FileType in [ftBINARY, ftBTF, ftVARBTF] then begin if fiNativeTypeDesc = 'BOOL' then fiNativeType := nftBoolean else if fiNativeTypeDesc = 'FLOAT' then begin case fiNativeSize of 4: fiNativeType := nftSingle; 6: fiNativeType := nftReal; 8: fiNativeType := nftDouble; 10: fiNativeType := nftExtended; else FFRaiseException(EffClientException, ffStrResClient, ffccImport_BadFloatSize, [FieldID]); end; end else if fiNativeTypeDesc = 'INTEGER' then begin case fiNativeSize of 1: fiNativeType := nftInt8; 2: fiNativeType := nftInt16; 4: fiNativeType := nftInt32; 8: fiNativeType := nftComp; else FFRaiseException(EffClientException, ffStrResClient, ffccImport_BadIntegerSize, [FieldID]); end; end else if fiNativeTypeDesc = 'UINTEGER' then begin case fiNativeSize of 1: fiNativeType := nftUInt8; 2: fiNativeType := nftUInt16; 4: fiNativeType := nftUInt32; else FFRaiseException(EffClientException, ffStrResClient, ffccImport_BadUIntegerSize, [FieldID]); end; end else if fiNativeTypeDesc = 'AUTOINC' then begin case fiNativeSize of 1: fiNativeType := nftAutoInc8; 2: fiNativeType := nftAutoInc16; 4: fiNativeType := nftAutoInc32; else FFRaiseException(EffClientException, ffStrResClient, ffccImport_BadAutoIncSize, [FieldID]); end; end else if fiNativeTypeDesc = 'STRING' then fiNativeType := nftLString else if fiNativeTypeDesc = 'ASCIIZ' then fiNativeType := nftZString else if fiNativeTypeDesc = 'UNICODE' then fiNativeType := nftUnicode else if fiNativeTypeDesc = 'CURRENCY' then fiNativeType := nftCurrency else if fiNativeTypeDesc = 'DATETIME1' then fiNativeType := nftDateTime1 else if fiNativeTypeDesc = 'DATETIME2' then fiNativeType := nftDateTime2 else if fiNativeTypeDesc = 'STDATE' then fiNativeType := nftStDate else if fiNativeTypeDesc = 'STTIME' then fiNativeType := nftStTime else if fiNativeTypeDesc = 'BINARY' then fiNativeType := nftBinary else FFRaiseException(EffClientException, ffStrResClient, ffccImport_BadFieldtype, [FieldID, fiNativeTypeDesc]); end else FFRaiseException(EffClientException, ffStrResClient, ffccImport_BadFieldtype, [FieldID, fiNativeTypeDesc]); end; end; var SchemaFields: TStringList; I: Integer; begin SchemaFields := TStringList.Create; try { Get all the field descriptors into a stringlist } SchemaFields.LoadFromFile(FFileName); { Traverse the stringlist and grab all the field descriptors in order } for I := 0 to SchemaFields.Count - 1 do if FFCmpShStrUC(FFShStrTrim(SchemaFields[I]), 'FIELD', 5) = 0 then Fields.Add(BuildField(SchemaFields[I])); finally SchemaFields.Free; end; if Fields.Count = 0 then FFRaiseExceptionNoData(EffClientException, ffStrResClient, ffccImport_NoFields); end; function TffSchemaFile.GetSourceFieldPtr(aBufPtr: Pointer; aFieldNo: Integer): Pointer; begin Result := nil; case FileType of ftASCII, ftBINARY, ftBTF: Result := PChar(aBufPtr) + Fields.Items[aFieldNo].fiNativeOffset; ftCSV: ; ftVARBTF: ; end; end; procedure TffSchemaFile.MakeIntoDictionary(aDictionary : TffDataDictionary); var I : Integer; FieldType : TffFieldType; Units, DecPl : Integer; begin for I := 0 to Fields.Count - 1 do if not ((I = 0) and BTFDelFlag) then begin with Fields.Items[I] do begin Units := 0; DecPl := 0; case fiNativeType of nftChar: begin if fiNativeSize = 1 then begin FieldType := fftChar; Units := 1; end else begin FieldType := fftShortString; Units := fiNativeSize; end; end; nftASCIIFloat: begin FieldType := fftDouble; DecPl := fiNativeDecPl; end; nftASCIINumber: FieldType := fftInt16; nftASCIIBool: FieldType := fftBoolean; nftASCIILongInt: FieldType := fftInt32; nftASCIIAutoInc: FieldType := fftAutoInc; nftASCIIDate: FieldType := fftDateTime; nftASCIITime: FieldType := fftDateTime; nftASCIITimestamp: FieldType := fftDateTime; nftInt8: FieldType := fftInt8; nftInt16: FieldType := fftInt16; nftInt32: FieldType := fftInt32; nftAutoInc8, nftAutoInc16, nftAutoInc32: FieldType := fftAutoInc; nftUInt8: FieldType := fftByte; nftUInt16: FieldType := fftWord16; nftUInt32: FieldType := fftWord32; nftReal: begin FieldType := fftDouble; DecPl := fiNativeDecPl; end; nftSingle: begin FieldType := fftSingle; DecPl := fiNativeDecPl; end; nftDouble: begin FieldType := fftDouble; DecPl := fiNativeDecPl; end; nftExtended: begin FieldType := fftExtended; DecPl := fiNativeDecPl; end; nftComp: begin FieldType := fftComp; DecPl := fiNativeDecPl; end; nftCurrency: begin FieldType := fftCurrency; DecPl := fiNativeDecPl; end; nftBoolean: FieldType := fftBoolean; nftDateTime1, nftDateTime2: FieldType := fftDateTime; nftLString: begin if fiNativeSize = 2 then FieldType := fftChar else if fiNativeSize <= 256 then FieldType := fftShortString else FieldType := fftNullString; Units := fiNativeSize - 1; end; nftZString: begin FieldType := fftNullString; Units := fiNativeSize - 1; end; nftUnicode: if fiNativeSize = 2 then FieldType := fftWideChar else begin FieldType := fftWideString; Units := (fiNativeSize - 2) div 2; end; nftStDate: FieldType := fftStDate; nftStTime: FieldType := fftStTime; else FieldType :=fftByteArray; Units := fiNativeSize; end; aDictionary.AddField(fiFieldName, '', FieldType, Units, DecPl, False, nil); end; end; end; procedure TffSchemaFile.SetDateMask(aValue: string); begin WriteString(FMainSection, 'DATEMASK', aValue); end; procedure TffSchemaFile.SetDblDelims(aValue: Boolean); begin WriteBool(FMainSection, 'DBLDELIMS', aValue); end; procedure TffSchemaFile.SetDelimiter(aValue: AnsiChar); begin WriteString(FMainSection, 'DELIMITER', aValue); end; procedure TffSchemaFile.SetFileType(aValue: TffieFileType); var S: string; begin S := GetEnumName(TypeInfo(TffieFileType), Integer(aValue)); Delete(S, 1, 2); WriteString(FMainSection, 'FILETYPE', S); end; procedure TffSchemaFile.SetRecLength(aValue: LongInt); begin FRecLength := aValue; end; procedure TffSchemaFile.SetSeparator(aValue: AnsiChar); begin WriteString(FMainSection, 'SEPARATOR', aValue); end; { TffFileStream } function TffFileStream.GetPercentCompleted: Word; begin Result := Round(Position * 100.0 / Size); end; function TffFileStream.Read(var Buffer; Count: LongInt): LongInt; begin if (Position = Size - 1) then begin Result := inherited Read(Buffer, 1); if Byte(Buffer) = $1A {EOF} then Result := 0; end else Result := inherited Read(Buffer, Count); end; { TffFixedFileStream } constructor TffFixedFileStream.Create(const aFileName: string; aMode: Word; aRecLength: LongInt); begin inherited Create(aFileName, aMode); if aRecLength > 0 then begin FRecLength := aRecLength; FNumRecs := Size div RecordLength; end; end; function TffFixedFileStream.GetNumRecords: LongInt; begin Result := FNumRecs; end; function TffFixedFileStream.GetRecordLength: LongInt; begin Result := FRecLength; end; function TffFixedFileStream.ReadRec(var Rec): Boolean; begin Result := Read(Rec, RecordLength) <> 0; end; { TffFixedASCIIStream } function TffFixedASCIIStream.ReadRec(var Rec): Boolean; var Buffer: Word; begin { Determine if we need to account for a CR+LF at the end of each record } if Position = 0 then begin Result := Read(Rec, RecordLength - 2) <> 0; Read(Buffer, 2); CRLF := Buffer = $0A0D; end else begin if CRLF then begin Result := Read(Rec, RecordLength - 2) <> 0; Position := Position + 2; end else Result := Read(Rec, RecordLength) <> 0; end; end; { TffFixedBTFStream } constructor TffFixedBTFStream.Create(const aFileName: string; aMode: Word; aDelFlag: Boolean); begin inherited Create(aFileName, aMode, 0); DelFieldAvail := aDelFlag; { Absorb the BTF header record } Position := 8; Read(FNumRecs, SizeOf(FNumRecs)); Read(FRecLength, SizeOf(FRecLength)); Position := FRecLength; end; function TffFixedBTFStream.ReadRec(var Rec): Boolean; begin repeat Inc(FNumSkipped); Result := inherited ReadRec(Rec); { Skip deleted records} until not Result or (not DelFieldAvail or (LongInt(Rec) = 0)); Dec(FNumSkipped); end; { TffVaryingFileStream } function TffVaryingFileStream.ReadRec(var Rec): Boolean; begin Result := False; end; { TffFieldConverter } procedure TffFieldConverter.Init(aFieldBuf: Pointer; aBufLen: LongInt; aSchema: TffSchemaFile; aDictionary: TffDataDictionary); begin FBuffer := aFieldBuf; FBufLen := aBufLen; FSchema := aSchema; FDict := aDictionary; end; procedure TffFieldConverter.AdjustMaskAndValue(aMask, aValue: TffShStr; var aDateMask, aDateValue, aTimeMask, aTimeValue: TffShStr); { Translates a FF date/time mask into one suitable for SysTools conversion routines (expands token characters out to the correct number of digitis for each element) } var I, J, K, N: Integer; ValueIdx: Integer; LastDateCharAt, LastTimeCharAt, FirstDateCharAt, FirstTimeCharAt: SmallInt; MaskStart, ValueStart: Integer; NewMask: string; Found: Boolean; NoDelimitersFound: Boolean; begin aDateMask := ''; aDateValue := ''; aTimeMask := ''; aTimevalue := ''; NewMask := ''; { Match number of digits in the mask with number of digits in the data } MaskStart := 1; ValueStart := 1; I := 1; NoDelimitersFound := True; while I <= Length(aMask) do begin { look for the next delimiter in the mask } if Pos(aMask[I], 'DMYhmst') = 0 then begin NoDelimitersFound := False; if I - MaskStart = 0 then begin {Error} Exit; end; { aMask[I] is our delimiter; find the position of this delimiter in the value } ValueIdx := ValueStart; Found := (aValue[ValueIdx] = aMask[I]); while not Found and (ValueIdx < Length(aValue)) do begin Inc(ValueIdx); Found := aValue[ValueIdx] = aMask[I]; end; { Count the digits in this element of the value } N := ValueIdx - ValueStart; if not Found or (N = 0) then begin {error} Exit; end; NewMask := NewMask + FFShStrRepChar(aMask[I - 1], N) + aMask[I]; MaskStart := I + 1; ValueStart := ValueIdx + 1; end; Inc(I); end; if NoDelimitersFound then NewMask := aMask else begin { Handle end-of-mask case } N := Length(aValue) - ValueStart + 1; NewMask := NewMask + FFShStrRepChar(aMask[Length(aMask)], N); end; {-- Special handling for "seconds" token; truncate fractional seconds --} for I := 1 to Length(NewMask) do { find start of "seconds" mask } if NewMask[I] = 's' then begin { Find the end of the "seconds" mask } J := I + 1; while (NewMask[J] = 's') and (J <= Length(NewMask)) do Inc(J); { Find first nondigit character in the "seconds" data } K := I; while (K < J) and (Pos(aValue[K], '0123456789') <> 0) do Inc(K); if K <> J then begin { Truncate mask and data } Delete(NewMask, K, J - K); Delete(aValue, K, J - K); end; Break; end; {-- Break up the date and time components --} LastDateCharAt := 0; LastTimeCharAt := 0; FirstDateCharAt := 0; FirstTimeCharAt := 0; { Find the bounds of each component in the mask } for I := 1 to Length(NewMask) do begin if Pos(NewMask[I], 'DMY') <> 0 then LastDateCharAt := I; if Pos(NewMask[I], 'hmst') <> 0 then LastTimeCharAt := I; J := Length(NewMask) - I + 1; if Pos(NewMask[J], 'DMY') <> 0 then FirstDateCharAt := J; if Pos(NewMask[J], 'hmst') <> 0 then FirstTimeCharAt := J; end; { Return date components } if FirstDateCharAt <> 0 then begin aDateMask := Copy(NewMask, FirstDateCharAt, LastDateCharAt - FirstDateCharAt + 1); aDateValue := Copy(aValue, FirstDateCharAt, LastDateCharAt - FirstDateCharAt + 1); end; { Return time components } if FirstTimeCharAt <> 0 then begin aTimeMask := Copy(NewMask, FirstTimeCharAt, LastTimeCharAt - FirstTimeCharAt + 1); aTimeValue := Copy(aValue, FirstTimeCharAt, LastTimeCharAt - FirstTimeCharAt + 1); end; end; function TffFieldConverter.ConvertField(aSourcePtr: Pointer; aSourceType: TffieNativeFieldType; aSourceSize: Integer; aTargetFFType: TffFieldType; aTargetSize: Integer; aDateMask: TffShStr): TffResult; var I: Integer; MinUnits: Integer; SourceFFType: TffFieldType; vFloat: Extended; vDouble: Double; vSmallInt: SmallInt; vLongInt: LongInt; vDateValue, vTimeValue: TffShStr; vDateMask, vTimeMask: TffShStr; Da, Mo, Yr: Integer; Hr, Mn, Sc: Integer; IsBlank: Boolean; function ExtractAsciiField(aPtr: PChar; aSize: SmallInt): TffShStr; var HoldChar: Char; begin HoldChar := aPtr[aSize]; aPtr[aSize] := #0; Result := FFStrPasLimit(aPtr, aSize); aPtr[aSize] := HoldChar; end; begin FillChar(FBuffer^, FBufLen, #0); Result := 0; { ASCII import fields that are totally blank are treated as nulls } if FSchema.FileType = ftASCII then begin IsBlank := True; for I := 0 to aSourceSize - 1 do begin IsBlank := FFCmpB(PByte(LongInt(aSourcePtr) + I)^, $20) = 0; if not IsBlank then Break; end; if IsBlank then begin Result := DBIERR_FIELDISBLANK; Exit; end; end; case aSourceType of nftChar: begin MinUnits := FFMinI(aSourceSize, aTargetSize); case aTargetFFType of fftChar: Char(FBuffer^) := Char(aSourcePtr^); fftShortString, fftShortAnsiStr: TffShStr(FBuffer^) := FFShStrTrimR(ExtractAsciiField(aSourcePtr, MinUnits)); fftNullString, fftNullAnsiStr: Move(aSourcePtr^, FBuffer^, MinUnits); fftWideChar: WideChar(FBuffer^) := FFCharToWideChar(Char(aSourcePtr^)); fftWideString: begin { Note: the length of a "wide" field is the number of bytes it occupies, not the number of wide chars it will hold. } MinUnits := FFMinI(aSourceSize - 1, (aTargetSize div SizeOf(WideChar)) - 1); FFShStrLToWideStr(FFShStrTrimR(TffShStr(aSourcePtr^)), FBuffer, MinUnits); end; else Result := DBIERR_INVALIDFLDXFORM; end; end; nftASCIIFloat: begin vFloat := {!!.02} StrToFloat(Trim(ExtractAsciiField(aSourcePtr, aSourceSize))); {!!.02} case aTargetFFType of fftSingle: Single(FBuffer^) := vFloat; fftDouble: Double(FBuffer^) := vFloat; fftExtended: Extended(FBuffer^) := vFloat; fftCurrency: Comp(FBuffer^) := vFloat * 10000.0; {!!.03} else Result := DBIERR_INVALIDFLDXFORM; end; end; nftASCIINumber: begin vSmallInt := StrToInt(Trim(ExtractAsciiField(aSourcePtr, aSourceSize))); {!!.02} case aTargetFFType of fftByte, fftInt8: Byte(FBuffer^) := vSmallInt; fftWord16, fftInt16: TffWord16(FBuffer^) := vSmallInt; fftWord32, fftInt32: TffWord32(FBuffer^) := StrToInt(Trim(ExtractAsciiField(aSourcePtr, aSourceSize))); {!!.02} fftComp: Comp(FBuffer^) := StrToInt(Trim(ExtractAsciiField(aSourcePtr, aSourceSize))); {!!.02} fftCurrency: begin Comp(FBuffer^) := StrToInt(Trim(ExtractAsciiField(aSourcePtr, aSourceSize))); {!!.02} Comp(FBuffer^) := Comp(FBuffer^) * 10000.0; end; fftAutoInc: TffWord32(FBuffer^) := vSmallInt; else Result := DBIERR_INVALIDFLDXFORM; end; end; nftASCIIBool: if aTargetFFType = fftBoolean then Boolean(FBuffer^) := (Char(aSourcePtr^) in ['T', 't', 'Y', 'y', '1']) else Result := DBIERR_INVALIDFLDXFORM; nftASCIILongInt, nftASCIIAutoInc: begin vLongInt := StrToInt(Trim(ExtractAsciiField(aSourcePtr, aSourceSize))); {!!.02} case aTargetFFType of fftWord32, fftInt32: TffWord32(FBuffer^) := vLongInt; fftComp: Comp(FBuffer^) := vLongInt; fftCurrency: begin Comp(FBuffer^) := vLongInt; Comp(FBuffer^) := Comp(FBuffer^) * 10000.0; end; fftAutoInc: TffWord32(FBuffer^) := vLongInt; else Result := DBIERR_INVALIDFLDXFORM; end; end; nftASCIIDate: begin AdjustMaskAndValue(aDateMask, ExtractAsciiField(aSourcePtr, aSourceSize), vDateMask, vDateValue, vTimeMask, vTimeValue); DateStringToDMY(vDateMask, vDateValue, Da, Mo, Yr, DefEpoch); if (Yr = 0) and (Mo = 0) and (Da = 0) then begin Result := DBIERR_FIELDISBLANK; Exit; end; {if Yr < 100 then Yr := Yr + DefEpoch;} {!!.05 - Deleted} Yr := ResolveEpoch(Yr, DefEpoch); {!!.05 - Added} case aTargetFFType of fftDateTime: { TDateTime values are stored in the buffer as Delphi 1 dates } TDateTime(FBuffer^) := EncodeDate(Yr, Mo, Da) + 693594.0; fftStDate: TStDate(FBuffer^) := DMYToStDate(Da, Mo, Yr, DefEpoch); else Result := DBIERR_INVALIDFLDXFORM; end; end; nftASCIITime: begin AdjustMaskAndValue(aDateMask, ExtractAsciiField(aSourcePtr, aSourceSize), vDateMask, vDateValue, vTimeMask, vTimeValue); TimeStringToHMS(vTimeMask, vTimeValue, Hr, Mn, Sc); case aTargetFFType of fftDateTime: TDateTime(FBuffer^) := EncodeTime(Hr, Mn, Sc, 0); fftStTime: TStTime(FBuffer^) := HMSToStTime(Hr, Mn, Sc); else Result := DBIERR_INVALIDFLDXFORM; end; end; nftASCIITimestamp: begin AdjustMaskAndValue(aDateMask, ExtractAsciiField(aSourcePtr, aSourceSize), vDateMask, vDateValue, vTimeMask, vTimeValue); DateStringToDMY(vDateMask, vDateValue, Da, Mo, Yr, DefEpoch); if (Yr = 0) and (Mo = 0) and (Da = 0) then begin Result := DBIERR_FIELDISBLANK; Exit; end; {if Yr < 100 then Yr := Yr + DefEpoch;} {!!.05 - Deleted} Yr := ResolveEpoch(Yr, DefEpoch); {!!.05 - Added} TimeStringToHMS(vTimeMask, vTimeValue, Hr, Mn, Sc); if Hr < 0 then Hr := 0; if Mn < 0 then Mn := 0; if Sc < 0 then Sc := 0; case aTargetFFType of fftDateTime: { TDateTime values are stored in the buffer as Delphi 1 dates } TDateTime(FBuffer^) := EncodeDate(Yr, Mo, Da) + 693594.0 + EncodeTime(Hr, Mn, Sc, 0); fftStDate: TStDate(FBuffer^) := DMYToStDate(Da, Mo, Yr, DefEpoch); fftStTime: TStTime(FBuffer^) := HMSToStTime(Hr, Mn, Sc); else Result := DBIERR_INVALIDFLDXFORM; end; end; nftReal: begin vDouble := Real(aSourcePtr^); case aTargetFFType of fftSingle: Single(FBuffer^) := vDouble; fftDouble: Double(FBuffer^) := vDouble; fftExtended: Extended(FBuffer^) := vDouble; fftCurrency: begin Comp(FBuffer^) := vDouble; Comp(FBuffer^) := Comp(FBuffer^) * 10000.0; end; else Result := DBIERR_INVALIDFLDXFORM; end; end; else begin { All remaining datatypes are native to FlashFiler. Map datatypes and use the FF restructure conversion routine. } case aSourceType of nftInt8: SourceFFType := fftInt8; nftInt16: SourceFFType := fftInt16; nftInt32: SourceFFType := fftInt32; nftUInt8: SourceFFType := fftByte; nftUInt16: SourceFFType := fftWord16; nftUInt32: SourceFFType := fftWord32; nftAutoInc8, nftAutoInc16, nftAutoInc32: SourceFFType := fftAutoInc; nftSingle: SourceFFType := fftSingle; nftDouble: SourceFFType := fftDouble; nftExtended: SourceFFType := fftExtended; nftComp: SourceFFType := fftComp; nftCurrency: SourceFFType := fftCurrency; nftBoolean: SourceFFType := fftBoolean; nftDateTime1: SourceFFType := fftDateTime; nftDateTime2: begin SourceFFType := fftDateTime; { TDateTime values must be written to the record buffer as Delphi 1 values } TDateTime(aSourcePtr^) := TDateTime(aSourcePtr^) + 693594.0; end; nftLString: SourceFFType := fftShortString; nftZString: SourceFFType := fftNullString; nftUnicode: if aSourceSize = 2 then SourceFFType := fftWideChar else SourceFFType := fftWideString; nftStDate: SourceFFType := fftStDate; nftStTime: SourceFFType := fftStTime; else SourceFFType := fftByteArray; end; Result := FFConvertSingleField(aSourcePtr, FBuffer, SourceFFType, aTargetFFType, aSourceSize, aTargetSize); end; end; end; { TffInOutEngine } constructor TffInOutEngine.Create(const aFileName: TffFullFileName; aMode: Word); begin FLogFilename := ChangeFileExt(aFilename, '.LOG'); DeleteFile(FLogFilename); FLogCount := 0; FTerminated := False; FYieldInterval := DefYieldInterval; FImportFilename := aFileName; FSchema := TffSchemaFile.Create(ChangeFileExt(aFileName, DefExt)); case FSchema.FileType of ftASCII: FStream := TffFixedASCIIStream.Create(aFileName, aMode, FSchema.RecordLength); ftBINARY: FStream := TffFixedFileStream.Create(aFilename, aMode, FSchema.RecordLength); ftBTF: begin FStream := TffFixedBTFStream.Create(aFileName, aMode, FSchema.BTFDelFlag); FSchema.RecordLength := FStream.RecordLength; end; ftCSV: ; ftVARBTF: ; end; end; destructor TffInOutEngine.Destroy; begin if FLogCount <> 0 then CloseFile(FLogFile); FStream.Free; FSchema.Free; inherited Destroy; end; procedure TffInOutEngine.PostLog(S: string); begin if LogCount = 0 then begin AssignFile(FLogFile, FLogFilename); Rewrite(FLogFile); end; WriteLn(FLogFile, S); Inc(FLogCount); end; procedure TffInOutEngine.Terminate; begin FTerminated := True; end; { TffImportEngine } constructor TffImportEngine.Create(const aFileName: TffFullFileName); begin inherited Create(aFileName, fmOpenRead); FieldConverter := TffFieldConverter.Create; end; destructor TffImportEngine.Destroy; begin FieldConverter.Free; inherited Destroy; end; procedure TffImportEngine.Import(aTable: TffTable; aBlockInserts: Word); var RecBuffer: PByteArray; FldBuffer: Pointer; FldBufLen: LongInt; FFTable: TffTable; F: Integer; DateMask: TffShStr; ProgressPacket: TffieProgressPacket; Status: TffResult; IsNull: Boolean; DoExplicitTrans: Boolean; InTransaction: Boolean; AutoIncField: Integer; AutoIncHighValue: TffWord32; begin if aTable.CursorID = 0 then DatabaseError(SDataSetClosed); if not aTable.Active then DatabaseError(SDataSetClosed); { If we only have one insert per transaction, then let the server do implicit transactions; it'll be faster } if aBlockInserts = 0 then aBlockInserts := 1; DoExplicitTrans := (aBlockInserts > 1); FFTable := aTable; Schema.BindDictionary(FFTable.Dictionary); { See if we'll need to deal with an autoinc field } AutoIncHighValue := 0; if not FFTable.Dictionary.HasAutoIncField(AutoIncField) then AutoIncField := -1; { Find the largest target field } FldBufLen := 0; for F := 0 to Schema.Fields.Count - 1 do with Schema.Fields.Items[F] do if fiTargetFieldNo <> -1 then FldBufLen := FFMaxDW(FFTable.Dictionary.FieldLength[fiTargetFieldNo], FldBufLen); { Allocate field buffer } FFGetMem(FldBuffer, FldBufLen); try { Bind the field converter } FieldConverter.Init(FldBuffer, FldBufLen, Schema, FFTable.Dictionary); { Allocate record buffer } FFGetMem(RecBuffer, FStream.RecordLength); try with ProgressPacket do begin ppTotalRecs := Stream.NumRecords; ppNumRecs := 0; end; InTransaction := False; try { For each record in the import file... } while FStream.ReadRec(RecBuffer^) do begin Inc(ProgressPacket.ppNumRecs); { Check to see if we need to send the progress status } if (ProgressPacket.ppNumRecs mod YieldInterval) = 0 then if Assigned(FOnYield) then begin FOnYield(ProgressPacket); Application.ProcessMessages; { Check for user termination } if Terminated then begin if InTransaction then aTable.Database.Rollback; Exit; end; end; { Blocks inserts within a transaction } if DoExplicitTrans and not InTransaction then begin aTable.Database.StartTransaction; InTransaction := True; end; aTable.Insert; { Set all fields to default (null) values } aTable.ClearFields; { Find all fields in the import file } for F := 0 to Schema.Fields.Count - 1 do begin with Schema.Fields.Items[F], FFTable.Dictionary do begin if fiTargetFieldNo <> - 1 then begin { If we have an ASCII date/time field, fetch the mask } DateMask := ''; if fiNativeType in [nftASCIIDate, nftASCIITime, nftASCIITimestamp] then begin DateMask := fiDateMask; if DateMask = '' then DateMask := Schema.DateMask; end; { Convert the field into FF datatype } Status := FieldConverter.ConvertField(Schema.GetSourceFieldPtr(RecBuffer, F), fiNativeType, fiNativeSize, FieldType[fiTargetFieldNo], FieldLength[fiTargetFieldNo], DateMask); with FFTable.Dictionary do begin if Status = 0 then begin { All's well, save the field data to the record buffer } SetRecordField(fiTargetFieldNo, Pointer(aTable.ActiveBuffer), FldBuffer); { Check for AutoInc field and retain largest value observed } if fiTargetFieldNo = AutoIncField then begin if FFCmpDW(PffWord32(FldBuffer)^, AutoIncHighValue) > 0 then AutoIncHighValue := PffWord32(FldBuffer)^; end; end else begin { Assign null for this field } SetRecordField(fiTargetFieldNo, Pointer(aTable.ActiveBuffer), nil); case Status of DBIERR_INVALIDFLDXFORM: if ProgressPacket.ppNumRecs = 1 then PostLog(Format('Field %s datatype %s is incompatible ' + 'with target field datatype %s', [fiFieldName, fiNativeTypeDesc, GetEnumName(TypeInfo(TffFieldType), Ord(FieldType[fiTargetFieldNo])) ])); end; end; end; end; end; end; { Clean up "required" fields that are null; assign binary zero value } FillChar(FldBuffer^, FldBufLen, #0); with FFTable.Dictionary do begin for F := 0 to FieldCount - 1 do begin GetRecordField(F, Pointer(aTable.ActiveBuffer), IsNull, nil); if IsNull and FieldRequired[F] then if not (FieldType[F] in [fftBLOB..ffcLastBLOBType]) then { set nonBLOB fields to zeros } SetRecordField(F, Pointer(aTable.ActiveBuffer), FldBuffer); { Required BLOB fields are going to fail if not loaded by the import } end; end; { Post the changes } aTable.Post; if AutoIncField <> -1 then Check(aTable.SetTableAutoIncValue(AutoIncHighValue)); { See if it's time to commit the transaction } if InTransaction and ((ProgressPacket.ppNumRecs mod aBlockInserts) = 0) then begin aTable.Database.Commit; InTransaction := False; end; end; { Residual inserts need to be posted? } if InTransaction then aTable.Database.Commit; except on E:Exception do begin if InTransaction then aTable.Database.Rollback; raise; end; end; { Check to see if we need to send the final progress status } if (ProgressPacket.ppNumRecs mod YieldInterval) <> 0 then if Assigned(FOnYield) then begin FOnYield(ProgressPacket); Application.ProcessMessages; end; finally FFFreeMem(RecBuffer, FStream.RecordLength); end; finally FFFreeMem(FldBuffer, FldBufLen); end; end; end.