第三方组件：XLSReadWriteII.v.5.20.67_XE3
实例源码如下：
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
//最后一个<text> 销方企业名称
//最后一行
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 curRow<0 then
begin
Memo1.Lines.Add('错误：在'+changefileext(xmlFiles[i],'.ocr')+'找不到发票代码 '+Invoice_Code);
end; if curRow>0 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 oldRowNum<curRow then
begin XLS3[0].AsString[0, curRow]:=XLS3[0].AsString[0, oldRowNum];
XLS3[0].AsString[1, curRow]:=XLS3[0].AsString[1, oldRowNum];
XLS3[0].AsString[2, curRow]:=XLS3[0].AsString[2, oldRowNum];
XLS3[0].AsString[3, curRow]:=XLS3[0].AsString[3, oldRowNum]; XLS3[0].AsString[4, curRow]:=XLS3[0].AsString[4, oldRowNum];
XLS3[0].AsString[5, curRow]:=XLS3[0].AsString[5, oldRowNum];
XLS3[0].AsString[6, curRow]:=XLS3[0].AsString[6, oldRowNum];
XLS3[0].AsString[7, curRow]:=XLS3[0].AsString[7, oldRowNum];
XLS3[0].AsString[8, curRow]:=XLS3[0].AsString[8, oldRowNum]; end; 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); //税额 if oldRowNum<curRow then
begin XLS3[0].AsString[17, curRow]:=XLS3[0].AsString[17, oldRowNum];
XLS3[0].AsString[18, curRow]:=XLS3[0].AsString[18, oldRowNum];
XLS3[0].AsString[19, curRow]:=XLS3[0].AsString[19, oldRowNum];
XLS3[0].AsString[20, curRow]:=XLS3[0].AsString[20, oldRowNum]; XLS3[0].AsString[21, curRow]:=XLS3[0].AsString[21, oldRowNum];
XLS3[0].AsString[22, curRow]:=XLS3[0].AsString[22, oldRowNum];
XLS3[0].AsString[23, curRow]:=XLS3[0].AsString[23, oldRowNum]; end; // sleep(50);
application.ProcessMessages ;
curRow:=curRow+1; //行数加1 end; //for k end
end;
end; end;//curRow>0 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.