gobalexportexcel.pas

此程序是可以将数据库表中的数据导出转为EXCEL、也可将EXCEL中的数据导入至数据库的表中。

unit gobalExportExcel;

interface

uses ComObj,windows,Messages, SysUtils, Variants,UnitSelectWorkSheet,
    Controls,Classes,DBClient,Forms;

const
  xlCSV = $00000006;


function MsgBox(StrText, StrCaption: String; Flags: Longint): Integer;  //消息
function GetFileName(StrAppPath,StrName:String):String;
//将excel文件转换成CSV文件
function ExportExceltoCSVFile(StrFile,StrAppPath:String):String;
function CheckCSVText(tmpL:TStrings):String;
//转换文本到数据集合中
//返回数据集合的各列最大长度和匹配的数据类型
function GenToTextDataSet(tmpL:TStrings;tmpCDS:TClientDataSet):String;
function GenText(tmpText:String):String;
function GetTextCount(tmpText:String):Boolean;
//创建字段配置文件
function CreateFieldNameDataSet(tmpCDS:TClientDataSet):Boolean;


implementation

uses DB;
function MsgBox(StrText, StrCaption: String; Flags: Longint): Integer;
begin
  if length(StrCaption)<=0 then
    StrCaption:='导入Excel'
  else
    StrCaption:='导入Excel-'+Strcaption;
  if flags=-1 then
    flags:=MB_OK +MB_ICONINFORMATION;
  result:=Application.MessageBox(pchar(StrText),pChar(StrCaption),Flags);
end;

function GetFileName(StrAppPath,StrName:String):String;
var
  i:integer;
  Strs:String;
begin
  Strs:=StrAppPath+StrName+'.TXT';
  i:=0;
  while   FileExists(Strs) do
  begin
    Strs:=StrAppPath+StrName+InttoStr(i)+'.TXT';
    inc(i);
  end;
  Result:=Strs;
end;
function ExportExceltoCSVFile(StrFile,StrAppPath:String):String;
var
  ExcelApp:Variant;
  WorkSheetCount:Integer;
  i,SelectIndex:integer;
  StrName:String;
  tmpL:TStrings;
begin
  try
    ExcelApp:=CreateOleObject('Excel.Application');
  except
    MsgBox('连接excel错误','提示信息',MB_OK+MB_ICONWARNING);
    exit;
  end;
  try
    ExcelApp.Workbooks.Open(Strfile); ////打开指定的EXCEL 文件
  except
    MsgBox('打开excel文件错误','提示信息',MB_OK+MB_ICONWARNING);
    ExcelApp.quit;
    exit;
  end;
  try
    WorkSheetCount:=ExcelApp.WorkSheets.count;
    SelectIndex:=1;
    if WorkSheetCount>1 then
    try
      FrmSelectWorkSheet:=TFrmSelectWorkSheet.Create(nil);
      FrmSelectWorkSheet.ComboBox1.Clear;
      for i:=1 to WorkSheetCount do
        FrmSelectWorkSheet.ComboBox1.Items.Add(ExcelApp.WorkSheets[i].Name);
      if FrmSelectWorkSheet.ShowModal=mrok then
        SelectIndex:=1+FrmSelectWorkSheet.ComboBox1.Items.IndexOf(FrmSelectWorkSheet.ComboBox1.Text)
      else
        SelectIndex:=0;
    finally
      FrmSelectWorkSheet.Free;
    end;
    if SelectIndex=0 then
      Result:=''
    else
    begin
      StrName:=ExcelApp.WorkSheets[SelectIndex].Name;
      StrName:=GetFileName(StrAppPath,StrName);
      ExcelApp.WorkSheets[SelectIndex].saveas(StrName,xlCSV);
      ExcelApp.ActiveWorkBook.saved:=true;
      ExcelApp.ActiveWorkBook.close;
      tmpl:=TStringList.Create;
      try
        tmpL.LoadFromFile(StrName);
        DeleteFile(StrName);
      finally
        Result:=tmpL.Text;
        tmpL.Free;
      end;
    end;
  finally
    ExcelApp.WorkBooks.Close;
    ExcelApp.quit;
  end;
end;
function CheckCSVText(tmpL:TStrings):String;
var
  m,i,k:integer;
  tmps:String;
  tmpss:TStrings;
begin
  tmpss:=TStringList.Create;
  try
    for m:=0 to tmpL.Count-1 do
    begin
      tmps:=tmpL.Strings[m];
      k:=0;
      for i:=1 to Length(tmps) do
      if (tmps[i]<>',') AND (tmps[i]<>' ') then
      begin
        tmpss.Add(tmps);
        break;
      end;
    end;
  finally
    Result:=tmpss.Text;
    tmpss.free;
  end;
end;
function GetTextCount(tmpText:String):boolean;
var
  i:integer;
  m:integer;
