Delphi, Export HTML table to Excel - html

Question

All I want to do is to implement "Export to excel" option of a classical webbrowser, to Delphi2007 commands...... When I am using this option from a webbrowser to export a 12000 rows table it takes less than a minute to export the table from any web browser from windows. Trying to implement this in Delphi using 2D Array it takes 10 minutes... Trying to implement the export with parsing technique (Stringlists, strings, Pos(tr), pos (td) & some other string functions) it takes a long... Hence, which are the commands of a webbrowser to export an html table to excel that I have to convert them to Delphi? Should I use javascript inside Delphi? Should I use pointers? Should I use HTML entities? xml?...Any ideas? Thank you in advance.
2D ARRAY
Excel:= CreateOleObject('Excel.Application');
ovTable := WebBrowser1.OleObject.Document.all.tags('TABLE').item(0);
arrayn:=VarArrayCreate([1, ovTable.Rows.Length, 1, ovTable.Rows.Item(1).Cells.Length], varvariant);
for i:=0 to (ovTable.Rows.Length - 1) do
begin
for j := 0 to (ovTable.Rows.Item(i).Cells.Length - 1) do
Begin
arrayn[i+1, j+1]:=ovTable.Rows.Item(i).Cells.Item(j).InnerText;
Application.ProcessMessages;
end;end;
WS.range[ws.cells[1, 1], ws.cells[ovTable.Rows.Length, ovTable.Rows.Item(1).Cells.Length]].value:=arrayn;
Excel.WorkBooks[1].SaveAs(directorylistbox1.Directory+'\'+'test.xlsx');
WS := Excel.WorkBooks.close;
Excel.quit;
Excel:=unassigned;
HTML PARSING
function HTMLCleanUp(L : string) : string;
const
CSVTempSeparator = #255; //replaced by a comma
CRLF = #13#10;
var
P1,P2 : integer;
begin
P1 := Pos('<',L); //clean-up anything between <>
while (P1>0) do //WHILE1
begin
P2 := Pos('>',L);
if (P2>0)
then Begin Delete(L,P1,P2-P1+1); end;
P1 := Pos('<',L);
end; //WHILE1
L:=StringReplace(L,' ','-',[rfReplaceAll]);
L:=StringReplace(L,'-01','',[rfReplaceAll]);
L:=StringReplace(L,'-02','',[rfReplaceAll]);
L:=StringReplace(L,'-03','',[rfReplaceAll]);
Result := Trim(L);
end;
function HTMLTableToCSV(HTML,CSV : TStringList) : boolean;
const
CRLF = #13#10;
CSVTempSeparator = #9;
var
P1,P2,P3,P4, p5, P6, p11, p22 : integer;
S,TmpStr,CSVStr : string;
begin
Result := True;
S := Trim(StringReplace(HTML.Text,CRLF,'',[rfReplaceAll]));
P1 := PosEx('<TR',S, 1); //CASE SENSITIVE , TR->FIRST ROW
CSVStr := '';
while (P1>0) do //while1
begin
P2 := PosEx('</TR',S, P1);
if (P2>0) //if1
then begin
TmpStr := Copy(S,P1,P2-P1+1);
//Delete(S,P1,P2-P1+1);
CSVStr := ''; p11:=1;p22:=1;
P11 := PosEx('<TH',TmpStr,1);
while (P11>0) do //while2
begin
P22 := PosEx('</TH',TmpStr, P11);
if (P22>0) //if2
then begin
CSVStr :=
//CSVStr+Trim(Copy(TmpStr,P1+4,P2-P1-4));//+CSVTempSeparator;
CSVStr+Trim(Copy(TmpStr,P11,P22-P11))+CSVTempSeparator;
//Delete(TmpStr,P1,P2-P1+1);
end //if2
else begin
Result := False;
Exit;
end; //if2
P11 := PoseX('<TH',TmpStr, P22);
end; //while2
P11 := PosEx('<TD',TmpStr, 1);
while (P11>0) do //while2
begin
P22 := PosEx('</TD',TmpStr, P11);
if (P22>0) //if2
then begin
CSVStr :=
//CSVStr+Trim(Copy(TmpStr,P1+4,P2-P1-4));//+CSVTempSeparator;
CSVStr+Trim(Copy(TmpStr,P11,P22-P11))+CSVTempSeparator;
//Delete(TmpStr,P1,P2-P1+1);
end //if2
else begin
Result := False;
Exit;
end; //if2
P11 := PosEx('<TD',TmpStr,P22);
end; //while2
end //if1
else begin
Result:=false;
exit;
end; //if1
CSV.Add(HTMLCleanUp(CSVStr));
P1 := PosEx('<TR',S,P2); //CASE SENSITIVE
end; //while1
end;
procedure TForm11.Button1Click(Sender: TObject);
const
xlExcel7 = $00000027;
TmpFileName='c:\test\Test.txt';
VAR
Excel: Olevariant;
HTMLStrList,CSVSTRList : TStringList;
begin
HTMLStrList := TStringList.Create;
try
HTMLStrList.LoadFromFile('C:\test\TestTable1.htm');
CSVSTRList := TStringList.Create;
try
if HTMLTableToCSV(HTMLStrList,CSVSTRList)
then Begin
CSVSTRList.SaveToFile(TmpFileName);
Excel:= CreateOleObject('Excel.Application');
Excel.WorkBooks.opentext(TmpFileName);//OPEN TXT WITH EXCEL
Excel.DisplayAlerts := False;
Excel.WorkBooks[1].SaveAs('c:\test\Nisa.xls', xlExcel7);//SAVE TAB DELIMITED TEXT FILE
Excel.WorkBooks[1].close;
Excel.quit;
Excel:=unassigned;
End
else ShowMessage('Error converting HTML table to CSV');
finally
CSVSTRList.Free;
end;
finally
HTMLStrList.Free;
DeleteFile(TmpFileName);
end;
end;
procedure TForm11.FormCreate(Sender: TObject);
begin
webBrowser1.Navigate('http://samples.msdn.microsoft.com/workshop/samples/author/tables/HTML_ Table.htm');
end;
procedure TForm11.WebBrowser1DocumentComplete(ASender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
var
Document: IHtmlDocument2;
CurWebrowser : IWebBrowser;
TopWebBrowser: IWebBrowser;
WindowName : string;
begin
CurWebrowser := pDisp as IWebBrowser;
TopWebBrowser := (ASender as TWebBrowser).DefaultInterface;
if CurWebrowser=TopWebBrowser then
begin
document := webbrowser1.document as IHtmlDocument2;
memo3.lines.add(trim(document.body.innerhtml)); // to get html
ShowMessage('Document is complete.')
end;
end;
end.

Answer 1

I found the solution...HTML Table Parsing in Less than a second!
function HTMLCleanUp(L : string) : string;
var
P1,P2 : integer;
begin
P1 := Pos('<',L); //clean-up anything between <>
while (P1>0) do //WHILE1
begin
P2 := Pos('>',L);
if (P2>0)
then Begin Delete(L,P1,P2-P1+1); end;
P1 := Pos('<',L);
end; //WHILE1
L:=StringReplace(L,' ','-',[rfReplaceAll]);
Result := Trim(L);
end;
procedure TForm11.WB_SaveAs_HTML(WB : TWebBrowser; const FileName : string) ;
var
PersistStream: IPersistStreamInit;
Stream: IStream;
FileStream: TFileStream;
begin
if not Assigned(WB.Document) then
begin
ShowMessage('Document not loaded!') ;
Exit;
end;
PersistStream := WB.Document as IPersistStreamInit;
FileStream := TFileStream.Create(FileName, fmCreate) ;
try
Stream := TStreamAdapter.Create(FileStream, soReference) as IStream;
if Failed(PersistStream.Save(Stream, True)) then ShowMessage('SaveAs HTML fail!') ;
finally
FileStream.Free;
end;
end; (* WB_SaveAs_HTML *)
procedure TForm11.Button1Click(Sender: TObject);
const
xlExcel7 = $00000027;
TmpFileName='c:\test\xxxx.txt';
CRLF = #13#10;
CSVTempSeparator = #9; //#255; //replaced by a comma
ADPNEWHOTURL = 'http://samples.msdn.microsoft.com/workshop/samples/author/tables/HTML_Table.htm';
VAR
Excel, WS: Olevariant;
P1,P2,P3,P4, p5, P6, p11, p22 : integer;
i, j: Integer;
buffer,rawHTM,TmpStr,CSVStr:string;
HTMFile : TextFile;
CSVSTRList : TStringList;
begin
CSVSTRList := TStringList.Create;
WB_SaveAs_HTML(WebBrowser1,TmpFileName) ;
AssignFile(HTMFile, TmpFileName);//read the HTML file
Reset(HTMFile);
while not EOF(HTMFile) do begin
ReadLn(HTMFile, buffer);
rawHTM := Concat(rawHTM, buffer);
end;
i:=1;j:=1;
rawHTM := Trim(StringReplace(rawHTM,CRLF,'',[rfReplaceAll]));
P1 := PosEx('<TR',rawHTM, 1); //CASE SENSITIVE , TR->FIRST ROW
while (P1>0) do //while1
begin
P2 := PosEx('</TR',rawHTM, P1);
if (P2>0) //if1
then begin
TmpStr := Copy(rawHTM,P1,P2-P1+1);
CSVStr := '';p11:=1;p22:=1;
P11 := PosEx('<TH',TmpStr,1);
while (P11>0) do //while2
begin
P22 := PosEx('</TH',TmpStr, P11);
if (P22>0) //if2
then begin
CSVStr :=CSVStr+
HTMLCleanUp(Trim(Copy(TmpStr,P11,P22-P11)))+CSVTempSeparator; j:=j+1;
end //if2
else begin
Exit;
end; //if2
P11 := PoseX('<TH',TmpStr, P22);
end; //while2
P11 := PosEx('<TD',TmpStr, 1);
while (P11>0) do //while2
begin
P22 := PosEx('</TD',TmpStr, P11);
if (P22>0) //if2
then begin
CSVStr :=CSVStr+
HTMLCleanUp(Trim(Copy(TmpStr,P11,P22-P11)))+CSVTempSeparator; j:=j+1;
end //if2
else begin
Exit;
end; //if2
P11 := PosEx('<TD',TmpStr,P22);
end; //while2
end //if1
else begin
exit;
end; //if1
CSVSTRList.Add(CSVStr);
P1 := PosEx('<TR',rawHTM,P2); i:=i+1; j:=1; //CASE SENSITIVE
end; //while1
CSVSTRList.SaveToFile('c:\test\xxx2.txt');
Excel:= CreateOleObject('Excel.Application');
Excel.WorkBooks.opentext('c:\test\xxx2.txt');//OPEN TXT WITH EXCEL
Excel.visible := True;
CloseFile(HTMFile);
DeleteFile(TmpFileName);
end;