Chip 2001 December/Chip_2001-12_cd1.bin/zkuste/delphi/kompon/d3456/ACF10CE.ZIP/NyBck.pas

Pascal/Delphi Source File | 2001-09-10 | 20.9 KB | 680 lines

//TNyBck compenent V 1.3  10.9.2001
//Nihat Yorganc² [e-mail]
// Please send me notes, bugs and problems


//export and import whole database to the text files and binary files.
// Memo and BLOB fields are also supported. TnyBck is saved Total record count in Text file when Export.
//so you can use this count as Gauge Max Value.Please examine to Demo.
//You don't have to export calculated field or lookupfields with Tnybck.

//if you have calculated fields or lookupfields in dataset you must not be
// export this fields. See Csvmap properties.

// You can use this component for free in commercial or non-commercial programs
// Please send me the changes you made in source code, and do not forgret my credit!
// Read Readme.txt file included with the package for help and credits.

//This compenent TPgCSV (Khashayar Sadjadi ([e-mail])) And KDatabase Export pack([e-mail]) Combined.


//Installation:

// Remove Nybck component previous version.Click Component menu. Select Install Component.
//Select Nybck.pas in Unit File Name with Browse.
//Select Package file name exist your computer(*.dpk).
//or Select into new package, write a new filename in Package file name.Press ok.
//Appear package box and press install. After Save *.dpk file.



//Usage
// 1. Place the component of your Form or DataModule.
// 2. Set the proprties (See properties section in this readme)
// 3. Close dataset
// 4. Call Imprt or Exprt methods.
// 5. Open Dataset

//Properties:

//CSVMap : Mapping of BCK file(text file) and table fields. A List of field names, started bt value of
//      FieldIndicator value and seprated by Seprator value.
//           Ex: $Name,$Age,$BirthDate
//           if you writed CSVMap and Export all records, please don't change
//           CSVMap string while import all records to dataset. Othervise raised errors.
//           only exported and imported fields in CsvMap string. So you don't have to Export
//calculated and lookup fields.


// Dataset :Tdataset. TDataset in Delphi forms or DataModules to link with TNyBck for Import and Export.

//Delimiter: Char. Seprator character.specifies the delimiter that will separate field values in
// the text files.Default '"' .

//FieldIndicator  : Special character for identifing field names in CSVMap.

//Seprator    : Seprator character. Offten ,

//SilentImport    :boolean. Setting this property to True forces TNyBck to do not raise exceptions and call ImportError event


//TextFile :String. A Text file. Each record in a seperate line, seperated by CR.
//          if your have blob or memo field TnyBck create a binary file (*.mem).
//example: textfile:= 'myfile.Bck', TnyBck also create myfile.mem.


//TotalRecord :integer.Read only. Get Totol record  in BeforeExport and Before▌mport events.You get Total Record only this two events.
              // You can use Totol Record your gauge max value.
//Events:

//AfterCloseTable  : Fires after TNyBck closed dataset.

//AfterExport      : Fires after export process of a dataset to a Text Files( and *.Mem files) finishes.

//AfterImport     : Fires after import process of a Text files (and *.mem) to dataset finishes.

//AfterOpenTable   : Fires after TNyBck opens the dataset.

//BeforeCloseTable : Fires before TNyBck closes the database.

//BeforeExport     : Fires before export process starts from a Dataset to a Text files.

//BeforeImport     : Fires before import process starts from a Text files to a Dataset.

//BeforeOpenTable  : Fires before TNyBck opens dataset.

//ImportError     : Firest each time an exception occures in Importing a Text to a dataset.
//           You can force TNyBck to handle ignore error or abort the process.
//           This event will be fired only if Silent²mport property is setted to True.

//ExportProgress     : Fires each time a new record added to a Text files during exportin a dataset to a textFiles.
//           You can Stop export progress by setting StopIt parameter to True.

//ImportProgress     : Fires each time a new record added to a dataset during importing a text fileto a dataset.
//           You can Stop import progress by setting StopIt parameter to True.

//OnAddRecord     : Fires each time a new record added to dataset during importing a Text to a dataset.
//Exception handling:

//By setting SilentImport property to True, if an exception occure in Import method, TNyBck will
//not raise exception and will call ImportError event with exception message and record number.
//You can set the Response parameter to nybckIgnore or nybckAbort to make TnyBck handle the exception.
//Setting Response to nybckIgnore will make TNyBck ignore current record and it will continue Importing, but
//nybckAbort will terminate import process at the currect record.
//Default value of Response parameter is nybckIgnore.

//Progress monitoring:

