在delphi中XLSReadWriteII.组件的应用实例（2）

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ComCtrls,
  XLSSheetData5, XLSReadWriteII5, Xc12Utils5,
   Xml.xmldom, Xml.XMLIntf, Xml.Win.msxmldom,
  Xml.XMLDoc;

type
  TXMLLoader = class(TObject)
  private
    FXmlDoc: TXMLDocument;
    FRootNode: IXMLNode;

  public
    constructor Create();
    constructor destory();
    function readFromFile(filename: String): IXMLNode;
  end;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Edit1: TEdit;
    Label2: TLabel;
    Edit2: TEdit;
    Button1: TButton;
    ProgressBar1: TProgressBar;
    XLSReadWriteII51: TXLSReadWriteII5;
    xmldoc: TXMLDocument;
    Button2: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

  {$R *.dfm}

 { TXMLParser }
constructor TXMLLoader.Create;
begin
  inherited;
  FXmlDoc := TXMLDocument.Create(application);
end;

constructor TXMLLoader.destory;
begin
  FXmlDoc.Free;
end;

function TXMLLoader.readFromFile(filename: String): IXMLNode;
begin
  if assigned(FXmlDoc) then
  begin
    FXmlDoc.LoadFromFile(filename);
    FRootNode := FXmlDoc.DocumentElement;
    Result    := FRootNode;
  end;
end;


type
  TDelFlags = set of (dfDelBefore, dfDelAfter);


function Delstr(var ms: String; endstr: String; Flags: TDelFlags;
  bself: Boolean = True): String;
var
  l: Integer;
begin
  l := length(endstr);
  if dfDelBefore in Flags then
  begin
    if bself then
    begin
      Result := copy(ms, 1, pos(endstr, ms) + l - 1);
      Delete(ms, 1, pos(endstr, ms) + l - 1);
    end
    else
    begin
      Result := copy(ms, 1, pos(endstr, ms) - 1);
      Delete(ms, 1, pos(endstr, ms) - 1);
    end;
  end
  else
  begin
    if bself then
    begin
      Result := copy(ms, pos(endstr, ms), length(ms));
      Delete(ms, pos(endstr, ms), length(ms));
    end
    else
    begin
      Result := copy(ms, pos(endstr, ms) + l, length(ms));
      Delete(ms, pos(endstr, ms) + l, length(ms));
    end;
  end;
end;

function Matchstrings(Source, pattern: String): Boolean;
var
  pSource: array[0..255] of Char;
  pPattern: array[0..255] of Char;
  function MatchPattern(element, pattern: PChar): Boolean;
    function IsPatternWild(pattern: PChar): Boolean;
    begin
      Result := StrScan(pattern, ‘*‘)  nil;
      if not Result then
        Result := StrScan(pattern, ‘?‘)  nil;
    end;
  begin
    if 0 = StrComp(pattern, ‘*‘) then
      Result := True
    else if (element^ = Chr(0)) and (pattern^  Chr(0)) then
      Result := False
    else if element^ = Chr(0) then
      Result := True
    else
    begin
      case pattern^ of
        ‘*‘:
          if MatchPattern(element, @pattern[1]) then
            Result := True
          else
            Result := MatchPattern(@element[1], pattern);
          ‘?‘:
          Result := MatchPattern(@element[1], @pattern[1]);
        else
          if element^ = pattern^ then
            Result := MatchPattern(@element[1], @pattern[1])
          else
            Result := False;
      end;
    end;
  end;
begin
  StrPCopy(pSource, Source);
  StrPCopy(pPattern, pattern);
  Result := MatchPattern(pSource, pPattern);
end;



procedure FindFiles(ASourceDir, SearchFileType: String; var List: TStrings);
var
  FileRec: TSearchrec;
  Sour: String;
  xmlFile: String;
begin
  Sour := ASourceDir;
  if Sour[length(Sour)]  ‘\‘ then
    Sour := Sour + ‘\‘;
  if FindFirst(Sour + ‘*.*‘, faAnyfile, FileRec) = 0 then
    repeat
      if ((FileRec.Attr and faDirectory)  0) then
      begin
        if (FileRec.Name  ‘.‘) and (FileRec.Name  ‘..‘) then
        begin
          FindFiles(Sour + FileRec.Name, SearchFileType, List);
        end;
      end
      else
      begin

        if Matchstrings(LowerCase(FileRec.Name), SearchFileType) then
        begin
          xmlFile := changefileext(Sour + FileRec.Name, ‘.xml‘);
          renamefile(Sour + FileRec.Name, xmlFile);
          List.Add(xmlFile);
        end;
      end;
    until FindNext(FileRec)  0;
  FindClose(FileRec);
