2006. március 30., csütörtök
Generic File Importer Base Class
Problem/Question/Abstract:
Here is a useful base class to create derived classes to import data from any flat file format you can think of...
Answer:
{-----------------------------------------------------------------------------
Unit Name: classParentDataManipulator
Author: StewartM (Stewart Moss)
Documentation Date: 23, 08, 2002 (14:39,)
Version 1.0
-----------------------------------------------------------------------------
Compiler Directives:
Purpose:
Dependancies:
Description:
Parent Class for data manipulation
Creates the basic skelton for adding data manipulation sub-classes
Each of the inherited classes must override the ProcessData method and provide
their own properties specific to the class (ie Invoice Number etc...)
Very useful class.
inheritance Diagram
+ -- TParentDataProcessor // base class
+
|
+ --- TDerivedImporter // sub class
Notes:
History:
Copyright 2002 by Stewart Moss.
All rights reserved.
-----------------------------------------------------------------------------}
unit classParentDataManipulator;
interface
uses Sysutils, Classes;
type
TParentDataProcessor = class(TObject)
private
StringIn: string;
LineCounter: Integer;
public
FieldNames,
FieldValues,
MultiFieldNames,
MultiFieldValues: TStringList;
FormName,
FileName: string;
Delimiters: string;
// A list of delimiters (ie ',/[];:') used in inherited ProcessData()
constructor create;
destructor Destroy; override;
procedure ProcessFile;
function DataAtPos(S: string; StartP, EndP: Integer): string;
// Returns the data from "StartP" to "EndP" in String "S"
function ExpandTabs(s: string): string;
// ExpandTabs to 8 Spaces
procedure ProcessData(StrIn: string; LineNumber: Integer); virtual;
// Virtual method for override in sub-classes
procedure FieldAdd(FieldName, Data: string; GenException: Boolean);
// Adds FieldName and FieldValue to Strings and can generate exception if
// string is empty when required
procedure MultiFieldAdd(FieldName, Data: string; GenException: Boolean);
// Adds FieldName and FieldValue to Multi Field Strings and can generate exception
// if string is empty when required
end;
TProcessException = Exception;
implementation
var
F: text;
// Exception: TProcessException;
{ TDataProcessor }
constructor TParentDataProcessor.create;
begin
inherited create;
FieldNames := TStringList.Create;
FieldValues := TStringList.Create;
MultiFieldNames := TStringList.Create;
MultiFieldValues := TStringList.Create;
FieldNames.Clear;
FieldValues.Clear;
MultiFieldNames.Clear;
MultiFieldValues.Clear;
end;
procedure TParentDataProcessor.ProcessFile;
begin
if Filename = '' then
raise Exception.Create('No Filename specified');
try
AssignFile(F, Filename);
Reset(f);
except
try
CloseFile(F);
except
end;
raise Exception.Create('Could not open file ' + FileName);
end;
LineCounter := 0;
while not eof(f) do
begin
Inc(LineCounter);
try
Readln(f, StringIn);
except
try
CloseFile(f);
except // swallow CloseFile errors
end;
raise Exception.Create('Could not read from file. Line number ' +
IntToStr(LineCounter));
end;
StringIn := ExpandTabs(StringIn);
// Exapnd Tabs to 8 Spaces
ProcessData(StringIn, LineCounter);
// Execute virutal method in sub-classes passing current line and LineNumber
end;
try
closefile(f);
except
raise Exception.Create('Could not close file ' + FileName);
end;
end;
procedure TParentDataProcessor.ProcessData(StrIn: string; LineNumber: Integer);
// Virtual method for override in sub-classes
begin
//
end;
destructor TParentDataProcessor.Destroy;
begin
FieldNames.Free;
FieldValues.Free;
MultiFieldNames.Free;
MultiFieldValues.Free;
end;
function TParentDataProcessor.DataAtPos(S: string; StartP,
EndP: Integer): string;
begin
// Returns the data from "StartP" to "EndP" in String "S"
Result := trim(Copy(S, StartP, EndP - StartP));
end;
function TParentDataProcessor.ExpandTabs(s: string): string;
begin
// ExpandTabs to 8 Spaces
Result := StringReplace(S, #09, ' ', [rfReplaceAll]);
end;
procedure TParentDataProcessor.FieldAdd(FieldName, Data: string;
GenException: Boolean);
begin
// Adds FieldName and FieldValue to Strings and can generate exception if
// string is empty
if (GenException) and (Data = '') then
raise Exception.create('-- No ' + FieldName + ' Specified --');
Fieldnames.add(FieldName);
FieldValues.add(Data);
end;
procedure TParentDataProcessor.MultiFieldAdd(FieldName, Data: string;
GenException: Boolean);
var
loop: integer;
flag: Boolean;
begin
// Adds FieldName and FieldValue to Multi Field Strings and can generate exception
// if string is empty
if (GenException) and (Data = '') then
raise Exception.create('-- No Multiple Field - ' + FieldName + ' Specified --');
flag := false;
loop := 0;
while (loop < MultiFieldNames.count) and not flag do
begin
if MultiFieldNames.Strings[loop] = FieldName then
flag := true;
inc(Loop);
end;
dec(loop);
if Flag then
MultiFieldValues.Strings[loop] := MultiFieldValues.Strings[loop] + ';' + Data
else
begin
MultiFieldNames.add(FieldName);
MultiFieldValues.add(Data);
end;
end;
end.
Feliratkozás:
Megjegyzések küldése (Atom)
Nincsenek megjegyzések:
Megjegyzés küldése