//By writing event handlers for ExportProgress and ImportProgress events, you can monitor Import and/or
//Export progress during the process. You can also stop process by setting StopIt parameter to True within
//event handler.

//Total Record: Readonly.Total record write in text file first line(Export method).
//              Total Record Reading in text file first line(Import mehthod).
//You can get Total record in BeforeExport and BeforeImport events.

//AutoMapping feature:
//----------------------------------------------
//If you leave the CSVMap property blank, TPgCSV will use all Dataset
// fields to generate *.Bck file in Exprt and ▌mprt method.


//History:

///ver 1.3. (10.9.2001)
//a major bug solved in imprt method.

//ver 1.2. (8.9.2001)
//Export Method change Exprt, ▌mport Method change imprt.
//CsvMap, fieldindicator and Seprator properties added.

//ver 1.1   (26.1.2001)
//Some bugs solved.

unit NyBck;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Db;
  type
  TNyError = class(Exception)  //Pgcsv hav'not.
  end;


type

   TNyBckErrorResponse     = (nybckAbort, nybckIgnore);

  TNyBckProgressEvent     = procedure (Sender : TObject; AProgress: LongInt; var StopIt: Boolean) of object;
  TNyBckImportErrorEvent  = procedure (Sender : TObject; Mess: string; RecNo: LongInt; var Response:TNyBckErrorResponse) of object;


  TNyBck = class(TComponent)
  private
    { Private declarations }
    FDataset         : TDataset;
     FTextFile       :string;
      FCSVMap        :string;
     FDelimiter      :char;
     FSilentImport   :Boolean;
     Fstop           :Boolean;
     Ftotal          :longint;//totalrec.
     FSeprator,FFieldIndicator  : Char;
      FMapItems:integer;

     FBeforeOpenTable,
   FAfterOpenTable,
   FBeforeCloseTable,
   FAfterCloseTable,

   FBeforeExport,
   FAfterExport,
   FBeforeImport,
   FAfterImport,
   FOnAddRecord     : TNotifyEvent;
   FExportProgress,
   FImportProgress  : TNyBckprogressEvent;
   FImportError     : TNyBckImportErrorEvent;
    FFieldCache      : TList;
  protected
    { Protected declarations }


     procedure ClearFileExt(var FileName : string);
     procedure ChangeFileExtt(var FileName : string; const NewExt :string);
    // function FixPath(const Path : string) : string;
     function DelimitedText(Strings : TStrings; Delimiter, Quote : char) : string;
     function QuotedString(const S : string; Quote : char) : string;
     //Yedekal ba■l²yor.

     procedure ComposeText(const S : string; Delimiter, Quote : char; Strings : TStrings);
     function UnquotedString(const S : string; Quote : char) : string;
     function CountMapItems:Integer;
     function WordCount(const S ,WordDelim: string): Integer;
     function GetMapItem(ItemIndex:Integer;var AField:Boolean):string;
     function ExtractWord(Item: Integer;S, WordDelim: string): string;
     function WordPosition(Item: Integer; const S, SubStr: string): Integer;
     function BuildMap:string;//Csvmap bo■sa tⁿm alanlar² dahil et.
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy;override;
  published
    { Published declarations }
     //properties
   Property TotalRecord      :longint                 read Ftotal;
   property Dataset          : TDataset               read FDataset          write FDataset;
   property TextFile          : string                 read FTextFile          write FTextFile;
   property Delimiter        : Char                   read FDelimiter        write FDelimiter;
   property SilentImport     : Boolean                read FSilentImport     write FSilentImport;
   property FieldIndicator   : Char                   read FFieldIndicator   write FFieldIndicator;
   property Seprator         : Char                   read FSeprator         write FSeprator;
   property CSVMap           : string                 read FCSVMap           write FCSVMap;

    //events
   property BeforeOpenTable  : TNotifyEvent           read FBeforeOpenTable  write FBeforeOpenTable;
   property AfterOpenTable   : TNotifyEvent           read FAfterOpenTable   write FAfterOpenTable;
   property BeforeCloseTable : TNotifyEvent           read FBeforeCloseTable write FBeforeCloseTable;
   property AfterCloseTable  : TNotifyEvent           read FAfterCloseTable  write FAfterCloseTable;

   property BeforeImport     : TNotifyEvent           read FBeforeImport     write FBeforeImport;
   property AfterImport      : TNotifyEvent           read FAfterImport      write FAfterImport;
   property BeforeExport     : TNotifyEvent           read FBeforeExport     write FBeforeExport;
   property AfterExport      : TNotifyEvent           read FAfterExport      write FAfterExport;
   property ExportProgress   : TNyBckProgressEvent    read FExportProgress   write FExportProgress;
   property ImportProgress   : TNyBckProgressEvent    read FImportProgress   write FImportProgress;
   property OnAddRecord      : TNotifyEvent           read FOnAddRecord      write FOnAddRecord;
   property ImportError      : TNyBckImportErrorEvent read FImportError      write FImportError;
   //methodes
   procedure Exprt;//DatasetToText;
   procedure Imprt;//TextToDataset;

  end;