end;


procedure reNameForFiles(Files: TStrings);
var
  i: Integer;
begin
  for i := 0 to Files.Count - 1 do
  begin
    renamefile(Files[i], changefileext(Files[i], ‘.ocr‘));
  end;
end;

function  getValueFromRowChars(row:IXMLNode):string;
var
  i: Integer;
  charNode: IXMLNode;
begin
    result:=‘‘;
    for i := 0 to row.ChildNodes.Count-1 do
    begin
         charNode:=row.ChildNodes[i];
         if vartostr(charNode.Attributes[‘Code‘])‘‘ then
         begin
            result:=result+vartostr(charNode.Attributes[‘Code‘]);
         end;
    end;
end;

function checkEmpty(list:TStringList;index:Integer):boolean;
var
  strline2: string;
begin
      strline2:=trim(list.Strings[index]);
      delstr(strline2,‘|‘,[dfdelafter]);
      result:=false;
      if ‘‘=trim(strline2) then  result:=true;
end;

function getRowByInvoiceCode(xls:TXLSReadWriteII5;InvoiceCode:string):integer;
var curCol:integer;
  iRow: Integer;
begin
   curCol:=3;
   result:=-1;
   for iRow := 1 to xls.MaxRowCount do
   begin
     if trim(InvoiceCode)= trim(xls[0].AsString[curCol,iRow]) then
     begin
        result:=iRow;
        break;
     end;
   end;
end;

function getRealDataNum(list:TStringList):integer;
var
  i: Integer;
  sline: string;
begin
     result:=0;
     for i := 0 to list.Count-1 do
     begin
          sline:=trim(list[i]);
          delstr(sline,‘|‘,[dfdelafter]);
          if ‘‘sline then  inc(result);
     end;
end;


procedure filterList(var list:TStringList);
var
  i: Integer;
   slist:TStringList;
begin
    slist:=TStringList.Create;
    try
    for i := 0 to list.Count-1 do
    begin
       if  pos(‘|‘, trim(list[i]))=1 then
        begin

        end
        else
        begin
           slist.Add(list[i]);
        end;
    end;

     list.Clear ;
     list.Assign(slist);
    finally
       slist.Free;
    end;

end;


procedure TForm1.Button1Click(Sender: TObject);
var
  xmlFiles: TStrings;
  XLS3: TXLSReadWriteII5;
  i: Integer;
  xmlFile: String;
  MLR: TXMLLoader;
  rootNode: IXMLNode;
  TextNodesList: IXMLNodeList;
  j: Integer;
  TextNodeName: string;
  numOfText:integer;
  RowNodeList: IXMLNodeList;
  Invoice_code: string;
  GoodsName: string;
  ColNum: Integer;
  specification: string;
  unitValue: string;
  NumValue: string;
  MoneyValue: string;
  TaxRate: string;
  TaxMoney: string;
  enterpriseName: string;
  tmpName: string;
  rowNum:integer;
  resultList:TStringList;
  tmpList: TStringList;
  curRow: Integer;
  k: Integer;
  trueDataNum: Integer;
  m: Integer;
  oldRowNum: Integer;
