jvqedidbbuffering.pas

East make Tray Icon in delphi

            ElementList.Values[Element.Id] :=
              IntToStr(StrToInt(ElementList.Values[Element.Id]) + 1);
            RecordExists := ElementExist(Segment.SegmentId, Element.Id);
            if not RecordExists then
              AddElement(Segment.SegmentId, Element.Id, Element.ElementType, Element.MaximumLength)
            else
              UpdateElement(Segment.SegmentId, Element.Id, Element.ElementType,
                Element.MaximumLength, StrToInt(ElementList.Values[Element.Id]));
          end;
          DoAfterProfiledSegment(Segment);
        end;
        DoAfterProfiledTransactionSet(TransactionSet);
      end;
    end;
  ElementList.Free;
end;

//=== { TJvEDIDBSEFProfiler } ================================================

procedure TJvEDIDBSEFProfiler.BuildProfile(EDISEFFile: TEDISEFFile);
var
  E, I, J: Integer;
  RecordExists: Boolean;
  ElementStrList: TStrings;
  Id: string;
  SEFSet: TEDISEFSet;
  SEFSegment: TEDISEFSegment;
  SEFElement: TEDISEFElement;
  SegmentList: TObjectList;
  ElementList: TObjectList;
begin
  if (FElementProfiles = nil) or (FSegmentProfiles = nil) or (FLoopProfiles = nil) then
    raise EJVCLException.CreateRes(@RsENoProfileDatasets);
  FElementProfiles.Filtered := False;
  FSegmentProfiles.Filtered := False;
  FLoopProfiles.Filtered := False;
  for I := 0 to EDISEFFile.SETS.Count - 1 do
  begin
    SEFSet := TEDISEFSet(EDISEFFile.SETS[I]);
    SegmentList := SEFSet.GetSegmentObjectList;
    try
      for J := 0 to SegmentList.Count - 1 do
      begin
        SEFSegment := TEDISEFSegment(SegmentList[J]);
        RecordExists := LoopExist(SEFSegment.OwnerLoopId, SEFSegment.ParentLoopId);
        if not RecordExists then
          AddLoop(SEFSegment.OwnerLoopId, SEFSegment.ParentLoopId);
        RecordExists := SegmentExist(SEFSegment.SegmentId, SEFSegment.OwnerLoopId,
          SEFSegment.ParentLoopId);
        if not RecordExists then
          AddSegment(SEFSegment.SegmentId, SEFSegment.OwnerLoopId, SEFSegment.ParentLoopId);
        ElementList := SEFSegment.GetElementObjectList;
        ElementStrList := TStringList.Create;
        try
          ElementStrList.Clear;
          for E := 0 to ElementList.Count - 1 do
          begin
            if ElementList[E] is TEDISEFElement then
            begin
              SEFElement := TEDISEFElement(ElementList[E]);
              Id := SEFSegment.Id + SEFElement.Id;
              if ElementStrList.Values[Id] = '' then
                ElementStrList.Values[Id] := '0';
              ElementStrList.Values[Id] :=
                IntToStr(StrToInt(ElementStrList.Values[Id]) + 1);
              RecordExists := ElementExist(SEFSegment.Id, SEFElement.Id);
              if not RecordExists then
                AddElement(SEFSegment.Id, SEFElement.Id, SEFElement.ElementType,
                  SEFElement.MaximumLength)
              else
                UpdateElement(SEFSegment.Id, SEFElement.Id, SEFElement.ElementType,
                  SEFElement.MaximumLength, StrToInt(ElementStrList.Values[Id]));
            end;
          end;
        finally
          ElementStrList.Free;
          ElementList.Free;
        end;
        DoAfterProfiledSegment(SEFSegment);
      end;
    finally
      SegmentList.Free;
    end;
    DoAfterProfiledTransactionSet(SEFSet);
  end;
end;

//=== { TJvEDIFieldDef } =====================================================

