Is there a way to assign a multiline string value in Delphi without having to quote each line?
Edit (the specific problem): I have some SQL queries which I want to test outside Delphi. When copying the queries it is a bit of overhead to add and replace quotes every time.
Here's code for an application you can add to the IDE's Tools menu that might help. It was posted a while back to one of the CodeGear newsgroups by TeamB member Peter Below:
program ClipToStringConst;
// Remove the dot from the line below for a console app,
// per Rob Kennedy's comment. It works fine without being
// a console app.
{.$APPTYPE CONSOLE}
uses
Windows,
Classes,
Sysutils,
APIClipboard;
const
cIndent = ' '; // 2 spaces
cSingleQuote = '''';
EndChar : array [Boolean] of Char = ('+',';');
procedure Process;
var
SL: TStringlist;
i, max: Integer;
begin
if ClipboardHasFormat( CF_TEXT ) then
begin
SL := TStringlist.Create;
try
SL.Text := ClipboardAsString;
max := SL.count-1;
for i:= 0 to max do
SL[i] := cIndent +
AnsiQuotedStr( TrimRight(SL[i])+#32, cSingleQuote ) +
EndChar[i = max];
StringToClipboard( SL.Text );
finally
SL.Free;
end; { Finally }
end;
end;
begin
try
Process;
except
on E: Exception do
ShowException( E, ExceptAddr );
end;
end.
Just select the text in the SQL management tool after you've tested it and copy it to the clipboard. Switch to the Delphi Code Editor, place the insertion point where you want the constant text to appear, choose 'Clipboard To Const' or whatever you called it from the Tools menu, and then Ctrl+V to paste it into the editor.
It's a pretty handy little tool. You can also modify it to work the opposite way (ConstantToClipboard) to remove the source formatting and revert back to raw SQL, although I haven't bothered to do so yet.
EDIT: Missed a unit (APIClipboard). This needs to be a separate unit, obviously. Again, thanks to Peter Below:
{== Unit APIClipboard =================================================}
{: Clipboard access routines using only API functions
#author Dr. Peter Below
#desc Version 1.0 created 5 Juli 2000<BR>
Current revision 1.0<BR>
Last modified 5 Juli 2000<P>
This unit provides simply clipboard access routines that do not rely on
the VCL Clipbrd unit. That unit drags in Dialogs and Forms and a major
part of the VCL as a consequence, not appropriate for simple console
or non-form programs. This unit uses only API routines, the only VCL
units used are Classes (for exceptions and streams) and SysUtils.
}
{=====================================================================}
unit APIClipboard;
interface
uses
Windows, Classes;
procedure StringToClipboard( const S: String );
function ClipboardAsString: String;
procedure CopyDataToClipboard( fmt: DWORD; const data; datasize: Integer;
emptyClipboardFirst: Boolean = true );
procedure CopyDataFromClipboard( fmt: DWORD; S: TStream );
function ClipboardHasFormat( fmt: DWORD ): Boolean;
implementation
uses
Sysutils;
type
{: This is an internal exception class used by the <see unit=APIClipboard> }
EClipboardError = class( Exception )
public
constructor Create( const msg: String );
end;
resourcestring
eSystemOutOfMemory =
'could not allocate memory for clipboard data.';
eLockfailed =
'could not lock global memory handle.';
eSetDataFailed =
'could not copy data block to clipboard.';
eCannotOpenClipboard =
'could not open the clipboard.';
eErrorTemplate =
'APIClipboard: %s'#13#10+
'System error code: %d'#13#10+
'System error message: %s';
{-- EClipboardError.Create --------------------------------------------}
{: Creates a new EclipboardError object
#Param msg is the string to embed into the error message
#Precondition none
#Postcondition none
#desc Composes an error message that contains the passed message and the
API error code and matching error message. The CreateFmt constructor
inherited from the basic Exception class is used to do the work.
Created 5.7.2000 by P. Below
}{---------------------------------------------------------------------}
constructor EClipboardError.Create( const msg: String );
begin { Create }
CreateFmt( eErrorTemplate,
[msg, GetLastError, SysErrorMessage(GetLastError)] );
end; { EClipboardError.Create }
{-- DataToClipboard ---------------------------------------------------}
{: Copies a block of memory to the clipboard in a given format
#Param fmt is the clipboard format to use
#Param data is an untyped const parameter that addresses the data to copy
#Param datasize is the size of the data, in bytes
#Precondition The clipboard is already open. If not an EClipboardError
will result. This precondition cannot be asserted, unfortunately.
#Postcondition Any previously exisiting data of this format will have
been replaced by the new data, unless datasize was 0 or we run into an
exception. In this case the clipboard will be unchanged.
#desc Uses API methods to allocate and lock a global memory block of
approproate size, copies the data to it and submits the block to the
clipboard. Any error on the way will raise an EClipboardError
exception.<BR>
Created 5.7.2000 by P. Below
#Raises EClipboardError
}{---------------------------------------------------------------------}
procedure DataToClipboard( fmt: DWORD; Const data; datasize: Integer );
var
hMem: THandle;
pMem: Pointer;
begin { DataToClipboard }
if datasize <= 0 then
Exit;
hMem := GlobalAlloc( GMEM_MOVEABLE or GMEM_SHARE or GMEM_ZEROINIT, datasize );
if hmem = 0 then
raise EClipboardError.Create( eSystemOutOfMemory );
pMem := GlobalLock( hMem );
if pMem = nil then
begin
GlobalFree( hMem );
raise EClipboardError.Create( eLockFailed );
end;
Move( data, pMem^, datasize );
GlobalUnlock( hMem );
if SetClipboardData( fmt, hMem ) = 0 then
raise EClipboardError( eSetDataFailed );
// Note: API docs are unclear as to whether the memory block has
// to be freed in case of failure. Since failure is unlikely here
// lets blithly ignore this issue for now.
end; { DataToClipboard }
{-- DataFromClipboard -------------------------------------------------}
{: Copies data from the clipboard into a stream
#Param fmt is the clipboard format to look for
#Param S is the stream to copy to
#precondition S <> nil
#postcondition If data was copied the streams position will have moved
#desc Tries to get a memory block for the requested clipboard format.
Nothing
further is done if this fails (because the format is not available or
the clipboard is not open, we treat neither as error here), otherwise
the memory handle is locked and the data copied into the stream. <P>
Note that we cannot determine the actual size of the data originally
copied to the clipboard, only the allocated size of the memory block!
Since GlobalAlloc works with a granularity of 32 bytes the block may be
larger than required for the data and thus the stream may contain some
spurious bytes at the end. There is no guarantee that these bytes will
be 0. <P>
If the memory handle obtained from the clipboard cannot be locked we
raise an <see class=EClipboardError> exception.
Created 5.7.2000 by P. Below
#Raises EClipboardError
}{---------------------------------------------------------------------}
procedure DataFromClipboard( fmt: DWORD; S: TStream );
var
hMem: THandle;
pMem: Pointer;
datasize: DWORD;
begin { DataFromClipboard }
Assert( Assigned( S ));
hMem := GetClipboardData( fmt );
if hMem <> 0 then
begin
datasize := GlobalSize( hMem );
if datasize > 0 then
begin
pMem := GlobalLock( hMem );
if pMem = nil then
raise EclipboardError.Create( eLockFailed );
try
S.WriteBuffer( pMem^, datasize );
finally
GlobalUnlock( hMem );
end;
end;
end;
end; { DatafromClipboard }
{-- CopyDataToClipboard -----------------------------------------------}
{: Copies a block of memory to the clipboard in a given format
#Param fmt is the clipboard format to use
#Param data is an untyped const parameter that addresses the data to copy
#Param datasize is the size of the data, in bytes
#Param emptyClipboardFirst determines if the clipboard should be emptied,
true by default
#Precondition The clipboard must not be open already
#Postcondition If emptyClipboardFirst is true all prior data will be
cleared from the clipboard, even if datasize is <= 0. The clipboard
is closed again.
#desc Tries to open the clipboard, empties it if required and then tries to
copy the passed data to the clipboard. This operation is a NOP if
datasize <= 0. If the clipboard cannot be opened a <see
class=EClipboardError>
is raised.
Created 5.7.2000 by P. Below
#Raises EClipboardError
}{---------------------------------------------------------------------}
procedure CopyDataToClipboard( fmt: DWORD; const data; datasize: Integer;
emptyClipboardFirst: Boolean = true );
begin { CopyDataToClipboard }
if OpenClipboard( 0 ) then
try
if emptyClipboardFirst then
EmptyClipboard;
DataToClipboard( fmt, data, datasize );
finally
CloseClipboard;
end
else
raise EclipboardError.Create( eCannotOpenClipboard );
end; { CopyDataToClipboard }
{-- StringToClipboard -------------------------------------------------}
{: Copies a string to clipboard in CF_TEXT clipboard format
#Param S is the string to copy, it may be empty.
#Precondition The clipboard must not be open already.
#Postcondition Any prior clipboard content will be cleared, but only
if S was not empty. The clipboard is closed again.
#desc Hands the brunt of the work off to <See routine=CopyDataToClipboard>,
but only if S was not empty. Otherwise nothing is done at all.<BR>
Created 5.7.2000 by P. Below
#Raises EClipboardError
}{---------------------------------------------------------------------}
procedure StringToClipboard( const S: String );
begin
if Length(S) > 0 Then
CopyDataToClipboard( CF_TEXT, S[1], Length(S)+1);
end; { StringToClipboard }
{-- CopyDataFromClipboard ---------------------------------------------}
{: Copies data from the clipboard into a stream
#Param fmt is the clipboard format to look for
#Param S is the stream to copy to
#Precondition S <> nil<P>
The clipboard must not be open already.
#Postcondition If data was copied the streams position will have moved.
The clipboard is closed again.
#desc Tries to open the clipboard, and then tries to
copy the data to the passed stream. This operation is a NOP if
the clipboard does not contain data in the requested format.
If the clipboard cannot be opened a <see class=EClipboardError>
is raised.
Created 5.7.2000 by P. Below
#Raises EClipboardError
}{---------------------------------------------------------------------}
procedure CopyDataFromClipboard( fmt: DWORD; S: TStream );
begin { CopyDataFromClipboard }
Assert( Assigned( S ));
if OpenClipboard( 0 ) then
try
DataFromClipboard( fmt , S );
finally
CloseClipboard;
end
else
raise EclipboardError.Create( eCannotOpenClipboard );
end; { CopyDataFromClipboard }
{-- ClipboardAsString -------------------------------------------------}
{: Returns any text contained on the clipboard
#Returns the clipboards content if it contained something in CF_TEXT
format, or an empty string.
#Precondition The clipboard must not be already open
#Postcondition The clipboard is closed.
#desc If the clipboard contains data in CF_TEXT format it is copied to a
temp memory stream, zero-terminated for good measure and copied into
the result string.
Created 5.7.2000 by P. Below
#Raises EClipboardError
}{---------------------------------------------------------------------}
function ClipboardAsString: String;
const
nullchar: Char = #0;
var
ms: TMemoryStream;
begin { ClipboardAsString }
if not IsClipboardFormatAvailable( CF_TEXT ) then
Result := EmptyStr
else
begin
ms:= TMemoryStream.Create;
try
CopyDataFromClipboard( CF_TEXT , ms );
ms.Seek( 0, soFromEnd );
ms.WriteBuffer( nullChar, Sizeof( nullchar ));
Result := PChar( ms.Memory );
finally
ms.Free;
end;
end;
end; { ClipboardAsString }
{-- ClipboardHasFormat ------------------------------------------------}
{: Checks if the clipboard contains data in the specified format
#Param fmt is the format to check for
#Returns true if the clipboard contains data in this format, false
otherwise
#Precondition none
#Postcondition none
#desc This is a simple wrapper around an API function.
Created 5.7.2000 by P. Below
}{---------------------------------------------------------------------}
function ClipboardHasFormat( fmt: DWORD ): Boolean;
begin { ClipboardHasFormat }
Result := IsClipboardFormatAvailable( fmt );
end; { ClipboardHasFormat }
end.
Sample use:
Prepare the text in your SQL editor, text editor, or whatever:
SELECT
lname,
fname,
dob
FROM
employees
Select all of the text, and copy to the clipboard using Ctrl+C.
Switch to the IDE's Code Editor, run the ClipboardToStringConst application (using the Tools menu item you added, or whatever other means you want). Place the editor's cursor (insertion point) where you want the constant text to appear, and press Ctrl+V to paste in the text.
const
MySQLText = | // The pipe indicates the insertion point.
The result:
const
MySQLText = 'SELECT '+
' lname, '+
' fname, '+
' dob '+
'FROM '+
' employees ';
You mean something like this?
myStr := 'first line'#13#10'secondline'#13#10'thirdline';
We had the same problem, and finally we created a small IDE plugin (merged with existing solutions). That creates two extra menu items (Copy and Paste extra). One of this pastes the formatted content of the clipboard to the code editor, the other does the same thing in reverse (copy the content of the selection to the clipboard and removes the extra charachters).
To use this:
Create new Package in Delphi
Add to "designide" to requires section (and remove anything else)
Create new Unit, and copy the code
Build and Install
Sample code:
unit ClipboardWizard;
interface
uses
Windows, SysUtils, Classes, ToolsAPI,
{$ifdef VER280} // XE7
VCL.Menus
{$else}
Menus
{$endif};
type
TClipboardWizard = class(TInterfacedObject, IOTAWizard)
private
FMainMenuItem, FCopyMenuItem, FPasteMenuItem: TMenuItem;
// Formatting
function GetFormattedString: string;
function RemoveUnneededChars(const Value: string): string;
// Menu events
procedure CopyToClipboard(Sender: TObject);
procedure PasteFromClipboard(Sender: TObject);
public
// TObject
constructor Create;
destructor Destroy; override;
// IOTANotifier
procedure AfterSave;
procedure BeforeSave;
procedure Destroyed;
procedure Modified;
// IOTAWizard
function GetIDString: string;
function GetName: string;
function GetState: TWizardState;
procedure Execute;
end;
procedure Register;
implementation
uses
Vcl.Clipbrd, System.StrUtils;
procedure Register;
begin
RegisterPackageWizard(TClipboardWizard.Create);
end;
// Formatting
function TClipboardWizard.RemoveUnneededChars(const Value: string): string;
var
List: TStringList;
q: integer;
s : string;
begin
if Trim(Value) <> '' then
begin
List := TStringList.Create;
try
List.Text := Value;
for q := 0 to List.Count - 1 do
begin
s := Trim(List[q]);
if Length(s) > 0 then
if s[1] = '''' then
s := Copy(s, 2, Length(s));
s := TrimLeft(ReverseString(s));
if Length(s) > 0 then
if s[1] = '+' then
s := TrimLeft(Copy(s, 2, Length(s)));
if Length(s) > 0 then
if s[1] = ';' then
s := TrimLeft(Copy(s, 2, Length(s)));
if Length(s) > 0 then
if s[1] = '''' then
s := TrimLeft(Copy(s, 2, Length(s)));
s := StringReplace(s, '''''', '''', [rfReplaceAll]);
List[q] := ReverseString(s)
end;
Result := List.Text;
finally
List.Free;
end;
end
else
Result := '';
end;
procedure TClipboardWizard.CopyToClipboard(Sender: TObject);
begin
with BorlandIDEServices as IOTAEditorServices do
if Assigned(TopView) then
Clipboard.AsText := RemoveUnneededChars(TopView.Block.Text);
end;
function TClipboardWizard.GetFormattedString: string;
const
FSingleQuote = '''';
Indent: array [boolean] of string = (' ', '');
EndChar: array [boolean] of string = (' +', ';');
var
List: TStringlist;
q: Integer;
begin
if Clipboard.HasFormat(CF_TEXT) then
begin
List := TStringlist.Create;
try
List.Text := Clipboard.AsText;
for q := 0 to List.Count - 1 do
List[q] := Indent[q <> 0] + AnsiQuotedStr(TrimRight(List[q]) + #32, FSingleQuote) +
EndChar[q = (List.Count - 1)];
Result := List.Text;
finally
List.Free;
end;
end;
end;
procedure TClipboardWizard.PasteFromClipboard(Sender: TObject);
begin
with BorlandIDEServices as IOTAEditorServices do
if Assigned(TopView) then
begin
TopView.Buffer.EditPosition.InsertText(GetFormattedString);
TopView.Paint; // invalidation
end;
end;
{ Anything else }
constructor TClipboardWizard.Create;
var
NTAServices : INTAServices;
begin
NTAServices := BorlandIDEServices as INTAServices;
// Main Menu
FMainMenuItem := TMenuItem.Create(nil);
FMainMenuItem.Caption := 'Clibrd Extra' ;
NTAServices.MainMenu.Items.Add(FMainMenuItem);
// Sub Menus
FCopyMenuItem := TMenuItem.Create(nil);
FCopyMenuItem.Caption := 'Copy to clipboard';
FCopyMenuItem.OnClick := Self.CopyToClipboard;
FMainMenuItem.Add(FCopyMenuItem);
FPasteMenuItem := TMenuItem.Create(nil);
FPasteMenuItem.Caption := 'Paste from clipboard';
FPasteMenuItem.OnClick := Self.PasteFromClipboard;
FMainMenuItem.Add(FPasteMenuItem);
end;
destructor TClipboardWizard.Destroy;
begin
if Assigned(FPasteMenuItem) then
FreeAndNil(FPasteMenuItem);
if Assigned(FCopyMenuItem) then
FreeAndNil(FCopyMenuItem);
if Assigned(FMainMenuItem) then
FreeAndNil(FMainMenuItem);
inherited;
end;
{ IOTANotifier }
procedure TClipboardWizard.AfterSave;
begin
end;
procedure TClipboardWizard.BeforeSave;
begin
end;
procedure TClipboardWizard.Destroyed;
begin
end;
procedure TClipboardWizard.Modified;
begin
end;
{ IOTAWizard }
function TClipboardWizard.GetIDString: string;
begin
Result := 'Clipboard.Wizard7';
end;
function TClipboardWizard.GetName: string;
begin
Result := 'Clipboard Wizard7';
end;
function TClipboardWizard.GetState: TWizardState;
begin
Result := [];
end;
procedure TClipboardWizard.Execute;
begin
end;
end.
I know the code is not perfect, but it works :-)
You could consider putting your SQL in TQuery components on Forms or Data Modules.
This solves the copy/paste problem, but it introduces others (such as the diffs between two versions of a query being worse).
You can't define a string on multiple lines without the quotes:
const
myString = 'this is a long string that extends' +
'to a second line';
Although, you can make a string out of control characters like:
const
myString = #83#84#82#73#78#71;
But that does not attribute to readble code.
In versions of Delphi >= 2007, if you are entering a quoted string over multiple lines it will automatically add a closing quote and + ' on the next line if you don't close the quote yourself.
It's not a solution to the problem but it does help speed up typing in long strings.
The short answer is no, it can't be done. (I know that is not what you want to hear.)
However Andreas Hausladen did develop an extension capable of just this. I googled for it but couldn't find it. I think it was in his DLangExtensions pack, of which he dropped support in late 2007 already. :(
I'm surprised no one's mentioned resources. Although a pain to implement the first time, once you've done it once you can implement retrieving long multiline strings from files without too much trouble. Random instructions I found here: http://www.delphibasics.info/home/delphibasicssnippets/usingresourcefileswithdelphi
With GExperts:
enable GExperts -> Editor Experts -> Paste Strings As
assign a shortcut
I am late to Party, but if GExperts i no Option:
Fast Solution: Use IDE Macro Recorder...
copy text (start recording SHIFT + STRG + R)
Press [Pos1] ['] [End] [' + sLineBreak +] [change line to one down]
(stop recording SHIFT + STRG + R)
(replay Key Strokes SHIFT + STRG + P) repeat until last line ... delete the + which is too much ...
Partially finished;
The Escaping of ' for Strings is not done this way ...
Related
My program is processing incoming strings (from Telnet, HTTP, etc), and I have to write these to a text file with Delphi XE2 for logging purposes.
Sometimes the program may crash and I need to be sure that the remaining strings are not lost so I open/close the file for every incoming string and I have some performance problems. The code below, for example, takes 8 seconds to complete.
My code is included below, is there some way to improve the performance?
(For the test below simply create a Form with a Button : Button1, with OnClick event and a Label : lbl1).
Procedure AddToFile(Source: string; FileName :String);
var
FText : Text;
TmpBuf: array[word] of byte;
Begin
{$I-}
AssignFile(FText, FileName);
Append(FText);
SetTextBuf(FText, TmpBuf);
Writeln(FText, Source);
CloseFile(FText);
{$I+}
end;
procedure initF(FileName : string);
Var FText : text;
begin
{$I-}
if FileExists(FileName) then DeleteFile(FileName);
AssignFile(FText, FileName);
ReWrite(FText);
CloseFile(FText);
{$I+}
end;
procedure TForm1.Button1Click(Sender: TObject);
var tTime : TDateTime;
iBcl : Integer;
FileName : string;
begin
FileName := 'c:\Test.txt';
lbl1.Caption := 'Go->' + FileName; lbl1.Refresh;
initF(FileName);
tTime := Now;
For iBcl := 0 to 2000 do
AddToFile(IntToStr(ibcl) + ' ' + 'lkjlkjlkjlkjlkjlkjlkj' , FileName);
lbl1.Caption := FormatDateTime('sss:zzz',Now-tTime);
end;
Use a TStreamWriter, which is automatically buffered, and can handle flushing its buffers to the TFileStream automatically. It also allows you to choose to append to an existing file if you need to, set character encodings for Unicode support, and lets you set a different buffer size (the default is 1024 bytes, or 1K) in its various overloaded Create constructors.
(Note that flushing the TStreamWriter only writes the content of the TStreamBuffer to the TFileStream; it doesn't flush the OS file system buffers, so the file isn't actually written on disk until the TFileStream is freed.)
Don't create the StreamWriter every time; just create and open it once, and close it at the end:
function InitLog(const FileName: string): TStreamWriter;
begin
Result := TStreamWriter.Create(FileName, True);
Result.AutoFlush := True; // Flush automatically after write
Result.NewLine := sLineBreak; // Use system line breaks
end;
procedure CloseLog(const StreamWriter: TStreamWriter);
begin
StreamWriter.Free;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
tTime : TDateTime;
iBcl : Integer;
LogSW: TStreamWriter;
FileName: TFileName;
begin
FileName := 'c:\Test.txt';
LogSW := InitLog(FileName);
try
lbl1.Caption := 'Go->' + FileName;
lbl1.Refresh;
tTime := Now;
For iBcl := 0 to 2000 do
LogSW.WriteLine(IntToStr(ibcl) + ' ' + 'lkjlkjlkjlkjlkjlkjlkj');
lbl1.Caption := FormatDateTime('sss:zzz',Now - tTime);
finally
CloseLog(LogSW);
end;
end;
Instead of reopening file to save critical data on disk you can either use FlushFileBuffers function or open a file for unbuffered I/O by calling the CreateFile function with the FILE_FLAG_NO_BUFFERING and FILE_FLAG_WRITE_THROUGH flags (see Remarks section in the first link).
It seems your problem is that you need to flush the cache after each write so that you won't lose data if your application crashes.
Whereas I'm sure the other answers here are excellent, you needn't make such extensive changes to your code. All you need to do is call Flush(FText) after each write.
const
// 10 million tests
NumberOfTests = 1000000;
// Open and close with each write: 19.250 seconds
// Open once, and flush after each write: 5.686 seconds
// Open once, don't flush 0.439 seconds
var
FText : Text;
TmpBuf: array[word] of byte;
procedure initF(FileName : string);
begin
{$I-}
if FileExists(FileName) then DeleteFile(FileName);
AssignFile(FText, FileName);
ReWrite(FText);
SetTextBuf(FText, TmpBuf);
{$I+}
end;
procedure CloseTheFile;
begin
CloseFile(FText);
end;
Procedure AddToFile(Source: string);
Begin
{$I-}
Writeln(FText, Source);
// flush the cache after each write so that data will be written
// even if program crashes.
flush ( fText ); // <<<==== Flush the Cache after each write
{$I+}
end;
procedure TForm1.Button1Click(Sender: TObject);
var tTime : TDateTime;
iBcl : Integer;
FileName : string;
begin
FileName := 'c:\Test.txt';
lbl1.Caption := 'Go->' + FileName; lbl1.Refresh;
initF(FileName);
// put file close in a try/finally block to ensure file is closed
// even if an exception is raised.
try
tTime := Now;
For iBcl := 0 to NumberOfTests-1 do
AddToFile(IntToStr(ibcl) + ' ' + 'lkjlkjlkjlkjlkjlkjlkj');
lbl1.Caption := FormatDateTime('sss:zzz',Now-tTime);
finally
CloseTheFile;
end;
end;
for some reason a simple reading from one text file and writing to text output file I found the TextFile WriteLn is still the fastest way.
AssignFile(t,'c:\a\in.csv');
Reset(t);
AssignFile(outt,'c:\a\out.csv');
ReWrite(outt);
while not eof(t) do
begin
Readln(t,x);
WriteLn(outt, x); //27 sec, using LogSW.WriteLine(outx) takes 54 sec
// half Gb file took 27 sec with the above code, using TStreamWriter from example provided by Martijn took 54 seconds :o
I have written a Delphi function that loads data from a .dat file into a string list. It then decodes the string list and assigns to a string variable. The contents of the string use the '#' symbol as a separator.
How can I then take the contents of this string and then assign its contents to local variables?
// Function loads data from a dat file and assigns to a String List.
function TfrmMain.LoadFromFile;
var
index, Count : integer;
profileFile, DecodedString : string;
begin
// Open a file and assign to a local variable.
OpenDialog1.Execute;
profileFile := OpenDialog1.FileName;
if profileFile = '' then
exit;
profileList := TStringList.Create;
profileList.LoadFromFile(profileFile);
for index := 0 to profileList.Count - 1 do
begin
Line := '';
Line := profileList[Index];
end;
end;
After its been decoded the var "Line" contains something that looks like this:
example:
Line '23#80#10#2#1#...255#'.
Not all of the values between the separators are the same length and the value of "Line" will vary each time the function LoadFromFile is called (e.g. sometimes a value may have only one number the next two or three etc so I cannot rely on the Copy function for strings or arrays).
I'm trying to figure out a way of looping through the contents of "Line", assigning it to a local variable called "buffer" and then if it encounters a '#' it then assigns the value of buffer to a local variable, re-initialises buffer to ''; and then moves onto the next value in "Line" repeating the process for the next parameter ignoring the '#' each time.
I think I have been scratching around with this problem for too long now and I cannot seem to make any progress and need a break from it. If anyone would care to have a look, I would welcome any suggestions on how this might be achieved.
Many Thanks
KD
You need a second TStringList:
lineLst := TStringList.Create;
try
lineLst.Delimiter := '#';
lineLst.DelimitedText := Line;
...
finally
lineLst.Free;
end;
Depending on your Delphi version you can set lineLst.StrictDelimiter := true in case the line contains spaces.
You can do something like this:
program Project1;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils, StrUtils;
var
S : string;
D : string;
begin
S := '23#80#10#2#1#...255#';
for D in SplitString(S,'#') do //SplitString is in the StrUtils unit
writeln(D);
readln;
end.
You did not tag your Delphi version, so i don't know if it applies or not.
That IS version-specific. Please do!
In order of my personal preference:
1: Download Jedi CodeLib - http://jcl.sf.net. Then use TJclStringList. It has very nice split method. After that you would only have to iterate through.
function Split(const AText, ASeparator: string; AClearBeforeAdd: Boolean = True): IJclStringList;
uses JclStringLists;
...
var s: string; js: IJclStringList.
begin
...
js := TJclStringList.Create().Split(input, '#', True);
for s in js do begin
.....
end;
...
end;
2: Delphi now has somewhat less featured StringSplit routine. http://docwiki.embarcadero.com/Libraries/en/System.StrUtils.SplitString
It has a misfeature that array of string type may be not assignment-compatible to itself. Hello, 1949 Pascal rules...
uses StrUtils;
...
var s: string;
a_s: TStringDynArray;
(* aka array-of-string aka TArray<string>. But you have to remember this term exactly*)
begin
...
a_s := SplitString(input, '#');
for s in a_s do begin
.....
end;
...
end;
3: Use TStringList. The main problem with it is that it was designed that spaces or new lines are built-in separators. In newer Delphi that can be suppressed. Overall the code should be tailored to your exact Delphi version. You can easily Google for something like "Using TStringlist for splitting string" and get a load of examples (like #Uwe's one).
But you may forget to suppress here or there. And you may be on old Delphi,, where that can not be done. And you may mis-apply example for different Delphi version. And... it is just boring :-) Though you can make your own function to generate such pre-tuned stringlists for you and carefully check Delphi version in it :-) But then You would have to carefully free that object after use.
I use a function I've written called Fetch. I think I stole the idea from the Indy library some time ago:
function Fetch(var VString: string; ASeperator: string = ','): string;
var LPos: integer;
begin
LPos := AnsiPos(ASeperator, VString);
if LPos > 0 then
begin
result := Trim(Copy(VString, 1, LPos - 1));
VString := Copy(VString, LPos + 1, MAXINT);
end
else
begin
result := VString;
VString := '';
end;
end;
Then I'd call it like this:
var
value: string;
line: string;
profileFile: string;
profileList: TStringList;
index: integer;
begin
if OpenDialog1.Execute then
begin
profileFile := OpenDialog1.FileName;
if (profileFile = '') or not FileExists(profileFile) then
exit;
profileList := TStringList.Create;
try
profileList.LoadFromFile(profileFile);
for index := 0 to profileList.Count - 1 do
begin
line := profileList[index];
Fetch(line, ''''); //discard "Line '"
value := Fetch(line, '#')
while (value <> '') and (value[1] <> '''') do //bail when we get to the quote at the end
begin
ProcessTheNumber(value); //do whatever you need to do with the number
value := Fetch(line, '#');
end;
end;
finally
profileList.Free;
end;
end;
end;
Note: this was typed into the browser, so I haven't checked it works.
I am trying to remotely read a binary (REG_BINARY) registry value, but I get nothing but junk back. Any ideas what is wrong with this code? I'm using Delphi 2010:
function GetBinaryRegistryData(ARootKey: HKEY; AKey, AValue, sMachine: string; var sResult: string): boolean;
var
MyReg: TRegistry;
RegDataType: TRegDataType;
DataSize, Len: integer;
sBinData: string;
bResult: Boolean;
begin
bResult := False;
MyReg := TRegistry.Create(KEY_QUERY_VALUE);
try
MyReg.RootKey := ARootKey;
if MyReg.RegistryConnect('\\' + sMachine) then
begin
if MyReg.KeyExists(AKey) then
begin
if MyReg.OpenKeyReadOnly(AKey) then
begin
try
RegDataType := MyReg.GetDataType(AValue);
if RegDataType = rdBinary then
begin
DataSize := MyReg.GetDataSize(AValue);
if DataSize > 0 then
begin
SetLength(sBinData, DataSize);
Len := MyReg.ReadBinaryData(AValue, PChar(sBinData)^, DataSize);
if Len <> DataSize then
raise Exception.Create(SysErrorMessage(ERROR_CANTREAD))
else
begin
sResult := sBinData;
bResult := True;
end;
end;
end;
except
MyReg.CloseKey;
end;
MyReg.CloseKey;
end;
end;
end;
finally
MyReg.Free;
end;
Result := bResult;
end;
And I call it like this:
GetBinaryRegistryData(
HKEY_LOCAL_MACHINE,
'\SOFTWARE\Microsoft\Windows NT\CurrentVersion',
'DigitalProductId', '192.168.100.105',
sProductId
);
WriteLn(sProductId);
The result I receive from the WriteLn on the console is:
ñ ♥ ???????????6Z ????1 ???????☺ ???♦ ??3 ? ??? ?
??
Assuming that you are already connected remotely, try using the GetDataAsString function
to read binary data from the registry.
sResult := MyReg.GetDataAsString(AValue);
You're using Delphi 2010, so all your characters are two bytes wide. When you set the length of your result string, you're allocating twice the amount of space you need. Then you call ReadBinaryData, and it fills half your buffer. There are two bytes of data in each character. Look at each byte separately, and you'll probably find that your data looks less garbage-like.
Don't use strings for storing arbitrary data. Use strings for storing text. To store arbitrary blobs of data, use TBytes, which is an array of bytes.
Is there a way to access (and call) procedures like _CopyArray that are defined in the interface in the unit System?
NB: I am trying to create a routine that makes a deep clone of any dynamic array, and do not use Delphi 2010 (using Delphi 2007).
The reason why I am trying to solve this without using Copy is the fact that I have only a pointer where the dynamic array is located (the pointer that is) plus a typeinfo reference. I cannot call the Copy function because it implicitly needs to fill in the typeinfo.
SOLUTION:
You need to reference it by replacing the _ with an # and scoping it with system.
procedure CopyArray( dest, source, typeInfo: Pointer; cnt: Integer );
asm
PUSH dword ptr [EBP+8]
CALL system.#CopyArray
end;
type
PObject = ^TObject;
function TMessageRTTI.CloneDynArray( Source: Pointer; T: TTypeRecord ): Pointer;
var
TypeInfo: TTypeRecord;
L: Integer;
PObj: PObject;
PArr: PPointer;
begin
Assert( T.TypeKind = tkDynArray );
// set size of array
Result := nil;
L := Length( TIntegerDynArray( Source ) );
if L = 0 then Exit;
DynArraySetLength( Result, T.TypeInfo, 1, #L );
if Assigned( T.TypeData^.elType ) then TypeInfo := ByTypeInfo( T.TypeData^.elType^ ) else TypeInfo := nil;
if Assigned( TypeInfo ) then begin
case TypeInfo.TypeKind of
tkClass: begin
PObj := Result;
while L > 0 do begin
PObj^ := CloneObject( PObject( Source )^ );
Inc( PObject( Source ) );
Inc( PObj );
Dec( L );
end;
end;
tkDynArray: begin
PArr := Result;
while L > 0 do begin
PArr^ := CloneDynArray( PPointer( Source )^, TypeInfo );
Inc( PPointer( Source ) );
Inc( PArr );
Dec( L );
end;
end;
else CopyArray( Result, Source, TypeInfo.TypeInfo, L );
end;
end else begin
// We can simply clone the data
Move( Source^, Result^, L * T.ElementSize );
end;
end;
Like Serg and Andreas said, the _ routines all use compiler magic to provide functionality, so you should use Copy instead of _CopyArray, is instead of _IsClass, etc.
To directly answer your question though, no, there is no way to call those routines from Delphi code in other units. The makefile for the RTL passes an undocumented compiler switch when compiling System.pas and SysInit.pas which tells the compiler to convert any leading _ characters to #. _CopyArray becomes #CopyArray, for example. You can call it using a BASM (assembly) block, but that's it.
The comment by Andreas Rejbrand is actually an answer - the _CopyArray procedure is called automaticaly when you copy complicated arrays. For example, set a breakpoint in _CopyArray and run the following code (should be compiled with debug .dcu to activate the breakpoint):
procedure TForm1.Button4Click(Sender: TObject);
type
TArr2D = array of TBytes;
var
A, B: TArr2D;
begin
A:= TArr2D.Create(TBytes.Create(1, 2, 3), TBytes.Create(4, 5));
B:= Copy(A);
Button4.Caption:= IntToStr(B[1, 1]);
end;
I have a huge file that I must parse line by line. Speed is of the essence.
Example of a line:
Token-1 Here-is-the-Next-Token Last-Token-on-Line
^ ^
Current Position
Position after GetToken
GetToken is called, returning "Here-is-the-Next-Token" and sets the CurrentPosition to the position of the last character of the token so that it is ready for the next call to GetToken. Tokens are separated by one or more spaces.
Assume the file is already in a StringList in memory. It fits in memory easily, say 200 MB.
I am worried only about the execution time for the parsing. What code will produce the absolute fastest execution in Delphi (Pascal)?
Use PChar incrementing for speed of processing
If some tokens are not needed, only copy token data on demand
Copy PChar to local variable when actually scanning through characters
Keep source data in a single buffer unless you must handle line by line, and even then, consider handling line processing as a separate token in the lexer recognizer
Consider processing a byte array buffer that has come straight from the file, if you definitely know the encoding; if using Delphi 2009, use PAnsiChar instead of PChar, unless of course you know the encoding is UTF16-LE.
If you know that the only whitespace is going to be #32 (ASCII space), or a similarly limited set of characters, there may be some clever bit manipulation hacks that can let you process 4 bytes at a time using Integer scanning. I wouldn't expect big wins here though, and the code will be as clear as mud.
Here's a sample lexer that should be pretty efficient, but it assumes that all source data is in a single string. Reworking it to handle buffers is moderately tricky due to very long tokens.
type
TLexer = class
private
FData: string;
FTokenStart: PChar;
FCurrPos: PChar;
function GetCurrentToken: string;
public
constructor Create(const AData: string);
function GetNextToken: Boolean;
property CurrentToken: string read GetCurrentToken;
end;
{ TLexer }
constructor TLexer.Create(const AData: string);
begin
FData := AData;
FCurrPos := PChar(FData);
end;
function TLexer.GetCurrentToken: string;
begin
SetString(Result, FTokenStart, FCurrPos - FTokenStart);
end;
function TLexer.GetNextToken: Boolean;
var
cp: PChar;
begin
cp := FCurrPos; // copy to local to permit register allocation
// skip whitespace; this test could be converted to an unsigned int
// subtraction and compare for only a single branch
while (cp^ > #0) and (cp^ <= #32) do
Inc(cp);
// using null terminater for end of file
Result := cp^ <> #0;
if Result then
begin
FTokenStart := cp;
Inc(cp);
while cp^ > #32 do
Inc(cp);
end;
FCurrPos := cp;
end;
Here is a lame ass implementation of a very simple lexer. This might give you an idea.
Note the limitations of this example - no buffering involved, no Unicode (this is an excerpt from a Delphi 7 project). You would probably need those in a serious implementation.
{ Implements a simpe lexer class. }
unit Simplelexer;
interface
uses Classes, Sysutils, Types, dialogs;
type
ESimpleLexerFinished = class(Exception) end;
TProcTableProc = procedure of object;
// A very simple lexer that can handle numbers, words, symbols - no comment handling
TSimpleLexer = class(TObject)
private
FLineNo: Integer;
Run: Integer;
fOffset: Integer;
fRunOffset: Integer; // helper for fOffset
fTokenPos: Integer;
pSource: PChar;
fProcTable: array[#0..#255] of TProcTableProc;
fUseSimpleStrings: Boolean;
fIgnoreSpaces: Boolean;
procedure MakeMethodTables;
procedure IdentProc;
procedure NewLineProc;
procedure NullProc;
procedure NumberProc;
procedure SpaceProc;
procedure SymbolProc;
procedure UnknownProc;
public
constructor Create;
destructor Destroy; override;
procedure Feed(const S: string);
procedure Next;
function GetToken: string;
function GetLineNo: Integer;
function GetOffset: Integer;
property IgnoreSpaces: boolean read fIgnoreSpaces write fIgnoreSpaces;
property UseSimpleStrings: boolean read fUseSimpleStrings write fUseSimpleStrings;
end;
implementation
{ TSimpleLexer }
constructor TSimpleLexer.Create;
begin
makeMethodTables;
fUseSimpleStrings := false;
fIgnoreSpaces := false;
end;
destructor TSimpleLexer.Destroy;
begin
inherited;
end;
procedure TSimpleLexer.Feed(const S: string);
begin
Run := 0;
FLineNo := 1;
FOffset := 1;
pSource := PChar(S);
end;
procedure TSimpleLexer.Next;
begin
fTokenPos := Run;
foffset := Run - frunOffset + 1;
fProcTable[pSource[Run]];
end;
function TSimpleLexer.GetToken: string;
begin
SetString(Result, (pSource + fTokenPos), Run - fTokenPos);
end;
function TSimpleLexer.GetLineNo: Integer;
begin
Result := FLineNo;
end;
function TSimpleLexer.GetOffset: Integer;
begin
Result := foffset;
end;
procedure TSimpleLexer.MakeMethodTables;
var
I: Char;
begin
for I := #0 to #255 do
case I of
'#', '&', '}', '{', ':', ',', ']', '[', '*',
'^', ')', '(', ';', '/', '=', '-', '+', '#', '>', '<', '$',
'.', '"', #39:
fProcTable[I] := SymbolProc;
#13, #10: fProcTable[I] := NewLineProc;
'A'..'Z', 'a'..'z', '_': fProcTable[I] := IdentProc;
#0: fProcTable[I] := NullProc;
'0'..'9': fProcTable[I] := NumberProc;
#1..#9, #11, #12, #14..#32: fProcTable[I] := SpaceProc;
else
fProcTable[I] := UnknownProc;
end;
end;
procedure TSimpleLexer.UnknownProc;
begin
inc(run);
end;
procedure TSimpleLexer.SymbolProc;
begin
if fUseSimpleStrings then
begin
if pSource[run] = '"' then
begin
Inc(run);
while pSource[run] <> '"' do
begin
Inc(run);
if pSource[run] = #0 then
begin
NullProc;
end;
end;
end;
Inc(run);
end
else
inc(run);
end;
procedure TSimpleLexer.IdentProc;
begin
while pSource[Run] in ['_', 'A'..'Z', 'a'..'z', '0'..'9'] do
Inc(run);
end;
procedure TSimpleLexer.NumberProc;
begin
while pSource[run] in ['0'..'9'] do
inc(run);
end;
procedure TSimpleLexer.SpaceProc;
begin
while pSource[run] in [#1..#9, #11, #12, #14..#32] do
inc(run);
if fIgnoreSpaces then Next;
end;
procedure TSimpleLexer.NewLineProc;
begin
inc(FLineNo);
inc(run);
case pSource[run - 1] of
#13:
if pSource[run] = #10 then inc(run);
end;
foffset := 1;
fRunOffset := run;
end;
procedure TSimpleLexer.NullProc;
begin
raise ESimpleLexerFinished.Create('');
end;
end.
I made a lexical analyser based on a state engine (DFA). It works with a table and is pretty fast. But there are possible faster options.
It also depends on the language. A simple language can possibly have a smart algorithm.
The table is an array of records each containing 2 chars and 1 integer. For each token the lexer walks through the table, startting at position 0:
state := 0;
result := tkNoToken;
while (result = tkNoToken) do begin
if table[state].c1 > table[state].c2 then
result := table[state].value
else if (table[state].c1 <= c) and (c <= table[state].c2) then begin
c := GetNextChar();
state := table[state].value;
end else
Inc(state);
end;
It is simple and works like a charm.
If speed is of the essence, custom code is the answer. Check out the Windows API that will map your file into memory. You can then just use a pointer to the next character to do your tokens, marching through as required.
This is my code for doing a mapping:
procedure TMyReader.InitialiseMapping(szFilename : string);
var
// nError : DWORD;
bGood : boolean;
begin
bGood := False;
m_hFile := CreateFile(PChar(szFilename), GENERIC_READ, 0, nil, OPEN_EXISTING, 0, 0);
if m_hFile <> INVALID_HANDLE_VALUE then
begin
m_hMap := CreateFileMapping(m_hFile, nil, PAGE_READONLY, 0, 0, nil);
if m_hMap <> 0 then
begin
m_pMemory := MapViewOfFile(m_hMap, FILE_MAP_READ, 0, 0, 0);
if m_pMemory <> nil then
begin
htlArray := Pointer(Integer(m_pMemory) + m_dwDataPosition);
bGood := True;
end
else
begin
// nError := GetLastError;
end;
end;
end;
if not bGood then
raise Exception.Create('Unable to map token file into memory');
end;
I think the biggest bottleneck is always going to be getting the file into memory. Once you have it in memory (obviously not all of it at once, but I would work with buffers if I were you), the actual parsing should be insignificant.
This begs another question - How big?
Give us a clue like # of lines or # or Mb (Gb)?
Then we will know if it fits in memory, needs to be disk based etc.
At first pass I would use my WordList(S: String; AList: TStringlist);
then you can access each token as Alist[n]...
or sort them or whatever.
Speed will always be relative to what you are doing once it is parsed. A lexical parser by far is the fastest method of converting to tokens from a text stream regardless of size. TParser in the classes unit is a great place to start.
Personally its been a while since I needed to write a parser, but another more dated yet tried and true method would be to use LEX/YACC to build a grammar then have it convert the grammar into code you can use to perform your processing. DYacc is a Delphi version...not sure if it still compiles or not, but worth a look if you want to do things old school. The dragon book here would be of big help, if you can find a copy.
Rolling your own is the fastest way for sure. For more on this topic, you could see Synedit's source code which contains lexers (called highlighters in the project's context) for about any language on the market. I suggest you take one of those lexers as a base and modify for your own usage.
The fastest way to write the code would probably be to create a TStringList and assign each line in your text file to the CommaText property. By default, white space is a delimiter, so you will get one StringList item per token.
MyStringList.CommaText := s;
for i := 0 to MyStringList.Count - 1 do
begin
// process each token here
end;
You'll probably get better performance by parsing each line yourself, though.