在delphi中XLSReadWriteII.组件的应用实例（2）
第三方组件：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.
在delphi中XLSReadWriteII.组件的应用实例（2）的更多相关文章
- 在delphi中XLSReadWriteII.组件的应用实例（1）
第三方组件:XLSReadWriteII.v.5.20.67_XE3 实例源码如下: unit Unit1; interface uses Winapi.Windows, Winapi.Message ...
- Delphi中For In 语法应用实例
一.遍历 TStrings var List: TStrings; s: string; begin List := TStringList.Create; List.CommaText := 'aa ...
- EhLib DBGridEh组件在Delphi中应用全攻略总结（转）
EhLib DBGridEh组件在Delphi中应用全攻略总结(转) http://blog.sina.com.cn/s/blog_94b1b40001013xn0.html 优化SQL查询:如何写出 ...
- delphi 从 TWebbrowse组件中获取图片
在 delphi 中使用 TWebbrowse 组件,虽然效率不如用(idhttp之类)模拟操作效率高.但其难度低,上手快,简单粗暴有效. 从网上搜到的处理此问题的文章大多是 ctrl + c 复制到 ...
- Delphi中Tlist实例
http://blog.163.com/jiandande3218@126/blog/static/74728469201132721428194/ Delphi中Tlist实例 2011-04-27 ...
- 第七十七篇：ref引用(在vue中引用组件实例)
好家伙, 为方便理解, 我们先来写一个经典自增一按钮, 再加上一个count清零按钮, Left.vue组件中: <template> <div > <h1>我是L ...
- delphi列表视图组件(TListView)使用方法|实例
TListView 组件以多种形式显示列表的项目,如详细资料.小图标.大图标等形式表示列表中的项目. 列表视图与用TListBox 组件实现的列表框非常相似.不同的是,列表视图可以让用户选择不同 ...
- Delphi中使用比较少的一些语法
本文是为了加强记忆而写,这里写的大多数内容都是在编程的日常工作中使用频率不高的东西,但是又十分重要. ---Murphy 1,构造和析构函数: a,构造函数: 一般基于TComponent组件的派生类 ...
- 谈Delphi中SSL协议的应用（好多相关文章）
摘要:本文主要介绍如何在Delphi中使用SSL协议.一共分为七个部分:(1)SSL协议是什么?(2)Delphi中如何使用SSL协议?(3)SSL客户端编程实例.(4)SSL服务端编程实例.(5)S ...
随机推荐
- Atom+latex+中文环境
最近在写论文,的路上.很多idea都受限于官方给的模板不能够添加自己即时的中文idea,所以添加中文到文献中很有必要,这里记录自己添加中文的几个小步骤 1. 受限将atom中的latex packag ...
- SpringBoot下如何配置实现跨域请求？
一.什么是跨域请求? 跨域请求,就是说浏览器在执行脚本文件的ajax请求时,脚本文件所在的服务地址和请求的服务地址不一样.说白了就是ip.网络协议.端口都一样的时候,就是同一个域,否则就是跨域.这是由 ...
- 安装jdk1.8
这是很普通的shell的脚本,只需要注意:echo 语句内出现的变量,需要转义! #!/bin/bash function get_current_time_stamp(){ echo `date & ...
- LiquiBase 学习
preconditions mysql database is installed maven has been setted up properly add depedenceies apply p ...
- poj 3264 倍增 ST表
#include<iostream> #include<cmath> using namespace std; ; int a[maxn]; ]; ]; int quick(i ...
- Dynamics 365 CRM Free up storage 清理Dynamics 365 CRM的空间
Dynamics 365 CRM 的空间是要买的. 但是很多情况下用户可以去清理CRM从而达到给空间减重的方法 两大使用DB空间大的功能 1. Audit log 审计记录 审计记录是用来记录各个fi ...
- GradleUserGuide中文版 19)Plugins 20)插件规范 21)Java插件
https://blog.csdn.net/roymuste/article/details/51321881
- awk字符串操作（字符串链接、传入传出shell变量）
1.awk基础 awk的环境变量及其意义 https://blog.csdn.net/snowpay/article/details/52451718 linux awk命令详解 https:// ...
- centos下vi的用法大全
vi编辑器是所有Unix及Linux系统下标准的编辑器,它的强大不逊色于任何最新的文本编辑器,这里只是简单地介绍一下它的用法和一小部分指令.由于对Unix及Linux系统的任何版本,vi编辑器是完全相 ...
- 解决Kubelet Pod启动CreatePodSandbox或RunPodSandbox异常方法
新装Kubernetes,创建一个新Pod,启动Pod遇到CreatePodSandbox或RunPodSandbox异常.查看日志 # journalctl --since :: -u kubele ...