ufrmimportdb2.pas

数据库通用工具

  
  addMo( '------------------------------' );
  addMo( '目的库: '+edita2.Text );
  addMo( '目的表: '+editb5.Text );
  addMo( '目的表: 字段数 '+IntToStr(a) );
  //addMo( '目的表: 记录数 '+IntToStr( Query2.RecordCount ) );
  addMo( '目的表: 记录数 '+IntToStr(labRb.Tag) );
  
  lv2.Items.Clear;
  
  for i := 0 to a-1 do
  begin
    ss := DBGrid2.Columns.Items[i].FieldName;
    item := lv2.Items.Add;
    item.Caption := ss;
    item.SubItems.Add( getFieldType( DBGrid2.Columns.Items[i].Field.ClassName ) );
    item.SubItems.Add( IntToStr( DBGrid2.Columns.Items[i].Field.Size ) );
  end;
  
  if lv2.Items.Count > 0 then
  begin
    lv2.Items.Item[0].Selected := true;
  end;
  
end;

procedure TfrmImportDB2.lv1CustomDrawSubItem(Sender: TCustomListView;
  Item: TListItem; SubItem: Integer; State: TCustomDrawState;
  var DefaultDraw: Boolean);
begin
  case SubItem of
    1: Sender.Canvas.Font.Color := clFuchsia;
    2: Sender.Canvas.Font.Color := clBlue;
    3: Sender.Canvas.Font.Color := clRed;
  else Sender.Canvas.Font.Color := clBlack;
  end;
end;

