From 9ae9a3a768a0c7d713d4083d8f2ec4d1356769ee Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Mon, 18 Aug 2008 21:55:59 +0000 Subject: [PATCH] Refactor dataset2html/csv/xml routines: - Use TMemoryStreams for copy actions, TFileStreams for export actions. Should save some memory when saving to files and improves performance by factor ~100 on larger grid results. - Fetch text from the Grid.Text, not from the underlying TGridResult.Rows array. Fixes issue #685 . - Removes non functionial export of image files from BLOBs - Sanitize helpers function from GUI code (mousecursor, opening result file, ...) Todo: - Limit export to a user defined number of rows. Important for large tables. - Fetch entire TEXT field content, currently limited to 256 chars --- source/helpers.pas | 367 ++++++++++++++++++++------------------------- source/main.pas | 167 +++++++++++++-------- 2 files changed, 268 insertions(+), 266 deletions(-) diff --git a/source/helpers.pas b/source/helpers.pas index cbb83616..fb945f54 100644 --- a/source/helpers.pas +++ b/source/helpers.pas @@ -82,9 +82,9 @@ type function encrypt(str: String): String; function decrypt(str: String): String; function htmlentities(str: WideString): WideString; - function dataset2html(ds: TGridResult; htmltitle: WideString; filename: String = ''; ConvertHTMLEntities: Boolean = true; Generator: String = ''): Boolean; - function dataset2csv(ds: TGridResult; Separator, Encloser, Terminator: String; filename: String = ''): Boolean; - function dataset2xml(ds: TGridResult; title: WideString; filename: String = ''): Boolean; + procedure GridToHtml(Grid: TVirtualStringTree; Title: WideString; ConvertHTMLEntities: Boolean; S: TStream); + procedure GridToCsv(Grid: TVirtualStringTree; Separator, Encloser, Terminator: String; S: TStream); + procedure GridToXml(Grid: TVirtualStringTree; root: WideString; S: TStream); function esc2ascii(str: String): String; function StrCmpBegin(Str1, Str2: string): Boolean; function Max(A, B: Integer): Integer; assembler; @@ -135,11 +135,13 @@ type function GetDBObjectType( TableStatus: TFields ): Byte; procedure SetWindowSizeGrip(hWnd: HWND; Enable: boolean); procedure SaveUnicodeFile(Filename: String; Text: WideString); + function CreateUnicodeFileStream(Filename: String): TFileStream; procedure OpenTextFile(const Filename: String; out Stream: TFileStream; out FileCharset: TFileCharset); function GetFileCharset(Stream: TFileStream): TFileCharset; function ReadTextfileChunk(Stream: TFileStream; FileCharset: TFileCharset; ChunkSize: Int64 = 0): WideString; function ReadTextfile(Filename: String): WideString; procedure CopyToClipboard(Value: WideString); + procedure StreamToClipboard(S: TMemoryStream); var MYSQL_KEYWORDS : TStringList; @@ -729,235 +731,180 @@ begin end; +procedure ExportStatusMsg(Node: PVirtualNode; RootNodeCount: Cardinal; StreamSize: Int64); +begin + Mainform.Showstatus('Exporting row '+FormatNumber(Node.Index+1)+' of '+FormatNumber(RootNodeCount)+ + ' ('+IntToStr(Trunc((Node.Index+1) / RootNodeCount *100))+'%, '+FormatByteNumber(StreamSize)+')' + ); +end; + {*** - Converts a TDataSet to a HTML-Table. - If a filename is given, save HTML to disk, otherwise copy content to clipboard - - @param TDataSet Object which holds data to export + Converts a Grid to a HTML-Table. + @param Grid Object which holds data to export @param string Text used in - @param string Filename to use for saving. If not given, copy to clipboard. @param boolean Use htmlentities() on cell-contents? - @param string Generator, used for meta-tag in HTML-head - @return boolean True on access, False in case of any error } -function dataset2html(ds: TGridResult; htmltitle: WideString; filename: String = ''; ConvertHTMLEntities: Boolean = true; Generator: String = ''): Boolean; +procedure GridToHtml(Grid: TVirtualStringTree; Title: WideString; ConvertHTMLEntities: Boolean; S: TStream); var - I, J : Integer; - Buffer, cbuffer, data : Widestring; - blobfilename, extension : WideString; - bf : Textfile; - header, attribs : WideString; - tofile : Boolean; + i: Integer; + tmp, Data, Attribs, Generator: WideString; + Node: PVirtualNode; begin - tofile := filename <> ''; - try - buffer := '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">' + crlf + crlf + - '<html>' + crlf + - '<head>' + crlf + - ' <title>' + htmltitle + '' + crlf + - ' ' + crlf + - ' ' + crlf + - '' + crlf + crlf + - '' + crlf + crlf + - '