constructor TJvEDIFieldDef.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FUpdateStatus := usUnmodified;
end;

//=== { TJvEDIFieldDefs } ====================================================

function TJvEDIFieldDefs.Add: TJvEDIFieldDef;
begin
  Result := TJvEDIFieldDef(inherited Add);
end;

function TJvEDIFieldDefs.GetItem(Index: Integer): TJvEDIFieldDef;
begin
  Result := TJvEDIFieldDef(inherited GetItem(Index));
end;

procedure TJvEDIFieldDefs.SetItem(Index: Integer; Value: TJvEDIFieldDef);
begin
  inherited SetItem(Index, Value);
end;

procedure TJvEDIFieldDefs.Update(Item: TCollectionItem);
begin
  inherited Update(Item);
end;

//=== { TJvEDIDBBuffer } =====================================================

constructor TJvEDIDBBuffer.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FLoopKeyPrefix := Default_LoopKeyPrefix;
  FKeySuffix := Default_KeySuffix;
  FSegmentKeyPrefix := Default_SegmentKeyPrefix;
  FElementNonKeyPrefix := Default_ElementNonKeyPrefix;
end;

procedure TJvEDIDBBuffer.CloseProfileDataSets;
begin
  DoBeforeCloseDataSets;
  if FLoopProfiles.Active then
    FLoopProfiles.Close;
  if FLoopProfiles.Active then
    FElementProfiles.Close;
  if FLoopProfiles.Active then
    FSegmentProfiles.Close;
  DoAfterCloseDataSets;
end;

procedure TJvEDIDBBuffer.DoAfterOpenDataSets;
begin
  if Assigned(FOnAfterOpenDataSets) then
    FOnAfterOpenDataSets(Self);
end;

procedure TJvEDIDBBuffer.DoAlterTable(FieldDefs: TJvEDIFieldDefs; const TableName: string);
begin
  if Assigned(FOnAlterTable) then
    FOnAlterTable(FieldDefs, TableName);
end;

procedure TJvEDIDBBuffer.DoBeforeCloseDataSets;
begin
  if Assigned(FOnBeforeCloseDataSets) then
    FOnBeforeCloseDataSets(Self);
end;

procedure TJvEDIDBBuffer.DoAfterCloseDataSets;
begin
  if Assigned(FOnAfterCloseDataSets) then
    FOnAfterCloseDataSets(Self);
end;

procedure TJvEDIDBBuffer.DoBeforeOpenDataSets;
begin
  if Assigned(FOnBeforeOpenDataSets) then
    FOnBeforeOpenDataSets(Self);
end;

procedure TJvEDIDBBuffer.DoCheckForFieldChanges(FieldDefs: TJvEDIFieldDefs; const TableName: string);
begin
  if Assigned(FOnCheckForFieldChanges) then
    FOnCheckForFieldChanges(FieldDefs, TableName);
end;

procedure TJvEDIDBBuffer.DoCreateTable(FieldDefs: TJvEDIFieldDefs; const TableName: string);
begin
  if Assigned(FOnCreateTable) then
    FOnCreateTable(FieldDefs, TableName);
end;

procedure TJvEDIDBBuffer.DoTableExists(const TableName: string; var TableExists: Boolean);
begin
  if Assigned(FOnTableExists) then
    FOnTableExists(TableName, TableExists);
end;

procedure TJvEDIDBBuffer.CreateFieldDefs(FieldDefs: TJvEDIFieldDefs;
  const TableName, OwnerLoopId, ParentLoopId: string; DefaultUpdateStatus: TUpdateStatus);
var
  FieldDef: TJvEDIFieldDef;
  ApplyFilter: Boolean;
  I: Integer;
