(************************************************************************
*    This File is Part of the AHM Triton Tools                          *
*    for Borland Delphi and C++ Builder.                                *
*************************************************************************
* Copyright © 1995-1999 Alexander H. Mehlhorn (AHM) and Tritontools.com *
* All Rights reserved.                                                  *
*                                                                       *
*    For more Information contact us at                                 *
*    E-Mail : support@tritontools.com                                   *
*    URL : http://www.tritontools.com                                   *
*                                                                       *
*    AHM is copyright by Alexander H. Mehlhorn                          *
*    All Parts of this Collection were developed,                       *
*    designed and implemented by AHM                                    *
*                                                                       *
*    Under no Circumstances may you distribute this file                *
*    in this or any other format. This File is supplied                 *
*    as Evaluation of Source only. No Delphi Components may be developed*
*    using extracts or subsets of this code without expressed permission*
*    by AHM.                                                            *
*                                                                       *
*************************************************************************)
unit AHMTDBAscii;
{$I AHM.INC}
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons,DB,DBCtrls,AHMStdClass,AHMStandardConst
  {$IFNDEF AHMINPRISE3},DBTables{$ENDIF};
type
  TAHMDBAscii = class;
  TAHMADFields = class;
  TAHMImportExportEvent = procedure(Sender: TObject;RecordText : String) of object;
  TAHMADField = class(TCollectionItem)
  private
    FHeader : string;
    fdbascii : TAHMDBAscii;
    FFieldDataLink : TFieldDataLink;
    FDataField : String;
    procedure SetDataField(Value: String);
  protected
    function GetDisplayName: string; override;
  public
    constructor Create(Collection: TCollection); override;
    property Owner : TAHMDBAscii read fdbascii;
  published
    property DataField: String read FDataField write SetDataField stored True;
    Property Header : String read FHeader write FHeader;
  end;
  TAHMADFields = class(TCollection)
  private
    FAHMDBAscii: TAHMDBAscii;
    function GetItem(Index: Integer): TAHMADField;
    procedure SetItem(Index: Integer; Value: TAHMADField);
  protected
    function GetOwner: TPersistent; override;
  public
    constructor Create(AHMDBAscii: TAHMDBAscii);
    function Add: TAHMADField;
    procedure Delete(Index : Integer);
    property Items[Index: Integer]: TAHMADField read GetItem write SetItem; default;
  end;
  TAHMDBAscii = class(TComponent)
  private
    FAboutStr : TAHMAboutSControlStr;
    FFilename : String;
    FFixedWidth : Boolean;
    FFieldDataLink : TFieldDataLink;
    FDelimiter : char;
    FPrintHeader : Boolean;
    FAHMADFields : TAHMADFields;
    FOnExportDone : TNotifyevent;
    FOnImportSuccess : TAHMImportExportEvent;
    FImportBeforePost : TAHMImportExportEvent;
    FOnImportException : TAHMImportExportEvent;
    FExportBeforeWrite : TAHMImportExportEvent;
    FImportBeforeInsert : TAHMImportExportEvent;
    procedure SetAHMADFields(Value: TAHMADFields);
    function GetDataSource : TDataSource;
    procedure SetDataSource(Value : TDataSource);
  protected
    procedure Notification(AComponent: TComponent;Operation: TOperation); override;
    Function SetFixed(xOriginalString : String;xLength : Integer) : String;
  public
    property DataLink : TFieldDataLink read FFieldDataLink;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function InsertAllFields : Boolean;
    procedure DoExport;
    procedure DoImport;
    procedure Loaded; override;
  published
    property About : TAHMAboutSControlStr read FAboutStr write FAboutStr;
    property Fields: TAHMADFields read FAHMADFields write SetAHMADFields;
    property Delimiter : Char read FDelimiter write FDelimiter;
    property Filename : String read FFilename write FFilename;
    property FixedWidth : Boolean read FFixedWidth write FFixedWidth default false;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property PrintHeader : Boolean read FPrintHeader write FPrintHeader default false;
    property ImportBeforePost   : TAHMImportExportEvent read FImportBeforePost write FImportBeforePost;
    property ImportBeforeInsert : TAHMImportExportEvent read FImportBeforeInsert write FImportBeforeInsert;
    property OnImportException  : TAHMImportExportEvent read FOnImportException write FOnImportException;
    property OnImportSuccess    : TAHMImportExportEvent read FOnImportSuccess write FOnImportSuccess;
    property ExportBeforeWrite  : TAHMImportExportEvent read FExportBeforeWrite write FExportBeforeWrite;
    property OnExportDone : TNotifyEvent read FOnExportDone write FOnExportDone;
  end;


