xls.pas

xls2sql 将Microsoft的Excel文件导入MSSQL中

unit xls;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  DBTables, Grids, DBGrids, Db, ADODB, StdCtrls;

type
  TForm1 = class(TForm)
    ADOConnection1: TADOConnection;
    ADOQuery1: TADOQuery;
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    whdb: TDatabase;
    qu_tb: TQuery;
    DataSource2: TDataSource;
    DBGrid2: TDBGrid;
    Button1: TButton;
    Edit1: TEdit;
    Label1: TLabel;
    OpenDialog1: TOpenDialog;
    Label4: TLabel;
    Qu_temp: TQuery;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
    procedure Edit1Exit(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
  public
    sjjb: integer;
    function get_sub_id(parentid:string;parentjb:integer;var new_id:string): boolean;
    function get_inc36_id(old_id: string;var sub_id: string): boolean;
    function max_number(layer_len: integer): int64;
    function step_n36(old_n36:string;max_number:int64;var step_n36:string):boolean;
    function n36_number(N36: string): int64;
    function number_n36(number:int64):string;
    function n_36_power(number, power_36_n: integer): int64;
    function n36bit_number(n36bit:Char):integer;
    function NUMBER_N36BIT(NUMBER: integer):Char;
    function fill(oldstr:string; fchar:char; len:integer; ftype:integer; var restr: string):boolean;
    { Public declarations }
  end;

var
  Form1: TForm1;
  db_username,db_pass: string;
  fstr:string;
const
  N36_CHAR:array [0..35] of char =('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F','G','H','I','J',
                               'K','L','M','N','O','P','Q','R','S','T','U','V','W','X','Y','Z');

implementation

{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
var  start_sub_id,prevcode,currcode, curr_sub_id:string;
begin
    if edit1.text='' then
    begin
      application.MessageBox('上级id 数据不能为空！','提示',$30);
      edit1.SetFocus ;
      exit;
    end;
    sjjb:=strlen(PChar(trim(edit1.Text))) div 3;
    get_sub_id(trim(edit1.Text),sjjb,start_sub_id);
    curr_sub_id:=start_sub_id;
    if OpenDialog1.Execute then begin
     ADOConnection1.ConnectionString:='DBQ='+OpenDialog1.FileName+';DefaultDir=c:\;Driver={Microsoft Excel Driver (*.xls)};DriverId=790;FIL=excel 8.0;FILEDSN=C:\whdsxls.dsn;MaxBufferSize=2048;MaxScanRows=8;PageTimeout=5;ReadOnly=1;SafeTransactions=0;Threads=3;UID=admin;UserCommitSync=Yes;';
     ADOConnection1.open;
     with ADOQuery1 do begin
       close;
       sql.Clear ;
       sql.Add('select * from [sheet1$] order by f2');
       open;
     end;
    end else exit;
    try
      whdb.StartTransaction ;
      with qu_tb do
      begin
        close;
        sql.Clear ;
        sql.Add('insert into material (MID,MNO,SSIGN,MNAME,PRICE,MJB,MMX,DW,MTYPE,BZ,YBPRICE,spec,hsz,jldw,cid,plrk,plck)');
        sql.Add('values (:MID,:MNO,:SSIGN,:MNAME,:PRICE,:MJB,:MMX,:DW,:MTYPE,:BZ,:YBPRICE,:spec,:hsz,:jldw,:cid,:plrk,:plck)');
        prevcode:='';
        while not ADOQuery1.Eof do begin
          if (trim(ADOQuery1.fieldbyname('F3').asstring)='') and (trim(ADOQuery1.fieldbyname('F4').asstring)='') then begin
                ADOQuery1.next;
                continue;
          end;
          if  trim(ADOQuery1.fieldbyname('F2').asstring)='' then begin
            if trim(ADOQuery1.fieldbyname('F3').asstring)='' then
                currcode:=trim(ADOQuery1.fieldbyname('F4').asstring)
            else currcode:=trim(ADOQuery1.fieldbyname('F3').asstring);
          end else currcode:=trim(ADOQuery1.fieldbyname('F2').asstring);
          if  prevcode=currcode then begin
                ADOQuery1.next;
                continue;
          end;
          prevcode:=currcode;
          parambyname('MID').asstring   :=curr_sub_id;
          parambyname('MNO').asstring   :=currcode;
          if ADOQuery1.fieldbyname('F3').asstring<>'' then
            parambyname('ssign').asstring   :=ADOQuery1.fieldbyname('F3').asstring
          else
            parambyname('ssign').asstring   :=ADOQuery1.fieldbyname('F4').asstring ;
          if ADOQuery1.fieldbyname('F4').asstring<>'' then
            parambyname('mname').asstring   :=ADOQuery1.fieldbyname('F4').asstring
          else
            parambyname('mname').asstring   :=ADOQuery1.fieldbyname('F3').asstring ;
//          parambyname('price').asfloat   :=ADOQuery1.fieldbyname('F5').asfloat*0.067773;
          parambyname('price').asfloat   :=0;
          parambyname('ybprice').asfloat   :=ADOQuery1.fieldbyname('F5').asfloat;
          parambyname('bz').asstring   :=ADOQuery1.fieldbyname('F6').asstring;
          parambyname('mjb').asinteger   :=sjjb+1;
          parambyname('mmx').asstring   :='1';
          parambyname('mtype').asinteger   :=0;
          parambyname('dw').asstring   :='只';
          parambyname('hsz').asinteger   :=1;
          parambyname('jldw').asstring   :='只';
          parambyname('spec').asstring   :='';
          parambyname('cid').asstring   :='';
          parambyname('plrk').asinteger   :=1;
          parambyname('plck').asinteger   :=1;
          execsql;
          get_inc36_id(curr_sub_id,curr_sub_id);
          ADOQuery1.Next ;
        end;
      end;
      whdb.Commit ;
      application.MessageBox('写入数据完毕！','提示',$30);
    except
      on E:EDBEngineError do begin
        whdb.Rollback ;
        application.MessageBox(pchar(E.Message + #13 + '数据提交失败，请再试一次！'),'提示',$30);
      end;
    end;
    ADOQuery1.EnableControls ;
  with qu_tb do begin
    close;
    sql.Clear ;
    sql.Add('select * from material where mmx<>1 order by mid');
    open;
  end;

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
    whdb.Connected :=true;
    qu_tb.Active :=true;
end;

function TForm1.get_sub_id(parentid:string;parentjb:integer;var new_id:string): boolean;
begin
  result:=false;
  with qu_temp do begin
    close;
    sql.Clear ;
    sql.Add(' select MAX(mid) as mid from material where  mid like :id and mjb=:jb');
    parambyname('id').asstring  :=parentid+ '%';
    parambyname('jb').asinteger :=parentjb+ 1;
    open;
    if fieldbyname('mid').asstring<>'' then
      result:= get_inc36_id(fieldbyname('mid').asstring,new_id);
  end;
end;

function TForm1.get_inc36_id(old_id: string;var sub_id: string): boolean;
var
        last_len:integer;
        step_sub_id,ttt:string;
        max_n:int64;
begin
        //将id按规则递增1
        last_len:=(sjjb+1)*3;
        max_n:=max_number(last_len);
        result:=step_n36(old_id,max_n,sub_id);
//        if result then step_sub_id:=fill(step_sub_id,'0',last_len,0)
        if result then fill(sub_id,'0',last_len,0,sub_id)
        else sub_id:=old_id+'000';
end;

function TForm1.max_number(layer_len: integer): int64;
var restr:string;
begin
        fill('','Z',layer_len,0,restr);
        result:=n36_number(restr);
end;

function TForm1.step_n36(old_n36:string;max_number:int64;var step_n36:string):boolean;
var
        step_number:int64;
begin
        step_number:=n36_number(old_n36)+1;
        result:=(step_number<=max_number);
        if result then  step_n36:=number_n36(step_number)
        else step_n36:='';
end;

function TForm1.n36_number(N36: string): int64;
var
        i,N36len:integer;
        values:int64;
begin
        values:=0;
        N36len:=length(N36);
        for i:=1 to N36len do begin
                values:=values+n_36_power(n36bit_number(N36[i]),N36len-i);
        end;
        result:=values;
end;

function TForm1.n_36_power(number, power_36_n: integer): int64;
var
        i:integer;
        values:int64;
begin
        if number <> 0 then begin
                values:=1;
                for i:=1 to power_36_n do
                        values:=values*36;
                result:=number*values;
        end else result:=0;
end;

function TForm1.n36bit_number(n36bit:Char):integer;
begin
        result:=0;
        case ord(n36bit) of
                48:result:=0;//0
                49:result:=1;//1
                50:result:=2;//2
                51:result:=3;//3
                52:result:=4;//4
                53:result:=5;//5
                54:result:=6;//6
                55:result:=7;//7
                56:result:=8;//8
                57:result:=9;//9
                65:result:=10;//A
                66:result:=11;//B
                67:result:=12;//C
                68:result:=13;//D
                69:result:=14;//E
                70:result:=15;//F
                71:result:=16;//G
                72:result:=17;//H
                73:result:=18;//I
                74:result:=19;//J
                75:result:=20;//K
                76:result:=21;//L
                77:result:=22;//M
                78:result:=23;//N
                79:result:=24;//O
                80:result:=25;//P
                81:result:=26;//Q
                82:result:=27;//R
                83:result:=28;//S
                84:result:=29;//T
                85:result:=30;//U
                86:result:=31;//V
                87:result:=32;//W
                88:result:=33;//X
                89:result:=34;//Y
                90:result:=35;//Z
        end;
end;

procedure TForm1.Edit1Change(Sender: TObject);
begin
  qu_tb.Filter :='';
  qu_tb.Filtered :=false;
  if trim(edit1.Text)<>'' then
  begin
    fstr:=TRIM(edit1.Text)+'*';
    qu_tb.Filter :='mid= '+QuotedStr(fstr);
    qu_tb.Filtered :=true;
  end;
end;

procedure TForm1.Edit1Exit(Sender: TObject);
begin
  if trim(edit1.Text)<>'' then
  begin
    fstr:=TRIM(edit1.Text)+'*';
    qu_tb.Filter :='mid= '+QuotedStr(fstr);
    qu_tb.Filtered :=true;
  end;
end;

//填充字符串   str 原串  fill填充串 len生成串长度 filltype填充方式(0前面 1后面)
function tform1.fill(oldstr:string; fchar:char; len:integer; ftype:integer; var restr: string):boolean;
begin
        result:=false;
        if oldstr='' then restr:='';
        if strlen(pchar(oldstr))>=len then restr:=oldstr
        else begin
                case ftype of
                        0 : restr :=stringofchar(fchar, len - length(oldstr)) + oldstr;
                        1 : restr :=oldstr + stringofchar(fchar, len - strlen(pchar(oldstr)));
                end;
        end;
        result:=true;
end;

function tform1.number_n36(number: int64): string;
var
        values,temp:int64;
        n36:string;
begin
        n36:='';
        values:=number;
        while values>=36 do begin
                temp:=values div 36;
                n36:=NUMBER_N36BIT(integer(values-temp*36))+n36;
                values:=temp;
        end;
        result:=NUMBER_N36BIT(values)+n36;
end;

function n_36_power(number, power_36_n: integer): int64;
var     i:integer;
        values:int64;
begin
        if number <> 0 then begin
                values:=1;
                for i:=1 to power_36_n do
                        values:=values*36;
                result:=number*values;
        end else result:=0;
end;

function tform1.NUMBER_N36BIT(NUMBER: integer):Char;
begin
        if number in [0..35] then result:=N36_char[number]
        else result:='0';
end;


procedure TForm1.FormShow(Sender: TObject);
begin
  with qu_tb do begin
    close;
    sql.Clear ;
    sql.Add('select * from material where mmx<>1 order by mid');
    open;
  end;
end;

end.