procedure TfrmImportDB2.lv1CustomDrawItem(Sender: TCustomListView;
  Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
var
  ss : string;
begin
  {
  ss := item.SubItems.Strings[0];
  
  if SameText('1',ss) then
  begin
    Sender.Canvas.Font.Color := clBlue;
  end
  else if SameText('2',ss) then
  begin
    Sender.Canvas.Font.Color := clGreen;
  end
  else if SameText('3',ss) then
  begin
    Sender.Canvas.Font.Color := clMaroon;
  end
  else if SameText('4',ss) then
  begin
    Sender.Canvas.Font.Color := clPurple;
  end
  else
  begin
    Sender.Canvas.Font.Color := clRed;
  end;
  //}
end;

procedure TfrmImportDB2.lv2CustomDrawSubItem(Sender: TCustomListView;
  Item: TListItem; SubItem: Integer; State: TCustomDrawState;
  var DefaultDraw: Boolean);
begin
  case SubItem of
    1: Sender.Canvas.Font.Color := clFuchsia;
    2: Sender.Canvas.Font.Color := clBlue;
    3: Sender.Canvas.Font.Color := clRed;
  else Sender.Canvas.Font.Color := clBlack;
  end;
end;

procedure TfrmImportDB2.lv1Resize(Sender: TObject);
begin
  ShowScrollBar( lv1.Handle,   SB_HORZ,   False);
end;

procedure TfrmImportDB2.lv2Resize(Sender: TObject);
begin
  ShowScrollBar( lv2.Handle,   SB_HORZ,   False);
end;

procedure TfrmImportDB2.BitBtn1Click(Sender: TObject);
var
  i,j:integer;
  sa,sb:string;
  item2 : TListItem;
begin
  lv.Items.Clear();

  for  i:= 0 to lv1.Items.Count-1 do
  begin
    item := lv1.Items.Item[i];
    sa := item.Caption;
    
    for j := 0 to lv2.Items.Count-1 do
    begin
      item2 := lv2.Items.Item[j];
      sb := item2.Caption;
      
      if SameText(sb,sa) then
      begin
        with lv.Items.Add do
        begin
          Caption := sa ;
          SubItems.Add( sb );
          SubItems.Add( item.SubItems.Strings[0] );
        end;
        break;
      end;
    end;
  end;

  if lv.Items.Count>0 then
  begin
    bbtRun.Enabled := true;
    btndel.Enabled := true;
    btnclear.Enabled := true;
  end; 

end;

procedure TfrmImportDB2.btnaddClick(Sender: TObject);
begin
  if lv1.Selected=nil then Exit;
  if lv2.Selected=nil then Exit;

  if SameText( lv1.Selected.SubItems.Strings[0],lv2.Selected.SubItems.Strings[0]) then
  begin
    item := lv.Items.Add;
    item.Caption := lv1.Selected.Caption ;
    item.SubItems.Add( lv2.Selected.Caption );
    item.SubItems.Add( lv1.Selected.SubItems.Strings[0] );
  end
  else
  begin
    item := lv.Items.Add;
    item.Caption := lv1.Selected.Caption ;
    item.SubItems.Add( lv2.Selected.Caption );
    item.SubItems.Add( lv2.Selected.SubItems.Strings[0] );
    addMo( '------------------------------' );
    addMo( '目的表字段['+lv2.Selected.Caption+']' );
    addMo( '源表字段  ['+lv1.Selected.Caption+']' );
    addMo( '类型不一致，取目的表字段的类型: '+lv2.Selected.SubItems.Strings[0] );
  end;
  
  bbtRun.Enabled := true;
  btndel.Enabled := true;
  btnclear.Enabled := true;
end;

procedure TfrmImportDB2.btnclearClick(Sender: TObject);
begin
  lv.Items.Clear();
  bbtRun.Enabled := false;
  btndel.Enabled := false;
  btnclear.Enabled := false;
end;

procedure TfrmImportDB2.btndelClick(Sender: TObject);
begin
  if lv.Selected = nil then
  begin
    exit;
  end;

  lv.Selected.Delete;

  if lv.Items.Count = 0 then
  begin
    bbtRun.Enabled := false;
    btndel.Enabled := false;
    btnclear.Enabled := false;
  end;
  
end;

procedure TfrmImportDB2.lvCustomDrawSubItem(Sender: TCustomListView;
  Item: TListItem; SubItem: Integer; State: TCustomDrawState;
  var DefaultDraw: Boolean);
begin
  case SubItem of
    1: Sender.Canvas.Font.Color := clFuchsia;
    2: Sender.Canvas.Font.Color := clBlue;
    3: Sender.Canvas.Font.Color := clRed;
  else Sender.Canvas.Font.Color := clBlack;
  end;
end;

procedure TfrmImportDB2.lvResize(Sender: TObject);
begin
  ShowScrollBar( lv.Handle,   SB_HORZ,   False);//SB_BOTH
end;

function TfrmImportDB2.setFieldToParam( stype : string; tp : TParam; tf : TField ) : Integer;
var
  ff : TBlobField;
begin
  //
  Result := 0;
  //if SameText( stype,'' ) then
  if SameText( stype,'int' ) then//TIntegerField
  begin
    tp.AsInteger := tf.AsInteger;
  end
  else if SameText( stype,'varchar' ) then//='TStringField' then
  begin
    tp.AsString := tf.AsString;
  end
  else if SameText( stype,'float' ) then//='TFloatField' then
  begin
    tp.AsFloat := tf.AsFloat;
  end
  else if SameText( stype,'money' ) then//='TCurrencyField' then
  begin
    tp.AsFloat := tf.AsFloat;
  end
  else if SameText( stype,'datetime' ) then//='TDateTimeField' then
  begin
    tp.AsDateTime := tf.AsDateTime;
  end
  else if SameText( stype,'bit' ) then//='TBooleanField' then
  begin
    tp.AsBoolean := tf.AsBoolean;
  end
  else if SameText( stype,'image' ) then//='TBlobField' then
  begin
//    tp.Value := tf.AsVariant;
//    tp.AsBlob := tf.AsVariant;
    try
      ff := TBlobField( tf );
      ff.SaveToFile( path+'temp' );
      tp.LoadFromFile( path+'temp',ftBlob );
    except
    end;

  end
  else if SameText( stype,'int(自增)' ) then//='TAutoIncField' then
  begin
    Exit;//============
  end
  else if SameText( stype,'smallint' ) then//='TSmallintField' then
  begin
    tp.AsInteger := tf.AsInteger;
  end
  else if SameText( stype,'text' ) then//='TMemoField' then
  begin
    tp.AsMemo := tf.AsString;
  end
  else
  begin
    Exit;//============
  end;
  Result := 1;
end;

procedure TfrmImportDB2.bbtRunClick(Sender: TObject);
var
  sa,sb,st : string;
  i,x,v : integer;
  ss,sql,sfield,svalue : string;
  tdt : TDateTime;
begin
  if lv.Items.count<=0 then Exit;
  if Query1.IsEmpty then
  begin
    addMo( '源表 '+edita5.Text+' 中没有记录!' );
    Exit;
  end;

  bbtRun.Enabled := false;
    
  //操作时暂停数据集关联滚动
  Query1.DisableControls;
  Query2.DisableControls;

  //组织插入语句
  sql := 'insert into '+editb5.Text +' (';

  sfield := '';
  svalue := '';
  for i := 0 to lv.Items.Count-1 do
  begin
    item := lv.Items.Item[i];
    sa := item.Caption;//源表字段
    sb := item.SubItems.Strings[0];//目的表字段
    st := item.SubItems.Strings[1];//字段类型(目的表)

    if not SameText(st,'int(自增)') then
    begin
      sfield := sfield+','+sb;
//      svalue := svalue+',:'+sa;//2008-9-1 del
      svalue := svalue+',:'+sb;//目的表的字段和值假定同名
    end;

  end;

  Delete(sfield,1,1);
  Delete(svalue,1,1);

  sql := sql + sfield + ') values (' + svalue + ')';
  addMo( sql );

  Query2.Close;
  Query2.SQL.Text := sql;
  //-------------------------------------------
  ProgressBar1.Max := labRa.Tag;
  ProgressBar1.Position := 0;
  bDoing := true;
  StatusBar1.Refresh;
    
  //开始循环导入
  addMo( '------------------------------' );
  addMo( '开始导入...');
  x := 0;
  v := 0;
  tdt := Now;             
  addMo( '开始时间: '+FormatDateTime('yy-MM-dd hh:mm:ss',tdt));
  
  with Query1 do
  begin
    First;
    while not Eof do
    begin
      Application.ProcessMessages;
      
      Query2.Close;
      
      for i := 0 to lv.Items.Count-1 do
      begin
        item := lv.Items.Item[i];
        sa := item.Caption;//源表字段
        sb := item.SubItems.Strings[0];//目的表字段
        st := item.SubItems.Strings[1];//字段类型(目的表)

        if not SameText(st,'int(自增)') then
        begin
//          setFieldToParam( stype : string; tp : TParam; tf : TField );
          setFieldToParam( st,Query2.ParamByName(sb),Query1.FieldByName(sa) );          
        end;

      end;

      try
        Query2.ExecSQL; 
        inc(v);
      except
        inc(x);
      end;

      if ProgressBar1.Position<ProgressBar1.Max then
      begin
        ProgressBar1.Position := ProgressBar1.Position + 1;
        ProgressBar1.Repaint;
      end;

      Next;
    end;
    First;  
  end;

  tdt := Now - tdt;
  addMo( '结束时间: '+FormatDateTime('yy-MM-dd hh:mm:ss',Now));
  addMo( '用时: '+FormatDateTime('hh:mm:ss',tdt));
  addMo( '------------------------------' );
  addMo( '导入成功: '+IntToStr(v) );
  addMo( '导入失败: '+IntToStr(x) );
  addMo( '导入完毕。' );

  ProgressBar1.Visible := false;
  bDoing := False;
  StatusBar1.Refresh;

  //回复数据集关联
  Query1.EnableControls;
  Query2.EnableControls;
  
  //刷新显示
  {
  Query2.Close;
  Query2.SQL.Text := 'select * from '+editb5.Text;
  try
    Query2.Open;
    labRb.Caption := '记录数 '+IntToStr( Query2.RecordCount );
  except
  end;
  //}
  editb5.OnChange(Sender);

end;

procedure TfrmImportDB2.lvKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if key=VK_DELETE then
  begin
    btndel.Click;
  end;

end;

procedure TfrmImportDB2.moKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if key=VK_ESCAPE then
  begin
    btnout.Click;
  end;
end;

procedure TfrmImportDB2.FormCreate(Sender: TObject);
var
  ProgressBarStyle: integer;
begin
  //将状态栏的第二块面板设为的自绘（即psOwnerDraw）
  StatusBar1.Panels[2].Style := psOwnerDraw;

  //将进程条放入状态栏
  ProgressBar1.Parent := StatusBar1;

  //去除状态栏的边框，这样就与状态栏溶为一体了
  ProgressBarStyle := GetWindowLong(ProgressBar1.Handle,GWL_EXSTYLE);
  ProgressBarStyle := ProgressBarStyle - WS_EX_STATICEDGE;
  SetWindowLong( ProgressBar1.Handle, GWL_EXSTYLE, ProgressBarStyle);

  bDoing := False;
end;

procedure TfrmImportDB2.StatusBar1DrawPanel(StatusBar: TStatusBar;
  Panel: TStatusPanel; const Rect: TRect);
begin
  //注意这里的Panels[1]指的就是第2块面板，因为默认是从0开始的
  if bDoing then
  begin
    ProgressBar1.Visible := True;
    if Panel = StatusBar.Panels[2] then
    begin
      with ProgressBar1 do
      begin
        Top := Rect.Top;
        Left := Rect.Left;
        Width := Rect.Right - Rect.Left;// - 15;
        Height := Rect.Bottom - Rect.Top;
      end;
    end;
  end;
end;

end.