unit_importdata.pas

一个不错的源程序DELPHI开发的,功能比较好的客户管理系统

  accept:=true;   //允许拖放该控件
end;

procedure TFrm_ImportData.FormDragDrop(Sender, Source: TObject; X, Y: Integer);
begin
  if not (sender is tform) then exit;
  //只能在窗体上放下控件
  with source as tpanel do
  begin
   //设置面板的新位置
   left:=x;
   top:=y;
  end;
end;

procedure TFrm_ImportData.Button4Click(Sender: TObject);
var
  Ldata:TDataCode;
  str :string;
begin
  button3.Enabled :=false;
  divi_edit.Text :='';
  col_edit.Text :=inttostr(3);
  col_editChange(nil);
  if trim(edit1.text)='' then
  begin
    messagedlg('请选择要导入文件名！',mtInformation	,[mbok],0);
    exit;
  end;
  
  if ComboBox.Text ='' then
  begin
    messagedlg('请选择目标表！',mtInformation	,[mbok],0);
    exit;
  end;
  Panel4.Visible :=true;
  FreeNodeListBox(xtzd_list);
  FreeNodeListBox(link_list);
  xtzd_list.Items.Clear;
  link_list.Items.Clear;
  try
      //获取数据中全部表名加入到tablelist中
    query1.close;
    tablename :=ComboBox.Text;
    if pos('.',tablename)>0 then
    tablename :=copy(tablename,1,pos('.',tablename) -1 );
    query1.sql.text :=
    'Select TABLE_NAME,COLUMN_NAME,DATA_TYPE,DATA_LENGTH,NULLABLE FROM '
    +' user_tab_columns where TABLE_NAME='+#39
    +tablename+#39;
    query1.open;
    query1.First;
    while not query1.Eof do
    begin
      //赋值对象
      Ldata:=TdataCode.Create;
      //存字段名
      Ldata.COLUMN_NAME :=query1.fieldbyname('COLUMN_NAME').asstring;
      //存字段类型
      Ldata.DATA_TYPE   :=query1.fieldbyname('DATA_TYPE').asstring;
      //存字段长度
      Ldata.DATA_LENGTH :=query1.fieldbyname('DATA_LENGTH').asstring;
      //存非空标志
      Ldata.NULLABLE :=query1.fieldbyname('NULLABLE').asstring;

      //找到字段说明
      query2.close;
      query2.sql.Text :=
      'Select COMMENTS FROM USER_COL_COMMENTS where TABLE_NAME='
      +#39+tablename+#39+' and COLUMN_NAME='
      +#39+Ldata.COLUMN_NAME+#39;
      query2.open;
      str :=query2.Fields[0].asstring;
      if trim(str)='' then
      str :=Ldata.COLUMN_NAME;
      //存字段说明
      Ldata.COMMENTS :=Str;
      //存连接的列
      Ldata.LinkCol :='0';
      //加上
      xtzd_list.Items.AddObject(str,Ldata);
      
      query1.Next;
    end;
  except
    messagedlg('程序执行过程出错！',mtInformation	,[mbok],0);
    exit;
  end;
end;

procedure TFrm_ImportData.SpeedButton4Click(Sender: TObject);
var
  i :integer;
begin
  if P_TxtOrExcel=false then
  if trim(divi_edit.text)='' then
  begin
    messagedlg('请输入分隔符！',mtInformation	,[mbok],0);
    divi_edit.SetFocus;
    exit;
  end;
  if link_list.Items.Count <0  then
  begin
    messagedlg('请选择连接！',mtInformation	,[mbok],0);
    link_list.SetFocus;
    exit;
  end;
  //非空字段看有没全部被加上
  for i:=0 to xtzd_list.Items.Count -1 do
  begin
    if UpperCase(TDataCode(xtzd_list.Items.Objects[i]).NULLABLE)='N' then
    begin
      messagedlg('出错，非空字段'+TDataCode(xtzd_list.Items.Objects[i]).COMMENTS+
        '没有连接',mtInformation	,[mbok],0);
      xtzd_list.SetFocus;
      exit;
    end;
  end;
  P_Divi :=trim(divi_edit.text);
  //设置连接的个数
  P_LinkCount :=link_list.Items.Count;
  setlength(P_Link,P_LinkCount + 1);
  for i:=0 to link_list.Items.Count -1 do
  begin
    //赋值
    P_Link[i].DataCode :=TDataCode(link_list.Items.Objects[i]);

  end;
  P_Add :=true;
  Panel4.Visible :=false;
  button3.Enabled :=true;
end;

procedure TFrm_ImportData.SpeedButton5Click(Sender: TObject);
begin
  P_Add :=false;
  Panel4.Visible :=false;
  button3.Enabled :=false;
end;

procedure TFrm_ImportData.SpeedButton1Click(Sender: TObject);
var
  Str,Str1:string;
  Ldata,Ldata1:TDataCode;
  i :integer;
begin
  if (yhzd_list.ItemIndex=-1) or (xtzd_list.ItemIndex=-1) then
  begin
    messagedlg('请选择连接！',mtInformation	,[mbok],0);
    exit;
  end
  else
  begin
     str1 :=yhzd_list.Items[yhzd_list.ItemIndex]+
     '<=>'+xtzd_list.Items[xtzd_list.ItemIndex];//显示的
     
     Ldata :=TDataCode(xtzd_list.Items.Objects[xtzd_list.ItemIndex]);
     //加上对应的列
     str :=yhzd_list.Items[yhzd_list.ItemIndex];
     i :=pos('列',Str);
     i :=i -1;
     str :=copy(str,3,i -2);
     Ldata.LinkCol :=inttostr(strtoint(str) -1);
     link_list.Items.AddObject(Str1,Ldata);
     //删除
     yhzd_list.Items.Delete(yhzd_list.ItemIndex);

     //删除
     xtzd_list.Items.delete(xtzd_list.ItemIndex);

     yhzd_list.ItemIndex:=-1;
     xtzd_list.ItemIndex:=-1;
  end;
