⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 dimain.~pas

📁 导从文本文件或Excel导入数据到SQL SERVER中,自动匹配字段
💻 ~PAS
📖 第 1 页 / 共 2 页
字号:
    if RG_SourceType.ItemIndex =0 then
    begin
      Case OD.FilterIndex of
        1:
        begin
          with Aq_Table do
          begin
            close;
            Sql.Clear;
            Sql.Add('Select * from ['+Trim(TV_DB.Selected.Text)+'$]');
            Open;
          end;
          DBGridAutoSize(DBGrid1);
        end;
        2:
        begin

        end;
        3:
        begin
        end;
      end;
    end
    else begin
      With Aq_Table do
      begin
        Close;
        Sql.Clear;
        Sql.Add('Select * from '+Trim(TV_DB.Selected.Text));
        Open;
      end;
      DBGridAutoSize(DBGrid1);
    end;
  end;
end;

procedure TfrmDIMain.BtnGoClick(Sender: TObject);
Var
  i,n,m,OkRec,StartRecord,EndRecord:integer;
  BK:TBookmark;  
  TmpStr,TmpStr2:String;
  RstValue:TDateTime;
  AQ_Temp:TADOQuery;
  TFName,SFName,QryTable,QryField,RstField,UpdField:TStringList;
  RecExist:Boolean;
