unit mxEDIFACTunit;
interface
uses windows, sysutils, Messages, Classes,
db;
type
tmxedi_array_of_string = array of string;
tmxedi_una = class(tObject)
private
fUNA_1, // : Composite-Element
fUNA_2, // + Datenelement Trennzeichen
fUNA_3, // , Zeichen für Dezimalkomma
fUNA_4, // ? Release Zeichen Wennzeichen 1 bis 4 und 6 im text vorkommt muss es mit Releqase Zeichen escaped werden
fUNA_5, // _ Reserviert, bleibt leer = Leerzeichen
fUNA_6 // ' Segmentendezeichen
: char;
protected
procedure set_una(value:string);
function get_una:string;
public
constructor Create;
destructor Destroy; override;
published
property UNA_1_Composite_Element: char read fUna_1 write funa_1;
property UNA_2_Datenelement_TZ: char read funa_2 write funa_2;
property UNA_3_Dezimalkomma: char read funa_3 write funa_3;
property UNA_4_Release_Zeichen: char read funa_4 write funa_4;
property UNA_5_Reserved: char read funa_5 write funa_5;
property UNA_6_Segmentendezeichen: char read funa_6 write funa_6;
property UNA:string read get_una write set_una;
function StartROW(value:string):string;
function AddSegment(values: array of string):string;
function ExtractElement(var value:string; vtype:string):string;
function GetFieldValues(value:string; var v:tmxedi_array_of_string):integer;
end;
tmxedi_dataset_description_fieldtype = (ftString, ftInteger, ftLargeint, ftBoolean, ftFloat, ftDate, ftTime, ftDateTime, ftTimeStamp);
tmxedi_dataset_description_sids = record
id:string[4];
feld:string[4];
description:string[64];
typ:tmxedi_dataset_description_fieldtype;
mussfeld:boolean;
end;
tmxedi_dataset_description = record
datacount:integer;
datasids:array of tmxedi_dataset_description_sids;
end;
tmxedi_segment = class(tObject)
private
funa:tmxedi_una;
fDataType:string;
fdescription: array of tmxedi_dataset_description;
fdata:tstrings;
function getsidfieldname(const fd:array of tmxedi_dataset_description; vnr,vfeldid:integer):string;
protected
procedure set_data(value:string);
function get_data():string;
procedure set_Format(value:string);
function get_Format():string;
public
constructor Create; overload;
constructor Create(AOwner:TComponent); overload;
destructor Destroy; override;
published
property UNA_link:tmxedi_una read funa write funa;
property DataType:string read fDataType write fDataType;
property DataFormat:string read get_Format write set_Format;
property DataValue:string read get_data write set_data;
end;
tmxedi_segment_array = array of tmxedi_segment;
tmxEDIFACT = class(tComponent)
private
fUNA:tmxedi_una;
fDataSegments:tmxedi_segment_array;
fDataSegmentsFormat:tstrings;
protected
procedure Notification(AComponent:TComponent; Operation:TOperation); override;
procedure set_DataSegmentsFormat(Value:tStrings);
function get_DataOutput():string;
procedure set_DataInput(value: tStrings);
public
constructor Create(AOwner:TComponent); override;
destructor Destroy; override;
published
property UNA:tmxedi_una read funa write funa;
property DataSegments:tmxedi_segment_array read fDataSegments;
property DataSegmentsFormat:tstrings read fDataSegmentsFormat write set_DataSegmentsFormat;
property Output:string read get_DataOutput;
property Input:tstrings write set_DataInput;
end;
procedure Register;
implementation
// *************************************************************************************************************************************
// UNA
// *************************************************************************************************************************************
constructor tmxEDI_una.Create;
begin
inherited Create;
// Initialisierung der Parameter
self.UNA:=':+,? '+'''';
end;
destructor tmxedi_una.Destroy;
begin
inherited destroy;
end;
function tmxEDI_una.get_una;
begin
result:=fUNA_1+fUNA_2+fUNA_3+fUNA_4+fUNA_5+fUNA_6;
end;
procedure tmxEDI_una.set_una(value: string);
begin
if length(value)=6 then begin
fUNA_1:=value[1];
fUNA_2:=value[2];
fUNA_3:=value[3];
fUNA_4:=value[4];
fUNA_5:=value[5];
fUNA_6:=value[6];
end else begin
raise
Exception.Create('UNA muss 6 Zeichen lang sein!');
end;
end;
function tmxEDI_una.StartROW(value:string):string; begin result:=value+self.UNA_2_Datenelement_TZ; end;
function tmxEDI_una.AddSegment(values: array of string):string;
var
i:integer;
vtmp:string;
begin
result:='';
for i:=0 to length(values)-1 do begin
if result<>'' then result:=result+self.UNA_1_Composite_Element;
result:=result+values[i];
end;
end;
function tmxEDI_una.ExtractElement(var value:string; vtype:string):string;
var
i:integer;
begin
result:='';
i:=-1;
if vtype='+' then i:=pos(UNA_2_Datenelement_TZ, value);
if vtype=':' then i:=pos(UNA_1_Composite_Element, value);
if i<>-1 then begin
if i=0 then begin
i:=pos(UNA_6_Segmentendezeichen, value);
if i>0 then begin
result:=copy(value,1,i-1);
value:=copy(value, i, length(value));
end else begin
result:=value;
value:='';
end;
end else begin
result:=copy(value,1,i-1);
value:=copy(value,i+1,length(value));
end;
end;
// konvertierung durchführen , de_escape
result:=stringreplace(result, UNA_4_Release_Zeichen+UNA_4_Release_Zeichen, '$$rlz$$', [rfReplaceAll]); // excaped escape-zeichen sichern
result:=stringreplace(result, UNA_4_Release_Zeichen, '', [rfReplaceAll]);
result:=stringreplace(result, '$$rlz$$', UNA_4_Release_Zeichen, [rfReplaceAll]);
end;
function tmxEDI_una.GetFieldValues(value:string; var v:tmxedi_array_of_string):integer;
var
vtmp:string;
i:integer;
begin
setlength(v,0);
result:=0;
vtmp:=ExtractElement(value, ':');
setlength(v, length(v)+1);
v[length(v)-1]:=vtmp;
// abcde:dddd:dddd
while value<>'' do begin
vtmp:=ExtractElement(value, ':');
setlength(v, length(v)+1);
v[length(v)-1]:=vtmp;
end;
result:=length(v);
end;
// *************************************************************************************************************************************
// UNDATASET
// *************************************************************************************************************************************
constructor tmxedi_segment.Create;
begin
inherited Create;
UNA_Link:=nil;
raise
Exception.Create('MXEDI Segment: Create nur mit aOwner aufrufbar!');
end;
constructor tmxedi_segment.Create(AOwner: TComponent);
begin
inherited Create;
UNA_link:=tmxEDIFACT(aOwner).fUNA;
// Initialisierung der Parameter
// UNG+IFTMIN+0001GPO+0120CTXX+040130:1452+UNG-123+UN+D:03A'
self.DataType:='NIL';
fdata:=tstringlist.Create;
//self.DataFormat:='NIL'+UNA_link.UNA_2_Datenelement_TZ;
// wird per routine alles einrichten
end;
destructor tmxedi_segment.Destroy;
begin
UNA_Link:=nil;
fdata.Clear;
fdata.free;
inherited destroy;
end;
function tmxedi_segment.get_Data():string;
var
i, idata:integer;
vtemp:string;
v:array of string;
procedure __va(val:string);
begin
setlength(v, length(v)+1);
v[length(v)-1]:=val;
end;
procedure __AddSegment();
begin
result:=result+una_link.AddSegment(v);
setlength(v,0);
end;
begin
setlength(v,0);
result:=una_link.StartRow(fDataType);
for i:=0 to length(fdescription)-1 do begin
vtemp:='';
for idata:=0 to fdescription[i].datacount-1 do begin
vtemp:=vtemp+fdata.values[getsidfieldname(fdescription,i,idata)];
if idata<(fdescription[i].datacount-1) then begin
vtemp:=vtemp+UNA_link.UNA_1_Composite_Element;
end;
end;
if (length(vtemp)=(fdescription[i].datacount-1)) and (vtemp=StringOfChar(UNA_link.UNA_1_Composite_Element,fdescription[i].datacount-1)) then begin
vtemp:='';
end;
result:=result+vtemp;
if i<(length(fdescription)-1) then begin
result:=result+UNA_link.UNA_2_Datenelement_TZ;
end;
__AddSegment();
end;
result:=result+una_link.UNA_6_Segmentendezeichen;
end;
function tmxedi_segment.getsidfieldname(const fd:array of tmxedi_dataset_description; vnr, vfeldid:integer):string;
begin
result:=fd[vnr].datasids[vfeldid].id+'_'+fd[vnr].datasids[vfeldid].feld+'_'+inttostr(vnr);
end;
procedure tmxedi_segment.set_Format(value:string);
var
vtmp:string;
v:tmxedi_array_of_string;
vfields,i,vc:integer;
procedure __setids(var fd:tmxedi_dataset_description; idnr:integer; idtmp:string);
begin
// S000|0022$description of this data$
if pos('|',idtmp)>0 then begin
fd.datasids[idnr].id:=copy(idtmp,1,pos('|',idtmp)-1);
fd.datasids[idnr].feld:=copy(idtmp,pos('|',idtmp)+1,length(idtmp));
end else begin
fd.datasids[idnr].id:=idtmp;
fd.datasids[idnr].feld:='';
end;
if pos('$',idtmp)>0 then begin
idtmp:=copy(idtmp, pos('$',idtmp)+1, length(idtmp));
if pos('$',idtmp)>0 then idtmp:=copy(idtmp,1,pos('$',idtmp)-1);
end else begin
idtmp:='';
end;
fd.datasids[idnr].description:=idtmp;
end;
function __getfields():integer; begin vtmp:=UNA_link.ExtractElement(value, '+'); vc:=UNA_link.GetFieldValues(vtmp, v); result:=length(v); end;
begin
if copy(value,1,length(fDataType))=fDataType then begin
// UNB+S000|0022:S000|0033+S010|0020+S012|0080+0055:0099+S090+S080+S081|0041+S081|0042+S081|0043+S081|0044+S081|0046'
vtmp:=UNA_link.ExtractElement(value, '+'); // = UNB
setlength(fdescription,0);
while (value<>'') and (value<>UNA_link.UNA_6_Segmentendezeichen) do begin
vfields:=__getfields();
// hier eine bezeichnung der felder ??
setlength(fdescription, length(fdescription)+1);
fdescription[length(fdescription)-1].datacount:=vfields;
setlength(fdescription[length(fdescription)-1].datasids,vfields);
for i:=0 to vfields-1 do begin
__setids(fdescription[length(fdescription)-1], i, v[i]);
end;
end;
end else begin
raise
Exception.Create(format('Description not for: "%s"',[value]));
end;
end;
function tmxedi_segment.get_format():string;
begin
result:='format';
end;
procedure tmxedi_segment.set_Data(value: string);
var
vtmp:string;
idata, vc, tmpcount,i:integer;
v:tmxedi_array_of_string;
function __getfields():integer; begin
vtmp:=UNA_link.ExtractElement(value, '+');
vc:=UNA_link.GetFieldValues(vtmp, v);
result:=length(v);
end;
begin
// UNB+UNOC:3+0001GPO+GPO+040130:1452+GPO-001++++++1'
vtmp:=UNA_link.ExtractElement(value, '+'); // = UNB
for i:=0 to length(fdescription)-1 do begin
tmpcount:=__getfields();
if tmpcount=fdescription[i].datacount then begin
for idata:=0 to tmpcount-1 do begin
fdata.Values[getsidfieldname(fdescription,i, idata)]:=v[idata];
end;
end else begin
for idata:=0 to fdescription[i].datacount-1 do begin
if idata<=tmpcount-1 then begin
fdata.Values[getsidfieldname(fdescription,i, idata)]:=v[idata];
end else begin
fdata.values[getsidfieldname(fdescription,i, idata)]:='';
end;
end;
{
raise
Exception.Create(fDataType+#13+
'expected count:'+inttostr(fdescription[i].datacount)+#13+
'found count:'+inttostr(tmpcount)+#13+
'data:'+vtmp);
}
end;
end;
end;
// Ende UN-Dataset
// *************************************************************************************************************************************
procedure tmxEDIFACT.Notification(AComponent:TComponent; Operation:TOperation);
begin
inherited Notification(aComponent, Operation);
if (operation=opRemove) then begin
//if (aComponent = ADSConnection) and (ADSConnection<>nil) then ADSConnection:=nil;
//if (aComponent = MxINI) and (MxINI<>nil) then MxINI:=nil;
end;
end;
constructor tmxEDIFACT.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
// Initialisierung der Parameter
funa:=tmxedi_una.Create;
fDataSegmentsFormat:=tstringlist.Create;
end;
destructor tmxEDIFACT.Destroy;
var i:integer;
begin
funa.free; funa:=nil;
fDataSegmentsFormat.Free;
for i:=0 to length(fDataSegments)-1 do begin
fDataSegments[i].Free;
end;
inherited Destroy;
end;
function tmxEDIFACT.get_DataOutput():string;
var
i:integer;
begin
result:='';
for i:=0 to length(fdatasegments)-1 do begin
result:=result+fdatasegments[i].DataValue;
end;
end;
procedure tmxEDIFACT.set_DataInput(value: tStrings);
var
vtmp:tstrings;
vtemp, vsegmentid:string;
si, i:integer;
vplus, vpunkt:string;
vSegment:tmxedi_segment;
begin
vtemp:=value.Text;
vtemp:=StringReplace(vtemp, #10, '', [rfReplaceAll, rfIgnoreCase]);
vtemp:=StringReplace(vtemp, #13, '', [rfReplaceAll, rfIgnoreCase]);
vtemp:=StringReplace(vtemp, fUNA.UNA_6_Segmentendezeichen, #13, [rfReplaceAll, rfIgnoreCase]);
vtmp:=tstringlist.create;
vtmp.text:=vtemp;
vplus:=fUNA.UNA_2_Datenelement_TZ;
vpunkt:=fUNA.UNA_1_Composite_Element;
for i:=0 to vtmp.Count-1 do begin
vtemp:=trim(vtmp[i]);
if vtemp<>'' then begin
vsegmentid:=copy(vtemp,1,pos(vplus,vtemp)-1);
for si:=0 to Length(fdatasegments)-1 do begin
if fdatasegments[si].fDataType=vsegmentid then begin
// was ist mit mehrfach vorkommenden segmenten ??
fdatasegments[si].DataValue:=vtemp;
break;
end;
end;
end;
end;
vtmp.free;
end;
procedure tmxEDIFACT.set_DataSegmentsFormat(Value: TStrings);
var
vtmp:tstrings;
vtemp:string;
i:integer;
vplus, vpunkt:string;
vSegment:tmxedi_segment;
begin
fDataSegmentsFormat.clear;
vtemp:=value.Text;
vtemp:=StringReplace(vtemp, #10, '', [rfReplaceAll, rfIgnoreCase]);
vtemp:=StringReplace(vtemp, #13, '', [rfReplaceAll, rfIgnoreCase]);
vtemp:=StringReplace(vtemp, '$SEGMENT$', #13, [rfReplaceAll, rfIgnoreCase]);
vtmp:=tstringlist.create;
vtmp.text:=vtemp;
vplus:=fUNA.UNA_2_Datenelement_TZ;
vpunkt:=fUNA.UNA_1_Composite_Element;
for i:=0 to vtmp.Count-1 do begin
vtemp:=trim(vtmp[i]);
if vtemp<>'' then begin
vSegment:=tmxedi_segment.Create(self);
vsegment.DataType:=copy(vtemp,1,pos(vplus,vtemp)-1);
vsegment.DataFormat:=vtemp+UNA.UNA_6_Segmentendezeichen;
//vSegment.DataValue:='UNB+UNOC:3+0001GPO+GPO+040130:1452+GPO-001++++++1'+'''';
setlength(fdatasegments, length(fdatasegments)+1);
fDataSegments[length(fDataSegments)-1]:=vSegment;
end;
end;
vtmp.free;
end;
// *******************************************************************************************************************************
procedure Register;
begin
RegisterComponents('MicrotronX', [tmxEDIFACT]);
end;
end.