procedure Register;

implementation
procedure Tnybck.Exprt;//DatasetToText
var
D : string;
B : Boolean;
i : integer;
C : LongInt;//progresin say²s²n² tutar.

  slOut, slRow : TStrings;
  MS1, MS2 : TMemoryStream;

begin
 if FTextFile='' then
      raise TNyError.Create('NyBck Error: Please write backup Text file name.');

     if FDataSet = nil then
    raise TNyError.Create('NyBck Error : Dataset is not specified');

      if Assigned(FBeforeOpenTable) then
    FBeforeOpenTable(Self);

     Fdataset.open;
    if Assigned(FAfterOpenTable) then
    FAfterOpenTable(Self);


    try  //transfer start


      slOut := TStringList.Create;
  slRow := TStringList.Create;
  MS1 := TMemoryStream.Create;
  MS2 := TMemoryStream.Create;

  //create field cache
 FFieldCache:=TList.Create;

  FMapItems:=0;
 // filename:=dosyaadi;
  try

  C:=0;//▌lerleme miktar²
    FDataSet.First;
    if Trim(FCSVMap) = '' then
  FCSVMap:=BuildMap;

    FDataset.DisableControls;//ekran kompenentleri pasif
     slRow.Clear;
      Ftotal:=Fdataset.RecordCount;
       slRow.Add(inttostr(Ftotal)); //toplam rekordu kaydet
        slOut.Add(DelimitedText(slRow, Fseprator,FDelimiter));// '"'));
     if Assigned(FBeforeExport) then
  FBeforeExport(Self);
    while (not FDataset.Eof) and (not FStop) do//not FDataSet.EOF do
    begin
      slRow.Clear;
      for  i:=1 to CountMapItems do//i := 0 to FDataSet.FieldCount - 1 do
      begin
       D:=GetMapItem(i,B);
       if B=false then //wrong field defination.
        raise TNyError.Create('NyBck Error : '+D+' is not a Field Defination for CSVmap Strings.Fieldindicator is wrong.');


       if not (FDataSet.FieldByName(D).DataType in [ftBlob, ftMemo, ftGraphic, ftFmtMemo,
                                              ftParadoxOle, ftDBaseOle, ftTypedBinary]) then


         slRow.Add(FDataSet.FieldByName(D).AsString)
        else begin
          MS2.Clear;
          (FDataSet.FieldByName(D) as TBlobField).SaveToStream(MS2);
          MS1.CopyFrom(MS2,0);
          slRow.Add(IntToStr(MS2.Size));
        end;
      end;
      slOut.Add(DelimitedText(slRow,Fseprator,FDelimiter));// '"'));

      FDataSet.Next;
      if Assigned(FExportProgress) then
    FExportProgress(Self, C, FStop);
       Inc(C);//ilerleme miktar².
    end; //ⁿsttej■ while not fdatasete gidiyor.
     if ExtractFileExt(FtextFile) = '' then FtextFile := FtextFile + '.txt';
    slOut.SaveToFile(FtextFile);

 if MS1.Size > 0 then
    begin
      ChangeFileExtt(FTextFile, 'mem');
      MS1.SaveToFile(FtextFile);
    end;
  finally
    slRow.Free;
    slOut.Free;
    MS2.Free;
    MS1.Free;
    FFieldCache.Free;
    FDataset.EnableControls;
     if Assigned(FAfterExport) then
  FAfterExport(Self);
   end;
   finally
     if Assigned(FBeforeCloseTable) then
    FBeforeCloseTable(Self);
      Fdataset.Close;
      if Assigned(FAfterCloseTable) then
    FAfterCloseTable(Self);
    end;


end;

procedure TNyBck.imprt;//TextToDataset;
var                  //CsvToDataset
  i,j : integer;
  D : string;
  B:boolean;
  slIn, slValues : TStrings;
  MS1, MS2 : TMemoryStream;
  sz : integer;

  memdosya:string;
   ErrorResponse : TNyBckErrorResponse ;
   C : LongInt;//progresin say²s²n² tutar.
   //CoNoexp:longint;//Key violation hatas² nedeniyle kayda girmeyen kay²tlar.