begin
  m:=0;
  for i:=1 to length(tmptext) do
  if tmpText[i]='"' then
    inc(m);
  Result:=(m mod 2)=0;  //偶数
end;
function GenText(tmpText:String):String;
var
  i,m:integer;
  tmpss:TStrings;
  StrOldLeft,StrLeft,StrRight:String;
  tmpStr:String;
begin
  tmpss:=TStringList.Create;
  try
    StrOldLeft:='';
    i:=pos(',',tmpText);
    while i>0 do
    begin
      StrLeft:=copy(tmpText,1,i-1);
      if GetTextCount(StrOldLeft+StrLeft) then
      begin
        //如果含有双引号
        tmpStr:=StrOldLeft+StrLeft;
        if pos('"',tmpStr)>0 then
        begin
          if tmpStr[1]='"' then
            tmpStr:=copy(tmpStr,2,length(tmpStr)-1);
          if tmpStr[length(tmpStr)]='"' then
            tmpStr:=copy(tmpStr,1,length(tmpStr)-1);
          {m:=pos('""',tmpStr);
          while m>0 do
          begin
            tmpStr:=copy(tmpStr,1,m)+copy(tmpStr,m+1,length(tmpStr)-m-1);
            m:=pos('""',tmpStr);
          end;
          }
        end;
        tmpss.Add(tmpStr);
        StrOldLeft:='';
      end
      else
        StrOldLeft:=StrOldLeft+StrLeft+',';
      tmpText:=copy(tmpText,i+1,length(tmpText)-i);
      i:=pos(',',tmpText);
    end;
    //去处双引号
  finally
    Result:=tmpss.Text;
  end;
end;
//转换文本到数据集合中
function GenToTextDataSet(tmpL:TStrings;tmpCDS:TClientDataSet):String;
var
  i,j,m:Integer;
  tmpLines:TStrings;
  tmpLen:TStrings;   //记录列的长度和类型0:String,1:int;2:float;3:float
  tmptext:String;
begin
  tmpLines:=TStringList.Create;
  tmpLen:=TStringList.Create;
  try
    for i:=0 to tmpL.Count-1 do
    begin
      tmptext:=tmpL.Strings[i];
      tmpLines.Text:=GenText(tmptext);
      if i=0 then
      begin
        for j:=0 to tmpLines.Count-1 do
          tmpLen.Add(inttoStr(length(tmpLines.Strings[j])));   //记录长度
        //分解该字符串
        with tmpCDS do
        begin
          Close;
          FieldDefs.Clear;
          with FieldDefs.AddFieldDef do
          begin
            Name:='Checked';
            //DisplayName:='不导入';
            DataType:=ftBoolean;
          end;
          for j:=0 to  tmpLines.Count-1 do
          with FieldDefs.AddFieldDef do
          begin
            Name:='Items'+IntToStr(j);
            DataType:=ftString;
            Size:=200;
          end;
          CreateDataSet;
        end;
      end;
      //比较长度
      tmpCDS.Append;
      tmpCDS.fields[0].Value:=false;
      for j:=1 to tmpCDS.Fields.Count-1 do
      begin
        if (tmpLen.Count>=j) and (tmpLines.count>=j) then
        begin
          m:=Strtoint(tmpLen.Strings[j-1]);
          if m<length(tmpLines.Strings[j-1]) then
            tmpLen.Strings[j-1]:=inttoStr(length(tmpLines.Strings[j-1]));
        end;
        if (tmpLines.count>=j) then
          tmpCDS.fields[j].Value:=tmpLines.Strings[j-1];
      end;
      tmpCDS.Post;
    end;
  finally
    Result:=tmpLen.Text;
    tmpLines.Free;
    tmpLen.free;
  end;
end;
//创建字段配置文件
function CreateFieldNameDataSet(tmpCDS:TClientDataSet):Boolean;
begin
  with tmpCDS do
  begin
    IndexName:='';
    Close;
    FieldDefs.Clear;
    //excel字段名
    with FieldDefs.AddFieldDef do
    begin
      Name:='SFieldName';
      DataType:=ftString;
      Size:=20;
    end;
    //table字段名
    with FieldDefs.AddFieldDef do
    begin
      Name:='DFieldName';
      DataType:=ftString;
      Size:=20;
    end;
    with FieldDefs.AddFieldDef do
    begin
      Name:='DataType';
      DataType:=ftInteger;
    end;
    with FieldDefs.AddFieldDef do
    begin
      Name:='IsKey';
      DataType:=ftBoolean;
    end;
    with FieldDefs.AddFieldDef do
    begin
      Name:='SFieldvalue';
      DataType:=ftString;
      Size:=20;
    end;
    //table字段名
    with FieldDefs.AddFieldDef do
    begin
      Name:='DFieldvalue';
      DataType:=ftString;
      Size:=20;
    end;
    CreateDataSet;
  end;
end;
end.