begin
  try
    DllTargetDT.DisableControls;
    Case Pagecontrol1.ActivePageIndex of
      0:begin
        if Aq_Table.Active =False then
        begin
          Messagebox(Application.Handle,'还未确定数据源!','提示',Mb_Iconinformation+Mb_Ok);
          Exit;
        end;
        AutoMatchField;
        if Pagecontrol1.ActivePageIndex<(Pagecontrol1.PageCount-1) then
          Pageswitch(pagecontrol1.ActivePageIndex+1);
      end;
      1:begin
        try 
          BK:=DllCfgDT.GetBookmark ;
          DllCfgDT.DisableControls ;
          DllCfgDT.First; 
          for i:=1 to DllCfgDT.RecordCount do
          begin
            if Trim(DllCfgDT.FieldByName('SourceField').AsString) <>'' then
            begin  
              CDS_Temp.Append;
              for n:=0 to DllCfgDT.FieldCount-1 do
                CDS_Temp.Fields[n].Value :=DllCfgDT.Fields[n].Value;
              CDS_Temp.Post;
            end;
            DllCfgDT.Next;
          end; 
          DllCfgDT.GotoBookmark(Bk);
          DllCfgDT.FreeBookmark(BK);
        finally
          DllCfgDT.EnableControls ;
        end;
        if CDS_Temp.RecordCount=0 then
        begin
          Messagebox(Application.Handle,'您还没有选择匹配字段!','提示',Mb_Iconinformation+Mb_Ok);
          Exit;
        end;

        if Pagecontrol1.ActivePageIndex<(Pagecontrol1.PageCount-1) then
          Pageswitch(pagecontrol1.ActivePageIndex+1);

        CDS_Temp2.CloneCursor(CDS_Temp,False,True);
      end;
      2:begin
        if RadioGroup2.ItemIndex =0 then
        begin
          StartRecord:=1;
          EndRecord:=Aq_Table.RecordCount ;
        end
        else
        begin
          StartRecord:=dxSpinEdit1.IntValue;
          EndRecord:=dxSpinEdit2.IntValue;
        end;
        if StartRecord>EndRecord then
        begin
          Messagebox(Application.Handle,'开始行号不能大于结束行号,请重新输入','提示',Mb_IconError+Mb_Ok);
          Exit;
        end;
        if Pagecontrol1.ActivePageIndex<(Pagecontrol1.PageCount-1) then
          Pageswitch(pagecontrol1.ActivePageIndex+1);
        BtnBack.Enabled :=False;
        OkRec:=0;

        PB1.Min :=0;
        PB1.Max :=EndRecord-StartRecord+1;
        AQ_Temp:=TADOQuery.Create(Application);
        Aq_Temp.Connection :=DllDBCnn;
        try
          TFName:=TStringList.Create;
          SFName:=TStringList.Create;
          QryTable:=TStringList.Create;
          QryField:=TStringList.Create;
          RstField:=TStringList.Create;
          UpdField:=TStringList.Create;

          Aq_Table.First;
          Aq_Table.MoveBy(StartRecord-1);
          CancelImport:=False;
          BtnCancel.Enabled :=False;
          for i:=1 to EndRecord-StartRecord+1 do
          begin
            Application.ProcessMessages ;
            PB1.Position :=i;
            LbMsg.Caption :='正在导入第 '+InttoStr(i)+' 条记录,共需要导入 '+InttoStr(EndRecord-StartRecord+1)+'条记录!';
            if CancelImport then
            begin
              if Messagebox(Application.Handle,'真的要停止导入吗?','导入',Mb_IconQuestion+Mb_YesNo)=IdYes then
              begin
                Messagebox(Application.Handle,'由于用户取消导入,部分数据未导入成功!','提示',Mb_iconwarning+Mb_Ok);
                BtnGo.Visible :=False;
                Exit;
              end;
              CancelImport:=False;
            end;
            showmessage(inttostr(i));
            //开始导入记录
            try
              TmpStr:='';
              TmpStr2:='';
              TFName.Clear;
              SFName.Clear;
              DllTargetDT.Append;
              CDS_Temp.First;
              for n:=0 to CDS_Temp.RecordCount-1 do
              begin  
                TFName.Add(CDS_Temp.FieldByName('FieldName').AsString);
                SFName.Add(CDS_Temp.FieldByName('SourceField').AsString);
                QryTable.Add(Trim(CDS_Temp.FieldByName('QryTable').AsString));
                QryField.Add(Trim(CDS_Temp.FieldByName('QryField').AsString));
                RstField.Add(Trim(CDS_Temp.FieldByName('RstField').AsString));
                UpdField.Add(Trim(CDS_Temp.FieldByName('UpdateField').AsString));
                if CDS_Temp.FieldByName('QueryField').AsBoolean =True then
                begin
                  if (QryTable[n]='') Or (QryField[n]='') Or (RstField[n]='') Or (UpdField[n]='') then
                  begin
                    MessageBox(Application.Handle,'导入参数不完整!','提示',MB_IconError+MB_Ok);
                    Continue;
                  end
                  else begin
                    RecExist:=False;
                    TmpStr2:=QryTable[n]+'/'+RstField[n]+'/'+UpdField[n];
                    if n>0 then
                    for m:=0 to n-1 do
                    if TmpStr2=QryTable[m]+'/'+RstField[m]+'/'+UpdField[m] then
                    begin
                      RecExist:=True;
                      Break;
                    end;

                    if RecExist=False then begin
                      With AQ_Temp do
                      begin
                        Close;
                        Sql.Clear;
                        Sql.Add('Select '+RstField[n]+' from '+QryTable[n]+' Where ');
                        CDS_Temp2.Filtered :=False;
                        CDS_Temp2.Filter :='QryTable='''+QryTable[n]+''' And RstField='''+RstField[n]+''' And UpdateField='''+UpdField[n]+'''';
                        CDS_Temp2.Filtered :=True;
                        CDS_Temp2.First;
                        for m:=1 to CDS_Temp2.RecordCount do
                        begin
                          if m>1 then
                            Sql.Add(' And ');
                          Sql.Add('('+CDS_Temp2.FieldByName('QryField').AsString+'='''+Trim(Aq_Table.FieldByName(CDS_Temp2.FieldByName('SourceField').AsString).AsString)+''')');
                          CDS_Temp2.Next;
                        end;
                        Open;
                        if RecordCount>0 then
                          DllTargetDT.FieldByName(UpdField[n]).Value :=FieldByName(RstField[n]).Value
                        else
                          DllTargetDT.FieldByName(UpdField[n]).Value :=CDS_Temp.FieldByName('DefaultValue').Value;
                      end;
                    end;
                  end;
                end
                else begin
                  if DllTargetDT.FieldByName(TFName.Strings[n]).DataType=ftDateTime then
                  begin
                    if Trim(Aq_Table.FieldByName(SFName.Strings[n]).AsString)<>'' then
                    begin
                      RstValue:=ConvertAsDateTime(Aq_Table.FieldByName(SFName.Strings[n]).AsString);
                      DllTargetDT.FieldByName(TFName.Strings[n]).AsString :=FormatDateTime('yyyy-MM-dd HH:mm:ss',RstValue);
                    end;
                  end
                  else
                    DllTargetDT.FieldByName(TFName.Strings[n]).AsString :=Aq_Table.FieldByName(SFName.Strings[n]).AsString;
                end;
                CDS_Temp.Next;
              end; //end for
              DllTargetDT.Post;
              Inc(OkRec);
            except
              on e:Exception do
                Memo1.Lines.Add('导入第 '+InttoStr(i)+' (绝对位置: '+InttoStr(StartRecord+i)+') 条记录时出错!错误信息:'+E.Message);
            end;
            Aq_Table.Next;  
          end; //end for
          if (OkRec>0) And (SqlStr<>'') then
          begin
            LbMsg.Caption :='正在执行导入后命令';
            Memo1.Lines.Add('开始执行导入后命令');
            With Aq_Temp do
            begin
              Close;
              Sql.Clear;
              Sql.Add(SqlStr);
              try 
                ExecSql;
                Memo1.Lines.Add('导入后命令执行成功!');
              except
               on e:Exception do
                Memo1.Lines.Add('执行导入后命令时出错!错误信息:'+E.Message);
              end;
            end;
          end;
          if OkRec=EndRecord-StartRecord+1 then
            Messagebox(Application.Handle,'数据导入成功!','提示',Mb_Iconinformation+Mb_Ok)
          else
          begin
            Messagebox(Application.Handle,Pchar('数据完成,但有 '+InttoStr(EndRecord-StartRecord+1-OkRec)+' 条记录导入失败!'),'提示',Mb_Iconinformation+Mb_Ok);
            BtnGo.Visible :=False;
          end;
        finally
          QryTable.Free;
          QryField.Free;
          RstField.Free;
          UpdField.Free;
          TFName.Free;
          SFName.Free;
          Aq_Temp.Free;
          BtnCancel.Enabled :=True;
        end; 
      end;
      3:begin
        CancelImport:=True;
      end;
    end;
  finally
    DllTargetDT.EnableControls;
  end;
end;

procedure TfrmDIMain.AQ_TableAfterOpen(DataSet: TDataSet);
var
  n:integer;
begin
  inherited;
  DBGrid2.Columns[3].Picklist.Clear;
  if Aq_Table.RecordCount>0 then
  begin
    for n:=0 to Aq_Table.Fields.Count-1 do
      DBGrid2.Columns[3].Picklist.Add(Aq_Table.Fields[n].FieldName);  
    PB1.Min:=1;
    PB1.Max:=Aq_Table.RecordCount ;
  end;
end;

procedure TfrmDIMain.RadioGroup2Click(Sender: TObject);
begin
  dxSpinEdit1.Enabled :=(RadioGroup2.ItemIndex =1);
  dxSpinEdit2.Enabled :=(RadioGroup2.ItemIndex =1);
end;

procedure TfrmDIMain.CheckBox1Click(Sender: TObject);
begin
  DBGrid3.Enabled :=(CheckBox1.Checked);
  RadioGroup4.Enabled :=(CheckBox1.Checked);
end;

procedure TfrmDIMain.BtnCancelClick(Sender: TObject);
begin
  Close;
end;

procedure TfrmDIMain.DBGrid3ColExit(Sender: TObject);
begin
  if DBGrid3.SelectedField.DataType = ftBoolean then
    DBGrid3.Options := Self.FOriginalOptions;
end;

procedure TfrmDIMain.DBGrid3ColEnter(Sender: TObject);
begin
  if DBGrid3.SelectedField.DataType = ftBoolean then
  begin
    FOriginalOptions := DBGrid3.Options;
    DBGrid3.Options := DBGrid3.Options - [dgEditing];
  end;
end;

procedure TfrmDIMain.DBGrid3DrawColumnCell(Sender: TObject;
  const Rect: TRect; DataCol: Integer; Column: TColumn;
  State: TGridDrawState);
Const
 CtrlState : array[Boolean] of Integer = (DFCS_BUTTONCHECK,
     DFCS_BUTTONCHECK or DFCS_CHECKED);
var
  CheckBoxRectangle : TRect;
begin
  if Column.Field.DataType = ftBoolean then
  begin
    DBGrid3.Canvas.FillRect(Rect);
    CheckBoxRectangle.Left := Rect.Left + 2;
    CheckBoxRectangle.Right := Rect.Right - 2;
    CheckBoxRectangle.Top := Rect.Top + 2;
    CheckBoxRectangle.Bottom := Rect.Bottom - 2;
    DrawFrameControl(DBGrid3.Canvas.Handle,
    CheckBoxRectangle,
    DFC_BUTTON,
    CtrlState[Column.Field.AsBoolean]);
  end;
end;


procedure TfrmDIMain.DBGrid3CellClick(Column: TColumn);
begin
  if DBGrid3.SelectedField.DataType = ftBoolean then
    SaveBoolean();
end;

procedure TfrmDIMain.BtnBackClick(Sender: TObject);
begin
  if Pagecontrol1.ActivePageIndex=0 then
    Pageswitch(0)
  else
    Pageswitch(pagecontrol1.ActivePageIndex-1);
end;

procedure TfrmDIMain.DBGrid1DrawColumnCell(Sender: TObject;
  const Rect: TRect; DataCol: Integer; Column: TColumn;
  State: TGridDrawState);
begin
  DBGridRecordSize(Column);
  with TMyDBGrid(Sender) do
  begin
    if DataLink.ActiveRecord=Row-1 then
    begin
      Canvas.Font.Color:=clWhite;
      Canvas.Brush.Color:=$00800040;
    end
    else
    begin
      Canvas.Brush.Color:=Color;
      Canvas.Font.Color:=Font.Color;
    end;
    DefaultDrawColumnCell(Rect,DataCol,Column,State);
  end; 
end;

procedure TfrmDIMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin 
  CDS_Temp.Free;
  CDS_Temp2.Free;
  Action:=cafree;
end;

procedure TfrmDIMain.FormShow(Sender: TObject);
var
  i:Integer;
  FName:String;
begin
  try
    CDS_Temp.FieldDefs.Clear;
    CDS_Temp.FieldDefs.Add('Autoid',ftAutoInc,0);
    CDS_Temp.FieldDefs.Add('FieldName',ftString,30);
    CDS_Temp.FieldDefs.Add('DataType',ftString,30);
    CDS_Temp.FieldDefs.Add('DataSize',ftInteger,0);
    CDS_Temp.FieldDefs.Add('FieldCaption',ftString,30);
    CDS_Temp.FieldDefs.Add('FieldVisable',ftBoolean,0);
    CDS_Temp.FieldDefs.Add('QueryField',ftBoolean,0);
    CDS_Temp.FieldDefs.Add('QryTable',ftString,30);
    CDS_Temp.FieldDefs.Add('QryField',ftString,30);
    CDS_Temp.FieldDefs.Add('RstField',ftString,30);
    CDS_Temp.FieldDefs.Add('UpdateField',ftString,30);
    CDS_Temp.FieldDefs.Add('SourceField',ftString,30);
    CDS_Temp.FieldDefs.Add('DefaultValue',ftString,50);
    CDS_Temp.CreateDataSet;
    With DllCfgDT do
    begin
      DllCfgDT.First;
      for i:=0 to DllCfgDT.RecordCount-1 do
      begin
        FName:=Trim(DllCfgDT.FieldByName('FieldName').AsString); 
        Edit;
        Case DllTargetDT.FieldByName(FName).DataType of
          ftString:begin
            FieldByName('DataType').AsString :='字符串型';
          end;
          ftAutoInc:begin
            FieldByName('DataType').AsString :='自动编号';
          end;
          ftSmallInt,ftInteger,ftWord:begin
            FieldByName('DataType').AsString :='整型';
          end;
          ftBoolean:begin
            FieldByName('DataType').AsString :='布尔型';
          end;
          ftFloat:begin
            FieldByName('DataType').AsString :='浮点型';
          end;
          ftCurrency:begin
            FieldByName('DataType').AsString :='货币型';
          end;
          ftDate:begin
            FieldByName('DataType').AsString :='日期型';
          end;
          ftTime:begin
            FieldByName('DataType').AsString :='时间型';
          end;
          ftDateTime:begin
            FieldByName('DataType').AsString :='日期时间型';
          end ;
          ftBlob:begin
            FieldByName('DataType').AsString :='图片';
          end;
          else
          begin
            FieldByName('DataType').AsString :='数据类型未知';  
          end; 
        end; //end case
        Post;
        DllCfgDT.Next;
      end;
    end;
  finally  
  end;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -