在delphi中XLSReadWriteII.組件的應用實例（2）
阿新 • • 發佈：2017-10-16
ngs rms bool specific result ron function delete utils
第三方組件：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）