' + htmltitle + ' (' + inttostr(Length(ds.Rows)) + ' rows)

' + crlf + crlf + - '' + crlf + - ' ' + crlf; - for j:=0 to Length(ds.Columns)-1 do - buffer := buffer + ' ' + crlf; - buffer := buffer + ' ' + crlf; - - cbuffer := buffer; - - for I := 0 to Length(ds.Rows)-1 do - begin - Buffer := ' ' + crlf; - // collect data: - for j:=0 to Length(ds.Rows[i].Cells)-1 do - begin - data := ds.Rows[i].Cells[j].Text; - if tofile and ds.Columns[j].IsBlob then begin - header := copy(data, 0, 20); - extension := ''; - if pos('JFIF', header) <> 0 then - extension := 'jpg' - else if StrCmpBegin('GIF', header) then - extension := 'gif' - else if StrCmpBegin('BM', header) then - extension := 'bmp'; - if extension <> '' then begin - blobfilename := 'rec'+inttostr(i)+'fld'+inttostr(j)+'.'+extension; - AssignFile(bf, blobfilename); - Rewrite(bf); - Write(bf, data); - CloseFile(bf); - data := ''+blobfilename+' ('+floattostr(length(data) div 1024)+' KB)'; - end else begin - if ConvertHTMLEntities then data := htmlentities(data); - data := WideStringReplace(data, #10, #10+'
', [rfReplaceAll]); - end; - end else begin - if ConvertHTMLEntities then - data := htmlentities(data); - data := WideStringReplace(data, #10, #10+'
', [rfReplaceAll]); - end; - if ds.Rows[i].Cells[j].IsNull then - attribs := ' class="isnull"' - else begin - // Primary key field - attribs := ''; - if ds.Columns[j].IsPriPart then - attribs := ' class="pk"'; - end; - Buffer := Buffer + ' ' + data + '' + crlf; - end; - buffer := buffer + ' ' + crlf; - cbuffer := cbuffer + buffer; - end; - // footer: - buffer := '
' + crlf + crlf + '

' + crlf + - 'generated ' + datetostr(now) + ' ' + timetostr(now) + - ' by ' + Generator + '

' + crlf + crlf + - ''; - cbuffer := cbuffer + buffer; - if tofile then - SaveUnicodeFile(filename, cbuffer) - else - CopyToClipboard(cbuffer); - result := true; - except - on e: Exception do begin - MessageDlg(e.Message, mtError, [mbOK], 0); - result := false; - end; + Generator := APPNAME+' '+FullAppVersion; + tmp := '' + CRLF + CRLF + + '' + CRLF + + '' + CRLF + + ' ' + Title + '' + CRLF + + ' ' + CRLF + + ' ' + CRLF + + '' + CRLF + CRLF + + '' + CRLF + CRLF + + '' + CRLF + + ' ' + CRLF; + for i:=0 to Grid.Header.Columns.Count-1 do begin + if not (coVisible in Grid.Header.Columns[i].Options) then + continue; + tmp := tmp + ' ' + CRLF; end; - Screen.Cursor := crDefault; - // open file: - if tofile and FileExists(filename) then - ShellExec( filename ); + tmp := tmp + ' ' + CRLF; + S.Write(tmp[1], Length(tmp) * Sizeof(WideChar)); + + Node := Grid.GetFirst; + while Assigned(Node) do begin + if (Node.Index+1) mod 100 = 0 then + ExportStatusMsg(Node, Grid.RootNodeCount, S.Size); + tmp := ' ' + CRLF; + // collect data: + for i:=0 to Grid.Header.Columns.Count-1 do begin + // Skip hidden key columns + if not (coVisible in Grid.Header.Columns[i].Options) then + Continue; + Data := Grid.Text[Node, i]; + if ConvertHTMLEntities then + Data := htmlentities(Data); + Data := WideStringReplace(Data, #10, #10+'
', [rfReplaceAll]); + if Grid.Header.Columns[i].Alignment = taRightJustify then + Attribs := ' style="text-align: right;"' + else + Attribs := ''; + tmp := tmp + ' ' + Data + '' + CRLF; + end; + tmp := tmp + ' ' + CRLF; + S.Write(tmp[1], Length(tmp) * Sizeof(WideChar)); + Node := Grid.GetNext(Node); + end; + // footer: + tmp := '
' + CRLF + CRLF + '