begin

  if not directoryExists(edit1.Text) then
  begin
       showmessage(‘请输入发票OCR文件所在的路径！‘);
       edit1.Clear ;
       exit;
  end;

  if not fileExists(edit2.Text) then
  begin
       showmessage(‘请输入xls文件的完整路径！‘);
       edit2.SetFocus ;
       exit;
  end;


  button1.Caption:=‘正在提取‘;
  button1.Enabled:=false; button2.Enabled:=false;
  xmlFiles := TStringList.Create;
  FindFiles(Edit1.Text, ‘*.ocr‘, xmlFiles);

  ProgressBar1.Position := 0;
  ProgressBar1.Max := xmlFiles.Count;

  numOfText:=0; ColNum:=7; rowNum:=0;

  resultList:=TStringList.Create;
  XLS3 := TXLSReadWriteII5.Create(nil);
  MLR := TXMLLoader.Create;

  tmpList:=TStringList.Create ;
  tmpList.StrictDelimiter:=true;

  try
    XLS3.LoadFromFile(edit2.Text);

    for i := 0 to xmlFiles.Count - 1 do
    begin
      ProgressBar1.Position := i + 1;
      application.ProcessMessages;

      xmlFile := xmlFiles[i];
      rootNode := MLR.readFromFile(xmlFile);
      TextNodesList := rootNode.ChildNodes;

      if ‘PAGE‘ = AnsiUpperCase(rootNode.NodeName) then
      begin
          numOfText:=0; rowNum:=0;
          resultList.Clear ; enterpriseName:=‘‘;
          Invoice_Code:=‘‘; GoodsName:=‘‘; specification:=‘‘; unitValue:=‘‘;
          NumValue:=‘‘; MoneyValue:=‘‘;TaxRate:=‘‘; TaxMoney:=‘‘;
          for j := 0 to TextNodesList.Count-1 do
           begin
                TextNodeName:= TextNodesList[j].NodeName;
                RowNodeList:=TextNodesList[j].ChildNodes;

                if ‘TEXT‘=ansiuppercase(TextNodeName) then
                begin
                     inc(numOfText);
                     if numOfText=1 then
                     begin
                         //发票代码
                         if RowNodeList.Count>0 then
                           Invoice_Code:=getValueFromRowChars(RowNodeList[0]);
                     end
                     else
                     begin
                        if numOfText>1 then
                        begin
                          if (numofText+(ColNum-1))-ColNum=1 then
                          begin //货物品名
                              if RowNodeList.Count>0 then
                              GoodsName:=trim(getValueFromRowChars(RowNodeList[0]));
                          end;

                          if (numofText+(ColNum-1))-ColNum=2 then
                          begin    //规格型号
                              if RowNodeList.Count>0 then
                              begin
                                 specification:=trim(getValueFromRowChars(RowNodeList[0]));
                              end;
                          end;

                          if (numofText+(ColNum-1))-ColNum=3 then
                          begin    //单位

                              if RowNodeList.Count>0 then
                              begin
                                 unitValue:=trim(getValueFromRowChars(RowNodeList[0]));
                              end;
                          end;

                          if (numofText+(ColNum-1))-ColNum=4 then
                          begin    //数量
                              if RowNodeList.Count>0 then
                              begin
                                 NumValue:=trim(getValueFromRowChars(RowNodeList[0]));
                              end;
                          end;

                          if (numofText+(ColNum-1))-ColNum=5 then
                          begin    //金额
                              if RowNodeList.Count>0 then
                              begin
                                 MoneyValue:=trim(getValueFromRowChars(RowNodeList[0]));
                              end;
                          end;

                          if (numofText+(ColNum-1))-ColNum=6 then
                          begin    //税率
                              if RowNodeList.Count>0 then
                              begin
                                 TaxRate:=trim(getValueFromRowChars(RowNodeList[0]));
                              end;
                          end;

                          if (numofText+(ColNum-1))-ColNum=7 then
                          begin    //税额
                              if RowNodeList.Count>0 then
                              begin
                                 TaxMoney:=trim(getValueFromRowChars(RowNodeList[0]));
                              end;
                          end;
                        end;  //numOfText>1
                     end;
                end;//TEXT end

                if TextNodesList.Count=j+1 then
                begin
                    //最后一个  销方企业名称
                    //最后一行
                    if RowNodeList.Count>0 then
                     begin
                        enterpriseName:= getValueFromRowChars(RowNodeList[0]);
                      //  showmessage(enterpriseName);
                     end;

                   GoodsName:=‘‘; specification:=‘‘; unitValue:=‘‘;  NumValue:=‘‘; MoneyValue:=‘‘;TaxRate:=‘‘; TaxMoney:=‘‘;
                end;

                if numofText mod 8=0 then
                begin   //第一行
                  {  showmessage(
                     slinebreak+‘发票代码=‘+Invoice_Code
                     +slinebreak+‘货物品名=‘+GoodsName
                     +slinebreak+‘规格型号=‘+specification
                     +slinebreak+‘单位=‘+unitValue
                     +slinebreak+‘数量=‘+NumValue
                     +slinebreak+‘金额=‘+MoneyValue
                     +slinebreak+‘税率=‘+TaxRate
                     +slinebreak+‘税额=‘+TaxMoney
                    );}

                     numofText:=1;
                     inc(rowNum);
                     resultList.Add(GoodsName+‘|‘+specification+‘|‘+unitValue+‘|‘+NumValue+‘|‘+MoneyValue+‘|‘+TaxRate+‘|‘+TaxMoney);
                     GoodsName:=‘‘; specification:=‘‘; unitValue:=‘‘;  NumValue:=‘‘; MoneyValue:=‘‘;TaxRate:=‘‘; TaxMoney:=‘‘;
                end ;
           end;//for j end
      end; //PAGE end

      trueDataNum:=0; curRow:=0;

      XLS3.Version:=xvExcel2007;


      if resultList.Count>1 then
      begin
              
              tmpList.Clear ;
              tmpList.Delimiter:=‘|‘;

             curRow:=0;
             curRow:= getRowByInvoiceCode(XLS3,Invoice_Code);

             if curRow0 then
             begin
                  trueDataNum:=getRealDataNum(resultList);

                  if trueDataNum>1 then
                  begin
                     Memo1.Lines.Add(‘-----------‘+Invoice_Code+‘在‘+inttostr(curRow)+‘行后插入‘+inttostr(trueDataNum-1)+‘行---------------‘);
                     Memo1.Lines.Add(resultList.Text);
                     application.ProcessMessages ;

                     XLS3[0].InsertRows(curRow+1,trueDataNum-1);  //一次性插入全部需要新增的行  （在插入新时会报错！）

                  end;


                  XLS3[0].AsString[9, curRow]:=enterpriseName; //销方企业名称

                  for m := 1 to trueDataNum-1 do
                  begin
                      XLS3[0].AsString[9, curRow+m]:=enterpriseName; //销方企业名称 新增的
                  end;
                  oldRowNum:=0;
                  oldRowNum:=curRow;

                 // showmessage(resultList.Text);

                   filterList(resultList);   //过滤掉整行内容为空的


                  if (1=resultList.Count) then
                  begin

                      tmpList.DelimitedText:=resultList[0];
                   //  showmessage(resultList[0]);

                      if ( (‘‘=trim(tmpList[4])) and (‘‘=trim(tmpList[5])) and (‘‘=trim(tmpList[6]))) then
                      begin
                          XLS3[0].AsString[10, curRow]:=tmpList[0]; //货物品名
                          XLS3[0].AsString[11, curRow]:=tmpList[1]; //规格型号
                          XLS3[0].AsString[12, curRow]:=tmpList[2]; //单位
                          if ‘‘=trim(tmpList[3]) then
                          else
                             XLS3[0].AsFloat[13, curRow]:=strtofloatdef(tmpList[3],0); //数量
                      end
                      else
                      begin
                            XLS3[0].AsString[10, curRow]:=tmpList[0]; //货物品名
                            XLS3[0].AsString[11, curRow]:=tmpList[1]; //规格型号
                            XLS3[0].AsString[12, curRow]:=tmpList[2]; //单位

                            if ‘‘=trim(tmpList[3]) then
                            else
                              XLS3[0].AsFloat[13, curRow]:=strtofloatdef(tmpList[3],0); //数量

                            XLS3[0].AsFloat[14, curRow]:=strtofloatdef(tmpList[4],0.0); //金额
                            XLS3[0].AsString[15, curRow]:=tmpList[5]; //税率
                            XLS3[0].AsFloat[16, curRow]:=strtofloatdef(tmpList[6],0.0); //税额
                      end;

                  end
                  else
                  begin
                     if resultList.Count>1 then
                     begin
                          for k := 0 to resultList.Count-1 do
                          begin
                                tmpList.DelimitedText:=resultList[k];

                                 if oldRowNum0

             XLS3.SaveToFile(edit2.Text);
             resultList.Clear ;
      end;



end;   //for i end

    if ProgressBar1.Max = ProgressBar1.Position then
    begin
         ShowMessage(‘处理完毕!‘);  button1.Caption:=‘开始提取‘;
    end;

  finally
    button1.Enabled:=true; button2.Enabled:=true;
    MLR.Free;
    freeandnil(tmpList);
    freeandnil(resultList);
    reNameForFiles(xmlFiles);
    FreeAndNil(xmlFiles);
    XLS3.Free;
  end;
end;



procedure TForm1.Button2Click(Sender: TObject);
begin
edit1.Clear ;
edit2.Clear ;
edit1.SetFocus ;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 memo1.Clear ;
end;

end.