assign_a.~pas

通过此软件可方便的对interbase数据库进行合并

unit assign_a;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, RzPanel, FileCtrl, ComCtrls, RzListVw, rsListbox,
  LMDBaseLabel, LMDCustomSimpleLabel, LMDSimpleLabel, LMDControl,
  LMDBaseControl, LMDBaseGraphicControl, LMDGraphicControl, LMDFill, Db,
  IBDatabase, LMDCustomButton, LMDButton, IBCustomDataSet, IBTable,
  DBTables, Grids, DBGrids, LMDDrawEdge, TFlatProgressBarUnit,
  LMDCustomLabel, LMDLabel, LMDCustomComponent, LMDCustomHint,
  LMDCustomShapeHint, LMDShapeHint;

type
  Tassign_aform = class(TForm)
    Button2: TButton;
    RzGroupBox2: TRzGroupBox;
    DirectoryListBox2: TDirectoryListBox;
    DriveComboBox2: TDriveComboBox;
    FileListBox2: TFileListBox;
    Edit2: TEdit;
    FilterComboBox2: TFilterComboBox;
    RzGroupBox1: TRzGroupBox;
    DirectoryListBox1: TDirectoryListBox;
    DriveComboBox1: TDriveComboBox;
    FileListBox1: TFileListBox;
    Edit1: TEdit;
    FilterComboBox1: TFilterComboBox;
    rsListbox1: TrsListbox;
    LMDFill1: TLMDFill;
    LMDSimpleLabel1: TLMDSimpleLabel;
    LMDButton1: TLMDButton;
    ListBox2: TListBox;
    LMDDrawEdge1: TLMDDrawEdge;
    rsListbox2: TrsListbox;
    LMDDrawEdge2: TLMDDrawEdge;
    LMDShapeHint1: TLMDShapeHint;
    procedure FileListBox1Click(Sender: TObject);
    procedure FileListBox2Click(Sender: TObject);
    procedure LMDButton1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  assign_aform: Tassign_aform;
  ifselect: boolean;
implementation

uses main,datmod,tips;

{$R *.DFM}

procedure Tassign_aform.FileListBox1Click(Sender: TObject);
var
aliasparams : Tstringlist;
begin
ifselect:=true;
datamodule1.database1.Connected:=false;
datamodule1.session1.DeleteAlias('SOURCEBASE');
  AliasParams := TStringList.Create;
  try
    with AliasParams do begin
      Add('OPEN MODE=READ/WRITE');
      Add('USER NAME=SYSDBA');
      Add('ENABLE BCD=TRUE');
      Add('SERVER NAME='+filelistbox1.filename);
    end;
datamodule1.Session1.AddAlias('SOURCEBASE', 'INTRBASE', AliasParams);
datamodule1.database1.AliasName:='SOURCEBASE';
datamodule1.database1.Connected:=true;
rsListBox1.Clear;
datamodule1.Session1.GetTableNames('src','',false,true,rslistbox1.Items);
  finally
    AliasParams.Free;
end;
end;

procedure Tassign_aform.FileListBox2Click(Sender: TObject);
var aliasparams : Tstringlist;
begin
datamodule1.database2.Connected:=false;
datamodule1.session2.DeleteAlias('DESTBASE');
  AliasParams := TStringList.Create;
  try
    with AliasParams do begin
      Add('OPEN MODE=READ/WRITE');
      Add('USER NAME=SYSDBA');
      Add('ENABLE BCD=TRUE');
      Add('SERVER NAME='+filelistbox2.filename);
    end;
datamodule1.Session2.AddAlias('DESTBASE', 'INTRBASE', AliasParams);
datamodule1.database2.AliasName:='DESTBASE';
datamodule1.database2.Connected:=true;
if ifselect then LMDButton1.Enabled:=true;
rsListBox2.Clear;
datamodule1.Session2.GetTableNames('det','',false,true,rslistbox2.Items);
  finally
    AliasParams.Free;
end;
end;

procedure Tassign_aform.LMDButton1Click(Sender: TObject);
var
 i,j,k,stepofprog,listnum,recnum: integer;
 destfield: TField;
 ttablename,tfieldname: string;
 ifadd: boolean;
begin
 LMDButton1.Enabled:=false;
 tipsform.ListView1.Items.Clear;
 mainform.rzprogressbar1.Percent:=0;
 i:=0;
 listnum:=0;
 stepofprog:=rslistbox2.CheckedCount;
 while i<rslistbox2.Items.Count do
  begin
  recnum:=0;
  if rslistbox2.Checked[i]=true then
  begin
    ttablename:=rslistbox2.Items.Strings[i];
    mainform.RzStatusPane1.Caption:=ttablename;
    j:=0;
    while j<rslistbox1.Items.Count do
     begin
       if ttablename=rslistbox1.Items.Strings[j] then
         begin
           listbox2.Clear;
           datamodule1.table1.Close;
           datamodule1.table2.Close;
           datamodule1.table1.TableName:=ttablename;
           datamodule1.table2.TableName:=ttablename;
           datamodule1.table1.Open;
           datamodule1.table2.Open;
           datamodule1.table2.GetFieldNames(listbox2.Items);
         while not datamodule1.table1.Eof do
         begin
         recnum:=recnum+1;
           if ttablename='MAINDBF' then
           begin
            datamodule1.query3.Close;
            datamodule1.query3.SQL.Clear;
            datamodule1.query3.SQL.Add('select * from MAINDBF where YHBH=:P_YHBH');
            DataModule1.query3.Params.Items[0].AsString:=datamodule1.table1.fieldbyname('YHBH').asstring;
            datamodule1.query3.open;
           if datamodule1.query3.eof then
                ifadd:=true else
                begin
                tipsform.ListView1.Items.Add;
                tipsform.ListView1.Items.Item[listnum].Caption:='MAINDBF';
                tipsform.ListView1.Items.Item[listnum].SubItems.Add(inttostr(recnum));
                tipsform.ListView1.Items.Item[listnum].SubItems.Add('用户编号重复');
                listnum:=listnum+1;
                ifadd:=false;
                end;
           end
           else ifadd:=true;
         if ifadd then
          begin
          try
            datamodule1.table2.Append;
            k:=0;
            while k<listbox2.Items.Count do
            begin
              tfieldname:=trim(listbox2.Items.Strings[k]);
              destfield:=datamodule1.table1.FindField(tfieldname);
               if destfield<>Nil then
               begin
               if datamodule1.Table1.FieldValues[tfieldname]<>Null then
                datamodule1.table2.FieldValues[tfieldname]:=datamodule1.table1.FieldValues[tfieldname];
               end;
             k:=k+1;
           end;
           datamodule1.table2.Post;
         except
                tipsform.ListView1.Items.Add;
                tipsform.ListView1.Items.Item[listnum].Caption:=ttablename;
                tipsform.ListView1.Items.Item[listnum].SubItems.Add(inttostr(recnum));
                tipsform.ListView1.Items.Item[listnum].SubItems.Add('关键字段重复或非法数据');
                listnum:=listnum+1;
         end;
         end;
          datamodule1.table1.Next;
       end;
       end;
       j:=j+1;
     end;
     mainform.rzprogressbar1.percent:=mainform.RzProgressBar1.Percent+100 div stepofprog;
     end;
     i:=i+1;
     end;
    LMDButton1.Enabled:=true;
end;

procedure Tassign_aform.FormShow(Sender: TObject);
begin
LMDButton1.Enabled:=false;
end;

end.