mirror of
https://github.com/HeidiSQL/HeidiSQL.git
synced 2025-08-26 11:17:57 +08:00
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
This commit is contained in:
Ansgar Becker
@ -82,9 +82,9 @@ type
|
|||||||
function encrypt(str: String): String;
|
function encrypt(str: String): String;
|
||||||
function decrypt(str: String): String;
|
function decrypt(str: String): String;
|
||||||
function htmlentities(str: WideString): WideString;
|
function htmlentities(str: WideString): WideString;
|
||||||
function dataset2html(ds: TGridResult; htmltitle: WideString; filename: String = ''; ConvertHTMLEntities: Boolean = true; Generator: String = ''): Boolean;
|
procedure GridToHtml(Grid: TVirtualStringTree; Title: WideString; ConvertHTMLEntities: Boolean; S: TStream);
|
||||||
function dataset2csv(ds: TGridResult; Separator, Encloser, Terminator: String; filename: String = ''): Boolean;
|
procedure GridToCsv(Grid: TVirtualStringTree; Separator, Encloser, Terminator: String; S: TStream);
|
||||||
function dataset2xml(ds: TGridResult; title: WideString; filename: String = ''): Boolean;
|
procedure GridToXml(Grid: TVirtualStringTree; root: WideString; S: TStream);
|
||||||
function esc2ascii(str: String): String;
|
function esc2ascii(str: String): String;
|
||||||
function StrCmpBegin(Str1, Str2: string): Boolean;
|
function StrCmpBegin(Str1, Str2: string): Boolean;
|
||||||
function Max(A, B: Integer): Integer; assembler;
|
function Max(A, B: Integer): Integer; assembler;
|
||||||
@ -135,11 +135,13 @@ type
|
|||||||
function GetDBObjectType( TableStatus: TFields ): Byte;
|
function GetDBObjectType( TableStatus: TFields ): Byte;
|
||||||
procedure SetWindowSizeGrip(hWnd: HWND; Enable: boolean);
|
procedure SetWindowSizeGrip(hWnd: HWND; Enable: boolean);
|
||||||
procedure SaveUnicodeFile(Filename: String; Text: WideString);
|
procedure SaveUnicodeFile(Filename: String; Text: WideString);
|
||||||
|
function CreateUnicodeFileStream(Filename: String): TFileStream;
|
||||||
procedure OpenTextFile(const Filename: String; out Stream: TFileStream; out FileCharset: TFileCharset);
|
procedure OpenTextFile(const Filename: String; out Stream: TFileStream; out FileCharset: TFileCharset);
|
||||||
function GetFileCharset(Stream: TFileStream): TFileCharset;
|
function GetFileCharset(Stream: TFileStream): TFileCharset;
|
||||||
function ReadTextfileChunk(Stream: TFileStream; FileCharset: TFileCharset; ChunkSize: Int64 = 0): WideString;
|
function ReadTextfileChunk(Stream: TFileStream; FileCharset: TFileCharset; ChunkSize: Int64 = 0): WideString;
|
||||||
function ReadTextfile(Filename: String): WideString;
|
function ReadTextfile(Filename: String): WideString;
|
||||||
procedure CopyToClipboard(Value: WideString);
|
procedure CopyToClipboard(Value: WideString);
|
||||||
|
procedure StreamToClipboard(S: TMemoryStream);
|
||||||
|
|
||||||
var
|
var
|
||||||
MYSQL_KEYWORDS : TStringList;
|
MYSQL_KEYWORDS : TStringList;
|
||||||
@ -729,235 +731,180 @@ begin
|
|||||||
end;
|
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.
|
Converts a Grid to a HTML-Table.
|
||||||
If a filename is given, save HTML to disk, otherwise copy content to clipboard
|
@param Grid Object which holds data to export
|
||||||
|
|
||||||
@param TDataSet Object which holds data to export
|
|
||||||
@param string Text used in <title>
|
@param string Text used in <title>
|
||||||
@param string Filename to use for saving. If not given, copy to clipboard.
|
|
||||||
@param boolean Use htmlentities() on cell-contents?
|
@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
|
var
|
||||||
I, J : Integer;
|
i: Integer;
|
||||||
Buffer, cbuffer, data : Widestring;
|
tmp, Data, Attribs, Generator: WideString;
|
||||||
blobfilename, extension : WideString;
|
Node: PVirtualNode;
|
||||||
bf : Textfile;
|
|
||||||
header, attribs : WideString;
|
|
||||||
tofile : Boolean;
|
|
||||||
begin
|
begin
|
||||||
tofile := filename <> '';
|
Generator := APPNAME+' '+FullAppVersion;
|
||||||
try
|
tmp := '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" ' + CRLF +
|
||||||
buffer := '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">' + crlf + crlf +
|
' "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">' + CRLF + CRLF +
|
||||||
'<html>' + crlf +
|
'<html>' + CRLF +
|
||||||
'<head>' + crlf +
|
'<head>' + CRLF +
|
||||||
' <title>' + htmltitle + '</title>' + crlf +
|
' <title>' + Title + '</title>' + CRLF +
|
||||||
' <meta name="GENERATOR" content="'+ Generator + '">' + crlf +
|
' <meta name="GENERATOR" content="'+ Generator + '">' + CRLF +
|
||||||
' <style type="text/css">' + crlf +
|
' <style type="text/css">' + CRLF +
|
||||||
' tr#header {background-color: ActiveCaption; color: CaptionText;}' + crlf +
|
' tr#header {background-color: ActiveCaption; color: CaptionText;}' + CRLF +
|
||||||
' th, td {vertical-align: top; font-family: "'+Mainform.Childwin.DataGrid.Font.Name+'"; font-size: '+IntToStr(Mainform.Childwin.DataGrid.Font.Size)+'pt; padding: 0.5em; }' + crlf +
|
' th, td {vertical-align: top; font-family: "'+Grid.Font.Name+'"; font-size: '+IntToStr(Grid.Font.Size)+'pt; padding: '+IntToStr(Grid.TextMargin-1)+'px; }' + CRLF +
|
||||||
' table, td {border: 1px solid silver;}' + crlf +
|
' table, td {border: 1px solid silver;}' + CRLF +
|
||||||
' table {border-collapse: collapse;}' + crlf +
|
' table {border-collapse: collapse;}' + CRLF +
|
||||||
' td.isnull {background-color: '+TColorToHex(COLOR_NULLVALUE) +'}' + crlf +
|
' </style>' + CRLF +
|
||||||
' td.pk {background-color: #EEEEEE; font-weight: bold;}' + crlf +
|
'</head>' + CRLF + CRLF +
|
||||||
' </style>' + crlf +
|
'<body>' + CRLF + CRLF +
|
||||||
'</head>' + crlf + crlf +
|
'<table caption="' + Title + ' (' + inttostr(Grid.RootNodeCount) + ' rows)">' + CRLF +
|
||||||
'<body>' + crlf + crlf +
|
' <tr id="header">' + CRLF;
|
||||||
'<h3>' + htmltitle + ' (' + inttostr(Length(ds.Rows)) + ' rows)</h3>' + crlf + crlf +
|
for i:=0 to Grid.Header.Columns.Count-1 do begin
|
||||||
'<table >' + crlf +
|
if not (coVisible in Grid.Header.Columns[i].Options) then
|
||||||
' <tr id="header">' + crlf;
|
continue;
|
||||||
for j:=0 to Length(ds.Columns)-1 do
|
tmp := tmp + ' <th style="width:'+IntToStr(Grid.Header.Columns[i].Width)+'px">' + Grid.Header.Columns[i].Text + '</th>' + CRLF;
|
||||||
buffer := buffer + ' <th>' + ds.Columns[j].Name + '</th>' + crlf;
|
|
||||||
buffer := buffer + ' </tr>' + crlf;
|
|
||||||
|
|
||||||
cbuffer := buffer;
|
|
||||||
|
|
||||||
for I := 0 to Length(ds.Rows)-1 do
|
|
||||||
begin
|
|
||||||
Buffer := ' <tr>' + 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 := '<a href="'+blobfilename+'"><img border="0" src="'+blobfilename+'" alt="'+blobfilename+' ('+floattostr(length(data) div 1024)+' KB)" width="100" /></a>';
|
|
||||||
end else begin
|
|
||||||
if ConvertHTMLEntities then data := htmlentities(data);
|
|
||||||
data := WideStringReplace(data, #10, #10+'<br>', [rfReplaceAll]);
|
|
||||||
end;
|
|
||||||
end else begin
|
|
||||||
if ConvertHTMLEntities then
|
|
||||||
data := htmlentities(data);
|
|
||||||
data := WideStringReplace(data, #10, #10+'<br>', [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 + ' <td'+attribs+'>' + data + '</td>' + crlf;
|
|
||||||
end;
|
|
||||||
buffer := buffer + ' </tr>' + crlf;
|
|
||||||
cbuffer := cbuffer + buffer;
|
|
||||||
end;
|
|
||||||
// footer:
|
|
||||||
buffer := '</table>' + crlf + crlf + '<p>' + crlf +
|
|
||||||
'<em>generated ' + datetostr(now) + ' ' + timetostr(now) +
|
|
||||||
' by <a href="'+APPDOMAIN+'">' + Generator + '</a></em></p>' + crlf + crlf +
|
|
||||||
'</body></html>';
|
|
||||||
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;
|
|
||||||
end;
|
end;
|
||||||
Screen.Cursor := crDefault;
|
tmp := tmp + ' </tr>' + CRLF;
|
||||||
// open file:
|
S.Write(tmp[1], Length(tmp) * Sizeof(WideChar));
|
||||||
if tofile and FileExists(filename) then
|
|
||||||
ShellExec( filename );
|
Node := Grid.GetFirst;
|
||||||
|
while Assigned(Node) do begin
|
||||||
|
if (Node.Index+1) mod 100 = 0 then
|
||||||
|
ExportStatusMsg(Node, Grid.RootNodeCount, S.Size);
|
||||||
|
tmp := ' <tr>' + 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+'<br>', [rfReplaceAll]);
|
||||||
|
if Grid.Header.Columns[i].Alignment = taRightJustify then
|
||||||
|
Attribs := ' style="text-align: right;"'
|
||||||
|
else
|
||||||
|
Attribs := '';
|
||||||
|
tmp := tmp + ' <td'+Attribs+'>' + Data + '</td>' + CRLF;
|
||||||
|
end;
|
||||||
|
tmp := tmp + ' </tr>' + CRLF;
|
||||||
|
S.Write(tmp[1], Length(tmp) * Sizeof(WideChar));
|
||||||
|
Node := Grid.GetNext(Node);
|
||||||
|
end;
|
||||||
|
// footer:
|
||||||
|
tmp := '</table>' + CRLF + CRLF + '<p>' + CRLF +
|
||||||
|
'<em>generated ' + DateToStr(now) + ' ' + TimeToStr(now) +
|
||||||
|
' by <a href="'+APPDOMAIN+'">' + Generator + '</a></em></p>' + CRLF + CRLF +
|
||||||
|
'</body></html>';
|
||||||
|
S.Write(tmp[1], Length(tmp) * Sizeof(WideChar));
|
||||||
|
Mainform.Showstatus(STATUS_MSG_READY);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
{***
|
{***
|
||||||
Converts a TDataSet to CSV-values.
|
Converts a TDataSet to CSV-values.
|
||||||
If a filename is given, save CSV-data to disk, otherwise copy content to clipboard
|
@param Grid Object which holds data to export
|
||||||
|
|
||||||
@param TDataSet Object which holds data to export
|
|
||||||
@param string Field-separator
|
@param string Field-separator
|
||||||
@param string Field-encloser
|
@param string Field-encloser
|
||||||
@param string Line-terminator
|
@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
|
var
|
||||||
I, J : Integer;
|
i: Integer;
|
||||||
Buffer, cbuffer, val : WideString;
|
tmp, Data: WideString;
|
||||||
tofile : Boolean;
|
Node: PVirtualNode;
|
||||||
begin
|
begin
|
||||||
separator := esc2ascii(separator);
|
separator := esc2ascii(separator);
|
||||||
encloser := esc2ascii(encloser);
|
encloser := esc2ascii(encloser);
|
||||||
terminator := esc2ascii(terminator);
|
terminator := esc2ascii(terminator);
|
||||||
tofile := filename <> '';
|
|
||||||
|
|
||||||
try
|
tmp := '';
|
||||||
Buffer := '';
|
// Columns
|
||||||
// collect fields:
|
for i:=0 to Grid.Header.Columns.Count-1 do begin
|
||||||
for j:=0 to Length(ds.Columns)-1 do begin
|
// Skip hidden key columns
|
||||||
if j > 0 then
|
if not (coVisible in Grid.Header.Columns[i].Options) then
|
||||||
Buffer := Buffer + Separator;
|
Continue;
|
||||||
Buffer := Buffer + Encloser + ds.Columns[J].Name + Encloser;
|
if tmp <> '' then
|
||||||
end;
|
tmp := tmp + Separator;
|
||||||
cbuffer := cbuffer + buffer;
|
tmp := tmp + Encloser + Grid.Header.Columns[i].Text + Encloser;
|
||||||
|
|
||||||
// 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;
|
|
||||||
end;
|
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;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
{***
|
{***
|
||||||
Converts a TDataSet to XML.
|
Converts a TDataSet to XML.
|
||||||
If a filename is given, save XML to disk, otherwise copy content to clipboard
|
@param Grid Object which holds data to export
|
||||||
|
|
||||||
@param TDataSet Object which holds data to export
|
|
||||||
@param string Text used as root-element
|
@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
|
var
|
||||||
I, J : Integer;
|
i: Integer;
|
||||||
Buffer, cbuffer, data : WideString;
|
tmp, Data: WideString;
|
||||||
tofile : Boolean;
|
Node: PVirtualNode;
|
||||||
begin
|
begin
|
||||||
try
|
tmp := '<?xml version="1.0"?>' + CRLF + CRLF +
|
||||||
tofile := filename <> '';
|
'<'+root+'>' + CRLF;
|
||||||
buffer := '<?xml version="1.0"?>' + crlf + crlf +
|
S.Write(tmp[1], Length(tmp) * Sizeof(WideChar));
|
||||||
'<'+title+'>' + crlf;
|
|
||||||
cbuffer := buffer;
|
|
||||||
|
|
||||||
for i:=0 to Length(ds.Rows)-1 do
|
Node := Grid.GetFirst;
|
||||||
begin
|
while Assigned(Node) do begin
|
||||||
Buffer := #9'<row>' + crlf;
|
if (Node.Index+1) mod 100 = 0 then
|
||||||
// collect data:
|
ExportStatusMsg(Node, Grid.RootNodeCount, S.Size);
|
||||||
for j:=0 to Length(ds.Columns)-1 do
|
tmp := #9'<row>' + CRLF;
|
||||||
begin
|
// Data:
|
||||||
data := ds.Rows[i].Cells[j].Text;
|
for i:=0 to Grid.Header.Columns.Count-1 do begin
|
||||||
data := htmlentities(data);
|
// Skip hidden key columns
|
||||||
Buffer := Buffer + #9#9'<'+ds.Columns[j].Name+'>' + data + '</'+ds.Columns[j].Name+'>' + crlf;
|
if not (coVisible in Grid.Header.Columns[i].Options) then
|
||||||
end;
|
Continue;
|
||||||
buffer := buffer + #9'</row>' + crlf;
|
Data := Grid.Text[Node, i];
|
||||||
cbuffer := cbuffer + buffer;
|
// Unformat float values
|
||||||
end;
|
if Grid.Header.Columns[i].Alignment = taRightJustify then
|
||||||
// footer:
|
Data := FloatStr(Data)
|
||||||
cbuffer := cbuffer + '</'+title+'>' + crlf;
|
else
|
||||||
if tofile then
|
Data := htmlentities(Data);
|
||||||
SaveUnicodeFile(filename, cbuffer)
|
tmp := tmp + #9#9'<'+Grid.Header.Columns[i].Text+'>' + Data + '</'+Grid.Header.Columns[i].Text+'>' + CRLF;
|
||||||
else
|
|
||||||
CopyToClipboard(cbuffer);
|
|
||||||
result := true;
|
|
||||||
except
|
|
||||||
on e: Exception do begin
|
|
||||||
MessageDlg(e.Message, mtError, [mbOK], 0);
|
|
||||||
result := false;
|
|
||||||
end;
|
end;
|
||||||
|
tmp := tmp + #9'</row>' + CRLF;
|
||||||
|
S.Write(tmp[1], Length(tmp) * Sizeof(WideChar));
|
||||||
|
Node := Grid.GetNext(Node);
|
||||||
end;
|
end;
|
||||||
Screen.Cursor := crDefault;
|
// footer:
|
||||||
|
tmp := '</'+root+'>' + CRLF;
|
||||||
|
S.Write(tmp[1], Length(tmp) * Sizeof(WideChar));
|
||||||
|
Mainform.showstatus(STATUS_MSG_READY);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
@ -2283,17 +2230,21 @@ end;
|
|||||||
procedure SaveUnicodeFile(Filename: String; Text: WideString);
|
procedure SaveUnicodeFile(Filename: String; Text: WideString);
|
||||||
var
|
var
|
||||||
f: TFileStream;
|
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;
|
header: array[0..1] of Byte;
|
||||||
begin
|
begin
|
||||||
header[0] := $FF;
|
header[0] := $FF;
|
||||||
header[1] := $FE;
|
header[1] := $FE;
|
||||||
f := TFileStream.Create(Filename, fmCreate or fmOpenWrite);
|
Result := TFileStream.Create(Filename, fmCreate or fmOpenWrite);
|
||||||
try
|
Result.WriteBuffer(header, 2);
|
||||||
f.WriteBuffer(header, 2);
|
|
||||||
f.WriteBuffer(Pointer(Text)^, Length(Text) * 2);
|
|
||||||
finally
|
|
||||||
f.Free;
|
|
||||||
end;
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
@ -2545,6 +2496,20 @@ begin
|
|||||||
CB.AsWideString := Value;
|
CB.AsWideString := Value;
|
||||||
end;
|
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
|
initialization
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
167
source/main.pas
167
source/main.pas
@ -959,26 +959,6 @@ begin
|
|||||||
end;
|
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);
|
procedure TMainForm.actPrintListExecute(Sender: TObject);
|
||||||
var
|
var
|
||||||
page : TTabSheet;
|
page : TTabSheet;
|
||||||
@ -1109,64 +1089,121 @@ begin
|
|||||||
ChildWin.ExecSqlClick(sender, false, true);
|
ChildWin.ExecSqlClick(sender, false, true);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TMainForm.actCopyAsXMLExecute(Sender: TObject);
|
|
||||||
|
procedure TMainForm.actCopyAsCSVExecute(Sender: TObject);
|
||||||
|
var
|
||||||
|
S: TMemoryStream;
|
||||||
begin
|
begin
|
||||||
// Copy data in actual dataset as XML
|
// Copy data in focused grid as CSV
|
||||||
if ChildWin.PageControlMain.ActivePage = ChildWin.tabData then
|
Screen.Cursor := crHourglass;
|
||||||
dataset2xml(ChildWin.GetVisualDataset(), ChildWin.SelectedTable)
|
S := TMemoryStream.Create;
|
||||||
else if ChildWin.PageControlMain.ActivePage = ChildWin.tabQuery then
|
try
|
||||||
dataset2xml(ChildWin.GetVisualDataset(), 'SQL-query');
|
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;
|
end;
|
||||||
|
|
||||||
|
|
||||||
procedure TMainForm.actExportDataExecute(Sender: TObject);
|
procedure TMainForm.actExportDataExecute(Sender: TObject);
|
||||||
var
|
var
|
||||||
query : TGridResult;
|
Grid: TVirtualStringTree;
|
||||||
|
Dialog: TExportSaveDialog;
|
||||||
|
FS: TFileStream;
|
||||||
|
Title: WideString;
|
||||||
begin
|
begin
|
||||||
// Save data in current dataset as CSV, HTML or XML
|
// Save data in current dataset as CSV, HTML or XML
|
||||||
|
Dialog := ChildWin.SaveDialogExportData;
|
||||||
|
|
||||||
case ChildWin.PageControlMain.ActivePageIndex of
|
Grid := Mainform.Childwin.ActiveGrid;
|
||||||
3 : begin query := ChildWin.GetVisualDataset(){ZQuery2}; ChildWin.SaveDialogExportData.Filename := ChildWin.SelectedTable; end;
|
if Grid = Mainform.Childwin.DataGrid then
|
||||||
4 : begin query := ChildWin.GetVisualDataset() {ZQuery1}; ChildWin.SaveDialogExportData.Filename := 'SQL-query'; end;
|
Title := ChildWin.SelectedTable
|
||||||
else
|
else
|
||||||
raise Exception.Create('Internal error: Cannot fetch query with no related active tab.');
|
Title := 'SQL-query';
|
||||||
end;
|
|
||||||
|
|
||||||
with ChildWin.SaveDialogExportData do
|
Dialog.FileName := Title;
|
||||||
begin
|
Dialog.Title := 'Export result-set from '+Dialog.Filename+'...';
|
||||||
Title := 'Export result-set from '+Filename+'...';
|
Dialog.FieldSep := ChildWin.prefCSVSeparator;
|
||||||
FieldSep := ChildWin.prefCSVSeparator;
|
Dialog.LineSep := ChildWin.prefCSVTerminator;
|
||||||
LineSep := ChildWin.prefCSVTerminator;
|
Dialog.FieldEncl := ChildWin.prefCSVEncloser;
|
||||||
FieldEncl := ChildWin.prefCSVEncloser;
|
Dialog.ConvertHTMLSpecialChars := ChildWin.prefConvertHTMLEntities;
|
||||||
ConvertHTMLSpecialChars := ChildWin.prefConvertHTMLEntities;
|
|
||||||
|
|
||||||
|
if Dialog.Execute and (Dialog.FileName <> '') then try
|
||||||
if Execute and (FileName <> '') then
|
Screen.Cursor := crHourGlass;
|
||||||
begin
|
FS := CreateUnicodeFileStream(Dialog.FileName);
|
||||||
Screen.Cursor := crHourGlass;
|
case Dialog.FilterIndex of
|
||||||
case FilterIndex of
|
1: GridToCsv(Grid, Dialog.FieldSep, Dialog.FieldEncl, Dialog.LineSep, FS);
|
||||||
1 : dataset2csv(query, FieldSep, FieldEncl, LineSep, Filename);
|
2: GridToHtml(Grid, Title, Dialog.ConvertHTMLSpecialChars, FS);
|
||||||
2 : dataset2html(query, FileName, FileName, ConvertHTMLSpecialChars, APPNAME+' '+FullAppVersion);
|
3: GridToXml(Grid, Title, FS);
|
||||||
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;
|
|
||||||
end;
|
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;
|
||||||
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user