begin
  FieldDefs.Clear;
  //Primary Key
  FieldDef := FieldDefs.Add;
  FieldDef.FieldName := FSegmentKeyPrefix + TableName + FKeySuffix; // Primary Key
  FieldDef.FieldType := FieldType_PKey;
  FieldDef.DataType := ftInteger;
  FieldDef.MaximumLength := 1;
  FieldDef.UpdateStatus := DefaultUpdateStatus;
  //Foreign Key
  FieldDef := FieldDefs.Add;
  if (OwnerLoopId = NA_LoopId) or (OwnerLoopId = '') then
    FieldDef.FieldName := TransactionSetKeyName + FKeySuffix // Transaction Set Foreign Key
  else
    FieldDef.FieldName := FLoopKeyPrefix + OwnerLoopId + FKeySuffix; // Loop Foreign Key
  FieldDef.FieldType := FieldType_FKey;
  FieldDef.DataType := ftInteger;
  FieldDef.MaximumLength := 1;
  FieldDef.UpdateStatus := DefaultUpdateStatus;
  //Fields
  ApplyFilter := True;
  DoBeforeApplyElementFilter(FElementProfiles, TableName, ApplyFilter);
  if ApplyFilter then
  begin
    FElementProfiles.Filtered := False;
    FElementProfiles.Filter := Field_SegmentId + ' = ' + QuotedStr(TableName);
    FElementProfiles.Filtered := True;
  end;
  FElementProfiles.First;
  while not FElementProfiles.Eof do
  begin
    for I := 1 to FElementProfiles.FieldByName(Field_ElementCount).AsInteger do
    begin
      FieldDef := FieldDefs.Add;
      FieldDef.FieldName := FElementNonKeyPrefix +
        FElementProfiles.FieldByName(Field_ElementId).AsString + '_' + IntToStr(I);
      FieldDef.FieldType := FElementProfiles.FieldByName(Field_ElementType).AsString;
      if FieldDef.FieldType = '' then
        FieldDef.DataType := ftString
      else
      if FieldDef.FieldType[1] = EDIDataType_Numeric then
        FieldDef.DataType := ftInteger
      else
      if FieldDef.FieldType = EDIDataType_Decimal then
        FieldDef.DataType := ftFloat
      else
      if FieldDef.FieldType = EDIDataType_Identifier then
        FieldDef.DataType := ftString
      else
      if FieldDef.FieldType = EDIDataType_String then
        FieldDef.DataType := ftString
      else
      if FieldDef.FieldType = EDIDataType_Date then
        FieldDef.DataType := ftDate
      else
      if FieldDef.FieldType = EDIDataType_Time then
        FieldDef.DataType := ftTime
      else
      if FieldDef.FieldType = EDIDataType_Binary then
        FieldDef.DataType := ftBlob
      else
        FieldDef.DataType := ftString;
      FieldDef.MaximumLength := FElementProfiles.FieldByName(Field_MaximumLength).AsInteger;
      FieldDef.UpdateStatus := DefaultUpdateStatus;
      DoResolveFieldDefDataType(FieldDef);
    end;
    FElementProfiles.Next;
  end;
end;

procedure TJvEDIDBBuffer.OpenProfileDataSets;
begin
  DoBeforeOpenDataSets;
  FSegmentProfiles.Open;
  FElementProfiles.Open;
  FLoopProfiles.Open;
  DoAfterOpenDataSets;
end;

procedure TJvEDIDBBuffer.SyncProfilesWithBuffer;
var
  TableName, OwnerLoopId, ParentLoopId: string;
  FieldDefs: TJvEDIFieldDefs;