end;

procedure TFrm_ImportData.SpeedButton2Click(Sender: TObject);
var str:string;
    i:integer;
    Ldata,Ldata1:TDataCode;
begin
  if link_list.itemindex=-1 then
  begin
     messagedlg('请选择要删除的连接！',mtInformation	,[mbok],0);
     exit;
  end
  else
  begin
     str:=link_list.Items[link_list.itemindex];
    i:=pos('<',str);
    yhzd_list.Items.add(copy(str,1,i-1));
    i:=pos('>',str);
    delete(str,1,i);
    //
    Ldata :=TDataCode(link_list.Items.Objects[link_list.ItemIndex]);
    //加上对应的列
    Ldata.LinkCol :='0';
    xtzd_list.items.AddObject(str,Ldata);

    link_list.Items.delete(link_list.ItemIndex);
    link_list.itemindex:=-1;
  end;
end;

procedure TFrm_ImportData.SpeedButton3Click(Sender: TObject);
var j,i:integer;
     str:string;
     Ldata,Ldata1:TDataCode;
begin
  for j:=0 to link_list.Items.Count-1 do
   begin
     str:=link_list.Items[0];
     i:=pos('<',str);
     yhzd_list.Items.add(copy(str,1,i-1));
     i:=pos('>',str);
     delete(str,1,i);
     //
     Ldata :=TDataCode(link_list.Items.Objects[0]);
     //加上对应的列
     Ldata.LinkCol :='0';
     xtzd_list.items.AddObject(str,Ldata);

     link_list.Items.delete(0);
  end;
end;

procedure TFrm_ImportData.col_editChange(Sender: TObject);
var i:integer;
begin
  SpeedButton3Click(nil);
  yhzd_list.Items.clear;
  for i:=1 to strtoint(col_edit.text) do
    yhzd_list.items.Add('第'+inttostr(i)+'列');
end;

procedure TFrm_ImportData.FreeNodeListBox(ListBox: TListBox);
var
  i:integer;
  Ldata:TDataCode;
begin
  for i:=0 to ListBox.Items.Count - 1 do
  begin
    Ldata:=TdataCode(ListBox.Items.Objects[i]);
    if Ldata <> nil then Ldata.Free;
  end;
end;

function TFrm_ImportData.ConstrucSql: string;
begin
  
end;

procedure TFrm_ImportData.CheckBox1Click(Sender: TObject);
begin
  if CheckBox1.Checked then
  P_Title :=true
  else
  P_Title :=false;
end;

procedure TFrm_ImportData.FreeNodeCombobox(Combobox: TCombobox);
var
  i:integer;
  Ldata:TDataCode1;
begin
  for i:=0 to ComboBox.Items.Count - 1 do
  begin
    Ldata:=TdataCode1(ComboBox.Items.Objects[i]);
    if Ldata <> nil then Ldata.Free;
  end;
end;

procedure TFrm_ImportData.SetInTableName(values: string);
begin
  P_InTableName:=values;
end;

function TFrm_ImportData.GetCodeIndex(Combobox: TCombobox;
  pCode: string): integer;
var
  i:integer;
begin
  result:=0;
  for i:=0 to ComboBox.Items.Count - 1 do
  begin
    if (ComboBox.Items.Objects[i]<>nil) and
        (pCode = TDataCode1(ComboBox.Items.Objects[i]).Code) then
    begin
       result:=i;
       break;
    end;
  end;
end;

procedure TFrm_ImportData.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  Action :=cafree;
end;

procedure TFrm_ImportData.Button2Click(Sender: TObject);
begin
  close;
end;

procedure TFrm_ImportData.SpeedButton6Click(Sender: TObject);
begin
  P_Add :=false;
  Panel4.Visible :=false;
  button3.Enabled :=false;
end;

procedure TFrm_ImportData.PageControl1DragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
begin
  accept:=true;   //允许拖放该控件
end;

procedure TFrm_ImportData.PageControl1DragDrop(Sender, Source: TObject; X,
  Y: Integer);
begin
  if not (sender is tform) then exit;
  //只能在窗体上放下控件
  with source as tpanel do
  begin
   //设置面板的新位置
   left:=x;
   top:=y;
  end;
end;

procedure TFrm_ImportData.GroupBox1DragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
begin
  accept:=true;   //允许拖放该控件
end;

procedure TFrm_ImportData.GroupBox2DragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
begin
  accept:=true;   //允许拖放该控件
end;

procedure TFrm_ImportData.GroupBox1DragDrop(Sender, Source: TObject; X,
  Y: Integer);
begin
  if not (sender is tform) then exit;
  //只能在窗体上放下控件
  with source as tpanel do
  begin
   //设置面板的新位置
   left:=x;
   top:=y;
  end;
end;

procedure TFrm_ImportData.GroupBox2DragDrop(Sender, Source: TObject; X,
  Y: Integer);
begin
  if not (sender is tform) then exit;
  //只能在窗体上放下控件
  with source as tpanel do
  begin
   //设置面板的新位置
   left:=x;
   top:=y;
  end;
end;

procedure TFrm_ImportData.SetInFieldName(values: string);
begin
  P_InFieldName:=values;
end;

procedure TFrm_ImportData.SetInFieldLabel(values: string);
begin
  P_InFieldLabel:=values;
end;

procedure TFrm_ImportData.SetInFieldValue(values: string);
begin
  P_InFieldValue:=values;
end;

end.