begin //g

  if FTextFile='' then
      raise TNyError.Create('NyBck Error: Please write backup Text file name.');


   if FDataSet = nil then
    raise TNyError.Create('NyBck Error : Dataset is not specified');

  slIn := TStringList.Create;
  slValues := TStringList.Create;
  MS1 := TMemoryStream.Create;
  MS2 := TMemoryStream.Create;
   //create field cache
 FFieldCache:=TList.Create;
 //initiate map items
 FMapItems:=0;

      try //e
      if Assigned(FBeforeOpenTable) then
    FBeforeOpenTable(Self);

     Fdataset.Open;
     if Assigned(FAfterOpenTable) then
    FAfterOpenTable(Self);
    MS1.Position := 0;
     FDataset.DisableControls;//ekran kompenentleri pasif
     C:=0;//▌lerleme miktar²

    Memdosya:=FTextFile;
    ClearFileExt(memdosya);
    slIn.LoadFromFile(FTextFile);
    if FileExists(MemDosya + '.mem') then
      MS1.LoadFromFile(MemDosya + '.mem');

    ComposeText(slIn[0],FSeprator, FDelimiter, slValues);//kay²t toplam²n² al.
      Ftotal:=strtoint(slValues[0]);//toplam kayd² integer olarak al.
    //memolar² ilk Ms1 e yⁿkle.
         //export to table from text file
 if Assigned(FBeforeImport) then
  FBeforeImport(Self);
    if Trim(FCSVMap) = '' then
  FCSVMap:=BuildMap;

    for i := 1 to slIn.Count - 1 do //0 to idi ama ilk kay²t toplam kay²t adedi oldu≡undan.
    begin  //d

    if FStop=true then break;
           try//h
      Fdataset.Append;
      ComposeText(slIn[i], FSeprator,FDelimiter, slValues);
      for j := 0 to slValues.Count - 1 do
      begin //c
      d:=getmapitem(j+1,B);
      if B=false then //wrong field defination.
        raise TNyError.Create('NyBck Error : '+D+' is not a Field Defination for CSVmap Strings.Fieldindicator is wrong.');


        if not (Fdataset.Fieldbyname(D).DataType in [ftBlob, ftMemo, ftGraphic, ftFmtMemo,
                                              ftParadoxOle, ftDBaseOle, ftTypedBinary]) then
          Fdataset.Fieldbyname(D).AsString := slValues[j]
        else begin//b
          sz := StrToInt(slValues[j]);
          if sz > 0 then
          begin //a
            MS2.CopyFrom(MS1,sz);
            MS2.Position := 0;
            (Fdataset.Fieldbyname(D) as TBlobField).LoadFromStream(MS2);
            MS2.Clear;
          end; //a
        end;//b
      end; //c
      Fdataset.Post;
      except
      on E:Exception do
     if not FSilentImport then
      raise
     else
     if Assigned(FImportError) then
       begin
        FImportError(Self,E.Message,C,ErrorResponse);
        if ErrorResponse = NyBckAbort then
         Break;
       end;

      end;//h
      if Assigned(FOnAddRecord) then
    FOnAddRecord(Self);
   if Assigned(FImportProgress) then
    FImportProgress(Self, C, FStop);
   Inc(C);
     end;//d
      //Inc(Coexp);//ilerleme miktar².//key violation hatas² olsa bile buraya u≡ruyor.


    FDataset.EnableControls;//ekran kompenentleri aktif.dikkat alttaki fdataset.active=false'den ÷nce gelmeli yoksa hata veriyor.
    if Assigned(FAfterImport) then
  FAfterImport(Self);

    Fdataset.close;

      if Assigned(FAfterCloseTable) then
    FAfterCloseTable(Self);

  finally
    MS1.Free;
    MS2.Free;
    slValues.Free;
    slIn.Free;
    FFieldCache.Free;
  end;//e

end; //g



procedure TNyBck.ComposeText(const S : string; Delimiter, Quote : char; Strings : TStrings);
var
  i, prev : integer;
  b : boolean;
begin
  prev := 0;
  b := false;
  Strings.Clear;
  for i := 1 to Length(S) do
  begin
    if S[i] = Quote then b := not b;
    if not b and (S[i] = Delimiter) then
    begin
     Strings.Add(UnquotedString(Trim(Copy(S, prev + 1, i - prev - 1)), Quote));
      prev := i;

    end;
  end;
 Strings.Add(UnquotedString(Trim(Copy(S, prev + 1, Length(S))), Quote));