implementation

constructor TAHMADField.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FFieldDataLink  :=(((Collection as TAHMADFields).GetOwner) as TAHMDBAscii).Datalink;
  fdbascii :=(((Collection as TAHMADFields).GetOwner) as TAHMDBAscii);
end;

function TAHMADField.GetDisplayName: string;
begin
  Result := FDataField;
  {$IFDEF AHMINPRISE3}
  if Result = '' then Result := inherited GetDisplayName;
  {$ELSE}
  if Result = '' then Result := ahmrcstdTAHMADField;
  {$ENDIF}
end;

procedure TAHMADField.SetDataField(Value : String);
begin
  FDataField := Value;
end;

constructor TAHMADFields.Create(AHMDBAscii: TAHMDBAscii);
begin
  inherited Create(TAHMADField);
  FAHMDBAscii := AHMDBAscii;
end;

function TAHMADFields.Add: TAHMADField;
begin
  Result := TAHMADField(inherited Add);
end;

procedure TAHMADFields.Delete(Index : Integer);
begin
  Items[Index].Free;
end;

function TAHMADFields.GetItem(Index: Integer): TAHMADField;
begin
  Result := TAHMADField(inherited GetItem(Index));
end;

procedure TAHMADFields.SetItem(Index: Integer; Value: TAHMADField);
begin
  inherited SetItem(Index, Value);
end;

function TAHMADFields.GetOwner: TPersistent;
begin
  Result := FAHMDBAscii;
end;

function TAHMDBAscii.GetDataSource: TDataSource;
begin
  result := FFieldDataLink.DataSource;
end;

procedure TAHMDBAscii.SetDataSource(Value : TDataSource);
begin
  FFieldDataLink.DataSource := Value;
{?} if Value <> nil then Value.FreeNotification(Self);
end;

constructor TAHMDBAscii.Create( AOwner: TComponent );
begin
  FFixedWidth:=False;
  FPrintHeader:=False;
  inherited create(AOwner);
  FFieldDataLink := TFieldDataLink.Create;
  FAHMADFields:=TAHMADfields.create(Self);
end;

procedure TAHMDBAscii.Loaded;
begin
  inherited Loaded;
end;

destructor TAHMDBAscii.Destroy;
begin
  FAHMADFields.free;
  FFieldDataLink.free;
  inherited Destroy;
end;

procedure TAHMDBAscii.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (FFieldDataLink <> nil)
     and (AComponent = DataSource) then SetDataSource(nil);
end;

procedure TAHMDBAscii.SetAHMADFields(Value: TAHMADFields);
begin
  FAHMADFields.Assign(Value);
end;

Function TAHMDBAscii.SetFixed(xOriginalString : String;xLength : Integer) : String;
begin
  If FFixedWidth then
  while Length(xOriginalString)<xLength do xOriginalString:=xoriginalString+' ';
  result:=xOriginalString;
end;

procedure TAHMDBAscii.DoExport;
var vTextFile : Textfile;
    isopen : Boolean;
    fs : string;
    il : integer;
begin
  if assigned(DataSource) and assigned(Datasource.DataSet) then
  try
    isopen:=DataSource.DataSet.active;
    DataSource.DataSet.open;
    DataSource.DataSet.first;
    assignfile(vTextFile,FFilename);
    rewrite(vTextFile);
    if FPrintHeader then
    begin
      for il:=0 to FAHMADFields.count-1 do
      if il<FAHMADFields.count-1 then
        fs:=concat(fs,'[',FAHMADFields[il].Header,']',FDelimiter)
      else
        fs:=concat(fs,'[',FAHMADFields[il].Header,']');
      writeln(vTextFile,fs);
    end;
    while not(DataSource.DataSet.eof) do
    begin
      fs:='';
      for il:=0 to FAHMADFields.count-1 do
      begin
        fs:=concat(fs,SetFixed(DataSource.DataSet.fieldbyname(FAHMADFields[il].Datafield).asstring,
         Datasource.DataSet.FieldbyName(FAHMADFields[il].DataField).Size));
        if il<FAHMADFields.count-1 then fs:=concat(fs,FDelimiter);
      end;
      if assigned(FExportBeforeWrite) then FExportBeforeWrite(Self,fs);
      writeln(vTextFile,fs);
      DataSource.DataSet.next;
    end;
    closefile(vTextFile);
    if not(isopen) then DataSource.DataSet.close;
  except
    raise;
  end;
  if assigned(FOnExportDone) then FOnExportDone(Self);
end;

Function TAHMDBAscii.InsertAllFields : Boolean;
Var I : Integer;
    vAHMAdField : TAHMADField;
begin
  result:=false;
  if assigned(DataSource) and assigned(Datasource.DataSet) then
  begin
    while FAHMADFields.Count>0 do FAHMADFields.Delete(FAHMADFields.Count-1);
    if Datasource.DataSet.Active then
    begin
      For I:=0 to DataSource.DataSet.FieldCount-1 do
      begin
        vAHMADField:=FAHMADFields.Add;
        vAHMADField.DataField:=DataSource.DataSet.Fields[I].FieldName;
        vAHMADField.Header:=DataSource.DataSet.Fields[I].FieldName;
      end;
      result:=true;
    end;
  end;
end;

procedure TAHMDBAscii.DoImport;
var vTextFile : Textfile;
    fact : Boolean;
    fs : string;
    FRecordText : string;
    il : integer;
begin
  if assigned(DataSource) and assigned(Datasource.DataSet) then
  try
    fact:=DataSource.DataSet.active;
    DataSource.DataSet.open;
    assignfile(vTextFile,FFilename);
    reset(vTextFile);
    if FPrintHeader then Readln(vTextFile,fs);
    while not eof(vTextFile) do
    begin
      readln(vTextFile,fs);
      FRecordText:=fs;
      if fs<>'' then
      begin
        if assigned(FImportBeforeInsert) then FImportBeforeInsert(Self,FRecordText);
        DataSource.DataSet.insert;
        for il:=0 to FAHMADFields.count-1 do
        begin
          if il<FAHMADFields.count-1 then
             DataSource.DataSet.fieldbyname(FAHMADFields.items[il].Datafield).asstring:=copy(fs,1,pos(FDelimiter,fs)-1)
          else DataSource.DataSet.fieldbyname(FAHMADFields.items[il].Datafield).asstring:=fs;
          delete(fs,1,pos(FDelimiter,fs));
        end;
        if assigned(FImportBeforePost) then FExportBeforeWrite(Self,FRecordText);
        try
          DataSource.DataSet.post;
        except
          begin
            if assigned(FOnImportException) then FOnImportException(Self,FRecordText);
            DataSource.DataSet.cancel;
          end;
        end;
        if assigned(FOnImportSuccess) then FOnImportSuccess(Self,FRecordText);
      end;
    end;
    closefile(vTextFile);
    if not(fact) then DataSource.DataSet.close;
  except
    raise
  end;
end;

end.