begin
  FieldDefs := TJvEDIFieldDefs.Create(TJvEDIFieldDef);
  OpenProfileDataSets;
  while not FLoopProfiles.Eof do
  begin
    OwnerLoopId := FLoopProfiles.FieldByName(Field_OwnerLoopId).AsString;
    TableName := FLoopKeyPrefix + OwnerLoopId;
    ParentLoopId := FLoopProfiles.FieldByName(Field_ParentLoopId).AsString;
    if (OwnerLoopId <> NA_LoopId) and (not TableExists(TableName)) then
    begin
      CreateLoopFieldDefs(FieldDefs, TableName, ParentLoopId, usInserted);
      DoCreateTable(FieldDefs, TableName);
    end
    else
    if OwnerLoopId <> NA_LoopId then
    begin
      CreateLoopFieldDefs(FieldDefs, TableName, ParentLoopId, usUnmodified);
      DoCheckForFieldChanges(FieldDefs, TableName);
      DoAlterTable(FieldDefs, TableName);
    end;
    FLoopProfiles.Next;
  end;
  while not FSegmentProfiles.Eof do
  begin
    TableName := FSegmentProfiles.FieldByName(Field_SegmentId).AsString;
    OwnerLoopId := FSegmentProfiles.FieldByName(Field_OwnerLoopId).AsString;
    ParentLoopId := FSegmentProfiles.FieldByName(Field_ParentLoopId).AsString;
    if not TableExists(TableName) then
    begin
      CreateFieldDefs(FieldDefs, TableName, OwnerLoopId, ParentLoopId, usInserted);
      DoCreateTable(FieldDefs, TableName);
    end
    else
    begin
      CreateFieldDefs(FieldDefs, TableName, OwnerLoopId, ParentLoopId, usUnmodified);
      DoCheckForFieldChanges(FieldDefs, TableName);
      DoAlterTable(FieldDefs, TableName);
    end;
    FSegmentProfiles.Next;
  end;
  CloseProfileDataSets;
  FieldDefs.Free;
end;

function TJvEDIDBBuffer.TableExists(const TableName: string): Boolean;
begin
  Result := False;
  DoTableExists(TableName, Result);
end;

procedure TJvEDIDBBuffer.DoResolveFieldDefDataType(FieldDef: TJvEDIFieldDef);
begin
  if Assigned(FOnResolveFieldDefDataType) then
    FOnResolveFieldDefDataType(FieldDef);
end;

procedure TJvEDIDBBuffer.CreateLoopFieldDefs(FieldDefs: TJvEDIFieldDefs;
  const TableName, ParentLoopId: string; DefaultUpdateStatus: TUpdateStatus);
var
  FieldDef: TJvEDIFieldDef;
begin
  FieldDefs.Clear;
  if TableName = NA_LoopId then
    Exit;
  //Primary Key
  FieldDef := FieldDefs.Add;
  FieldDef.FieldName := TableName + FKeySuffix; // Primary Key
  FieldDef.FieldType := FieldType_PKey;
  FieldDef.DataType := ftInteger;
  FieldDef.MaximumLength := 1;
  FieldDef.UpdateStatus := DefaultUpdateStatus;
  //Foriegn Key
  FieldDef := FieldDefs.Add;
  if (ParentLoopId = NA_LoopId) or (ParentLoopId = '') then
    FieldDef.FieldName := TransactionSetKeyName + FKeySuffix // Transaction Set Foreign Key
  else
    FieldDef.FieldName := FLoopKeyPrefix + ParentLoopId + FKeySuffix; // Foreign Key
  FieldDef.FieldType := FieldType_FKey;
  FieldDef.DataType := ftInteger;
  FieldDef.MaximumLength := 1;
  FieldDef.UpdateStatus := DefaultUpdateStatus;
end;

procedure TJvEDIDBBuffer.DoBeforeApplyElementFilter(DataSet: TDataSet; const Table: string;
  var ApplyFilter: Boolean);
begin
  if Assigned(FOnBeforeApplyElementFilter) then
    FOnBeforeApplyElementFilter(DataSet, Table, ApplyFilter);
end;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvQEDIDBBuffering.pas,v $';
    Revision: '$Revision: 1.15 $';
    Date: '$Date: 2004/11/06 22:08:16 $';
    LogPath: 'JVCL\run'
  );

initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.