end;

//return unquoted string
function TNyBck.UnquotedString(const S : string; Quote : char) : string;
var
  i : integer;
begin
  if (S = '') or (S[1] <> Quote) then
  begin
    Result := S;
    exit;
  end;
  Result := ''; i := 2;
  while i < Length(S) do
  begin
    if S[i] = Quote then
    begin
      if S[i + 1] = Quote then
      begin
        Result := Result + Quote;
        inc(i, 2);
        continue;
      end;
    end;
    Result := Result + S[i];
    inc(i);
  end;
end;



procedure TNyBck.ClearFileExt(var FileName : string);
var
  p : integer;
begin
  p := Length(FileName);
  while (p > 0) and (FileName[p] <> '.') do dec(p);
  if p = 0 then exit;
  Delete(FileName, p, Length(FileName));

end;

procedure TNyBck.ChangeFileExtt(var FileName : string; const NewExt :string);
begin
  ClearFileExt(FileName);
  FileName := FileName + '.' + NewExt;
end;


function TNyBck.DelimitedText(Strings : TStrings; Delimiter, Quote : char) : string;
var
  i : integer;
begin
  Result := '';
  for i := 0 to Strings.Count - 1 do
  begin
    if i <> 0 then Result := Result + Delimiter;
    Result := Result + QuotedString(Strings[i], Quote);
  end;
end;
function TNyBck.QuotedString(const S : string; Quote : char) : string;
var
  i : integer;
begin
  Result := Quote;
  for i := 1 to Length(S) do
  begin
    Result := Result + S[i];
    if S[i] = Quote then
      Result := Result + Quote;
  end;
  Result := Result + Quote;
end;


function TNyBck.CountMapItems:Integer;
begin
 if FMapItems = 0 then
  FMapItems:=WordCount(FCSVMap,FSeprator);
 Result:=FMapItems;
end;
function TNYBck.WordCount(const S ,WordDelim: string): Integer;
var
 i,
 Count :Integer;
begin
 Count:=0;
 for i:=1 to Length(S) do
  if Copy(S,i,Length(WordDelim)) = WordDelim then
   Inc(Count);
 Result:=Count + 1;
end;
function TNYBck.GetMapItem(ItemIndex:Integer;var AField:Boolean):string;
var
 S : string;
 P : ^ShortString;
begin
 if FFieldCache.Count < ItemIndex then
  begin
   S:=ExtractWord(ItemIndex,FCSVMap,FSeprator);
   New(P);
   P^:=S;
   FFieldCache.Add(P);
  end
 else
  S:=ShortString(FFieldCache.Items[ItemIndex - 1]^);
 AField:=True;
 if (Length(S) >= 1) and (S[1] = FFieldIndicator) then
  Result:=Copy(S,2,Length(S) - 1)
 else
  begin
   AField:=False;
   Result:=S;
  end;
end;

function TNYBck.ExtractWord(Item: Integer;S, WordDelim: string): string;
var
 First,
 Second:Integer;
begin
 First:=WordPosition(Item - 1,S,WordDelim);
 Second:=WordPosition(Item,S,WordDelim);
 if Second = 0 then
  Second:=Length(S) + Length(WordDelim);
 if First = 1 then
  First:=-Length(WordDelim);
 Result:=Copy(S,First + Length(WordDelim),Second - (First + Length(WordDelim)));
 if Item = 1 then
  Delete(Result,Length(Result),1);
end;

function TNYBck.WordPosition(Item: Integer; const S, SubStr: string): Integer;
var
 i,
 Count : Integer;
begin
 Count:=0;
 Result:=0;
 for i:=1 to Length(S) do
  begin
   if Copy(S,i,Length(SubStr)) = SubStr then
    Inc(Count);
   if Count = Item then
    begin
     Result:=i;
     Break;
    end;
  end;
end;
function TNYBck.BuildMap:string;
var
 i:Integer;
 S:string;
begin
 S:='';
 for i:=0 to FDataset.FieldCount - 1 do
  S:=S + FFieldIndicator + FDataset.Fields[i].FieldName + FSeprator;
 Delete(S,Length(S),1);//Em sondaki Fseprat÷rⁿ siliyor.
 Result:=S;
end;

constructor TNyBck.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 FDelimiter:='"';
 FFieldIndicator:='$';
 FSeprator:=',';
 FSilentImport:=True;
 FStop:=False;
end;
destructor TNyBck.Destroy;
begin
  inherited;
end;


procedure Register;
begin
  RegisterComponents('Nihat', [TNyBck]);
end;

end.