' + CRLF + + 'generated ' + DateToStr(now) + ' ' + TimeToStr(now) + + ' by ' + Generator + '

' + CRLF + CRLF + + ''; + S.Write(tmp[1], Length(tmp) * Sizeof(WideChar)); + Mainform.Showstatus(STATUS_MSG_READY); end; {*** Converts a TDataSet to CSV-values. - If a filename is given, save CSV-data to disk, otherwise copy content to clipboard - - @param TDataSet Object which holds data to export + @param Grid Object which holds data to export @param string Field-separator @param string Field-encloser @param string Line-terminator - @param string Filename to use for saving. If not given, copy to clipboard. - @return boolean True on access, False in case of any error } -function dataset2csv(ds: TGridResult; Separator, Encloser, Terminator: String; filename: String = ''): Boolean; +procedure GridToCsv(Grid: TVirtualStringTree; Separator, Encloser, Terminator: String; S: TStream); var - I, J : Integer; - Buffer, cbuffer, val : WideString; - tofile : Boolean; + i: Integer; + tmp, Data: WideString; + Node: PVirtualNode; begin separator := esc2ascii(separator); encloser := esc2ascii(encloser); terminator := esc2ascii(terminator); - tofile := filename <> ''; - try - Buffer := ''; - // collect fields: - for j:=0 to Length(ds.Columns)-1 do begin - if j > 0 then - Buffer := Buffer + Separator; - Buffer := Buffer + Encloser + ds.Columns[J].Name + Encloser; - end; - cbuffer := cbuffer + buffer; - - // collect data: - for i:=0 to Length(ds.Rows)-1 do - begin - Buffer := ''; - Buffer := Buffer + Terminator; - for j:=0 to Length(ds.Rows[i].Cells)-1 do - begin - if j>0 then - Buffer := Buffer + Separator; - val := ds.Rows[i].Cells[j].Text; - if ds.Columns[j].IsFloat then val := FloatStr(val); - Buffer := Buffer + Encloser + val + Encloser; - end; - // write buffer: - cbuffer := cbuffer + buffer; - end; - if tofile then - SaveUnicodeFile(filename, cbuffer) - else - CopyToClipboard(cbuffer); - result := true; - except - on e: Exception do begin - MessageDlg(e.Message, mtError, [mbOK], 0); - result := false; - end; + tmp := ''; + // Columns + for i:=0 to Grid.Header.Columns.Count-1 do begin + // Skip hidden key columns + if not (coVisible in Grid.Header.Columns[i].Options) then + Continue; + if tmp <> '' then + tmp := tmp + Separator; + tmp := tmp + Encloser + Grid.Header.Columns[i].Text + Encloser; end; - Screen.Cursor := crDefault; + S.Write(tmp[1], Length(tmp) * Sizeof(WideChar)); + + // Data: + Node := Grid.GetFirst; + while Assigned(Node) do begin + if (Node.Index+1) mod 100 = 0 then + ExportStatusMsg(Node, Grid.RootNodeCount, S.Size); + tmp := Terminator; + for i:=0 to Grid.Header.Columns.Count-1 do begin + // Skip hidden key columns + if not (coVisible in Grid.Header.Columns[i].Options) then + Continue; + Data := Grid.Text[Node, i]; + // Unformat float values + if Grid.Header.Columns[i].Alignment = taRightJustify then + Data := FloatStr(Data); + tmp := tmp + Encloser + Data + Encloser + Separator; + end; + S.Write(tmp[1], Length(tmp) * Sizeof(WideChar)); + Node := Grid.GetNext(Node); + end; + Mainform.showstatus(STATUS_MSG_READY); end; {*** Converts a TDataSet to XML. - If a filename is given, save XML to disk, otherwise copy content to clipboard - - @param TDataSet Object which holds data to export + @param Grid Object which holds data to export @param string Text used as root-element - @param string Filename to use for saving. If not given, copy to clipboard. - @return boolean True on access, False in case of any error } -function dataset2xml(ds: TGridResult; title: WideString; filename: String = ''): Boolean; +procedure GridToXml(Grid: TVirtualStringTree; root: WideString; S: TStream); var - I, J : Integer; - Buffer, cbuffer, data : WideString; - tofile : Boolean; + i: Integer; + tmp, Data: WideString; + Node: PVirtualNode; begin - try - tofile := filename <> ''; - buffer := '' + crlf + crlf + - '<'+title+'>' + crlf; - cbuffer := buffer; + tmp := '' + CRLF + CRLF + + '<'+root+'>' + CRLF; + S.Write(tmp[1], Length(tmp) * Sizeof(WideChar)); - for i:=0 to Length(ds.Rows)-1 do - begin - Buffer := #9'' + crlf; - // collect data: - for j:=0 to Length(ds.Columns)-1 do - begin - data := ds.Rows[i].Cells[j].Text; - data := htmlentities(data); - Buffer := Buffer + #9#9'<'+ds.Columns[j].Name+'>' + data + '' + crlf; - end; - buffer := buffer + #9'' + crlf; - cbuffer := cbuffer + buffer; - end; - // footer: - cbuffer := cbuffer + '' + crlf; - if tofile then - SaveUnicodeFile(filename, cbuffer) - else - CopyToClipboard(cbuffer); - result := true; - except - on e: Exception do begin - MessageDlg(e.Message, mtError, [mbOK], 0); - result := false; + Node := Grid.GetFirst; + while Assigned(Node) do begin + if (Node.Index+1) mod 100 = 0 then + ExportStatusMsg(Node, Grid.RootNodeCount, S.Size); + tmp := #9'' + CRLF; + // Data: + for i:=0 to Grid.Header.Columns.Count-1 do begin + // Skip hidden key columns + if not (coVisible in Grid.Header.Columns[i].Options) then + Continue; + Data := Grid.Text[Node, i]; + // Unformat float values + if Grid.Header.Columns[i].Alignment = taRightJustify then + Data := FloatStr(Data) + else + Data := htmlentities(Data); + tmp := tmp + #9#9'<'+Grid.Header.Columns[i].Text+'>' + Data + '' + CRLF; end; + tmp := tmp + #9'' + CRLF; + S.Write(tmp[1], Length(tmp) * Sizeof(WideChar)); + Node := Grid.GetNext(Node); end; - Screen.Cursor := crDefault; + // footer: + tmp := '' + CRLF; + S.Write(tmp[1], Length(tmp) * Sizeof(WideChar)); + Mainform.showstatus(STATUS_MSG_READY); end; @@ -2283,17 +2230,21 @@ end; procedure SaveUnicodeFile(Filename: String; Text: WideString); var f: TFileStream; +begin + f := CreateUnicodeFileStream(Filename); + f.WriteBuffer(Pointer(Text)^, Length(Text) * 2); + f.Free; +end; + + +function CreateUnicodeFileStream(Filename: String): TFileStream; +var header: array[0..1] of Byte; begin header[0] := $FF; header[1] := $FE; - f := TFileStream.Create(Filename, fmCreate or fmOpenWrite); - try - f.WriteBuffer(header, 2); - f.WriteBuffer(Pointer(Text)^, Length(Text) * 2); - finally - f.Free; - end; + Result := TFileStream.Create(Filename, fmCreate or fmOpenWrite); + Result.WriteBuffer(header, 2); end; @@ -2545,6 +2496,20 @@ begin CB.AsWideString := Value; end; + +procedure StreamToClipboard(S: TMemoryStream); +var + Content: WideString; +begin + SetLength(Content, S.Size); + S.Position := 0; + S.Read(Pointer(Content)^, S.Size); + CopyToClipboard(Content); + // Free memory + SetString(Content, nil, 0); +end; + + initialization diff --git a/source/main.pas b/source/main.pas index b0c45848..513bcca2 100644 --- a/source/main.pas +++ b/source/main.pas @@ -959,26 +959,6 @@ begin end; -procedure TMainForm.actCopyAsCSVExecute(Sender: TObject); -begin - // Copy data in actual dataset as CSV - if ChildWin.PageControlMain.ActivePage = ChildWin.tabData then - dataset2csv(ChildWin.GetVisualDataset(), ChildWin.prefCSVSeparator, ChildWin.prefCSVEncloser, ChildWin.prefCSVTerminator) - else if ChildWin.PageControlMain.ActivePage = ChildWin.tabQuery then - dataset2csv(ChildWin.GetVisualDataset(), ChildWin.prefCSVSeparator, ChildWin.prefCSVEncloser, ChildWin.prefCSVTerminator); -end; - - -procedure TMainForm.actCopyAsHTMLExecute(Sender: TObject); -begin - // Copy data in actual dataset as HTML - if ChildWin.PageControlMain.ActivePage = ChildWin.tabData then - dataset2html(ChildWin.GetVisualDataset(), 'Result', '', ChildWin.prefConvertHTMLEntities, APPNAME + ' ' + FullAppVersion ) - else if ChildWin.PageControlMain.ActivePage = ChildWin.tabQuery then - dataset2html(ChildWin.GetVisualDataset(), 'Result', '', ChildWin.prefConvertHTMLEntities, APPNAME + ' ' + FullAppVersion); -end; - - procedure TMainForm.actPrintListExecute(Sender: TObject); var page : TTabSheet; @@ -1109,64 +1089,121 @@ begin ChildWin.ExecSqlClick(sender, false, true); end; -procedure TMainForm.actCopyAsXMLExecute(Sender: TObject); + +procedure TMainForm.actCopyAsCSVExecute(Sender: TObject); +var + S: TMemoryStream; begin - // Copy data in actual dataset as XML - if ChildWin.PageControlMain.ActivePage = ChildWin.tabData then - dataset2xml(ChildWin.GetVisualDataset(), ChildWin.SelectedTable) - else if ChildWin.PageControlMain.ActivePage = ChildWin.tabQuery then - dataset2xml(ChildWin.GetVisualDataset(), 'SQL-query'); + // Copy data in focused grid as CSV + Screen.Cursor := crHourglass; + S := TMemoryStream.Create; + try + GridToCsv(ChildWin.ActiveGrid, ChildWin.prefCSVSeparator, ChildWin.prefCSVEncloser, ChildWin.prefCSVTerminator, S); + StreamToClipboard(S); + finally + ShowStatus('Freeing data...'); + S.Free; + ShowStatus(STATUS_MSG_READY); + Screen.Cursor := crDefault; + end; +end; + + +procedure TMainForm.actCopyAsHTMLExecute(Sender: TObject); +var + S: TMemoryStream; + Title: WideString; +begin + // Copy data in focused grid as HTML table + Screen.Cursor := crHourglass; + S := TMemoryStream.Create; + if ChildWin.ActiveGrid = Childwin.DataGrid then Title := Childwin.SelectedTable + else Title := 'SQL query'; + try + GridToHtml(ChildWin.ActiveGrid, Title, ChildWin.prefConvertHTMLEntities, S); + StreamToClipboard(S); + finally + ShowStatus('Freeing data...'); + S.Free; + ShowStatus(STATUS_MSG_READY); + Screen.Cursor := crDefault; + end; +end; + + +procedure TMainForm.actCopyAsXMLExecute(Sender: TObject); +var + S: TMemoryStream; + Root: WideString; +begin + // Copy data in focused grid as XML + Screen.Cursor := crHourglass; + S := TMemoryStream.Create; + if ChildWin.ActiveGrid = Childwin.DataGrid then Root := Childwin.SelectedTable + else Root := 'SQL query'; + try + GridToXml(ChildWin.ActiveGrid, Root, S); + StreamToClipboard(S); + finally + ShowStatus('Freeing data...'); + S.Free; + ShowStatus(STATUS_MSG_READY); + Screen.Cursor := crDefault; + end; end; procedure TMainForm.actExportDataExecute(Sender: TObject); var - query : TGridResult; + Grid: TVirtualStringTree; + Dialog: TExportSaveDialog; + FS: TFileStream; + Title: WideString; begin // Save data in current dataset as CSV, HTML or XML + Dialog := ChildWin.SaveDialogExportData; - case ChildWin.PageControlMain.ActivePageIndex of - 3 : begin query := ChildWin.GetVisualDataset(){ZQuery2}; ChildWin.SaveDialogExportData.Filename := ChildWin.SelectedTable; end; - 4 : begin query := ChildWin.GetVisualDataset() {ZQuery1}; ChildWin.SaveDialogExportData.Filename := 'SQL-query'; end; - else - raise Exception.Create('Internal error: Cannot fetch query with no related active tab.'); - end; + Grid := Mainform.Childwin.ActiveGrid; + if Grid = Mainform.Childwin.DataGrid then + Title := ChildWin.SelectedTable + else + Title := 'SQL-query'; - with ChildWin.SaveDialogExportData do - begin - Title := 'Export result-set from '+Filename+'...'; - FieldSep := ChildWin.prefCSVSeparator; - LineSep := ChildWin.prefCSVTerminator; - FieldEncl := ChildWin.prefCSVEncloser; - ConvertHTMLSpecialChars := ChildWin.prefConvertHTMLEntities; + Dialog.FileName := Title; + Dialog.Title := 'Export result-set from '+Dialog.Filename+'...'; + Dialog.FieldSep := ChildWin.prefCSVSeparator; + Dialog.LineSep := ChildWin.prefCSVTerminator; + Dialog.FieldEncl := ChildWin.prefCSVEncloser; + Dialog.ConvertHTMLSpecialChars := ChildWin.prefConvertHTMLEntities; - - if Execute and (FileName <> '') then - begin - Screen.Cursor := crHourGlass; - case FilterIndex of - 1 : dataset2csv(query, FieldSep, FieldEncl, LineSep, Filename); - 2 : dataset2html(query, FileName, FileName, ConvertHTMLSpecialChars, APPNAME+' '+FullAppVersion); - 3 : dataset2xml(query, FileName, FileName); - end; - ChildWin.prefCSVSeparator := FieldSep; - ChildWin.prefCSVTerminator := LineSep; - ChildWin.prefCSVEncloser := FieldEncl; - ChildWin.prefConvertHTMLEntities := ConvertHTMLSpecialChars; - with TRegistry.Create do - begin - openkey(REGPATH, true); - WriteBool(REGNAME_CONVERTHTMLENTITIES, ConvertHTMLSpecialChars); - WriteString(REGNAME_CSV_SEPARATOR, FieldSep); - WriteString(REGNAME_CSV_ENCLOSER, FieldEncl); - WriteString(REGNAME_CSV_TERMINATOR, LineSep); - closekey(); - Free; - end; - Screen.Cursor := crDefault; + if Dialog.Execute and (Dialog.FileName <> '') then try + Screen.Cursor := crHourGlass; + FS := CreateUnicodeFileStream(Dialog.FileName); + case Dialog.FilterIndex of + 1: GridToCsv(Grid, Dialog.FieldSep, Dialog.FieldEncl, Dialog.LineSep, FS); + 2: GridToHtml(Grid, Title, Dialog.ConvertHTMLSpecialChars, FS); + 3: GridToXml(Grid, Title, FS); end; + ShowStatus('Freeing data...'); + FS.Free; + ShowStatus('Storing preferences...'); + ChildWin.prefCSVSeparator := Dialog.FieldSep; + ChildWin.prefCSVTerminator := Dialog.LineSep; + ChildWin.prefCSVEncloser := Dialog.FieldEncl; + ChildWin.prefConvertHTMLEntities := Dialog.ConvertHTMLSpecialChars; + with TRegistry.Create do begin + openkey(REGPATH, true); + WriteBool(REGNAME_CONVERTHTMLENTITIES, Dialog.ConvertHTMLSpecialChars); + WriteString(REGNAME_CSV_SEPARATOR, Dialog.FieldSep); + WriteString(REGNAME_CSV_ENCLOSER, Dialog.FieldEncl); + WriteString(REGNAME_CSV_TERMINATOR, Dialog.LineSep); + Closekey; + Free; + end; + finally + ShowStatus(STATUS_MSG_READY); + Screen.Cursor := crDefault; end; - end;