I am having issues with loading a CSV into a StringGrid. Occasionally, it runs out of memory, but also it seems to have blank columns after each value. I've not really read from a CSV as opposed to output to one, so I took a stock example online and modified it for my needs.
This is what I've currently got:
procedure x.LoadCSVtoGrid(ACSVFile : String; AStringGrid: TStringGrid)
var
LRowIndex, LColIndex: Integer;
LStrLine: string;
LFile: TStringList;
begin
AStringGrid.RowCount := 0;
AStringGrid.ColCount := 0;
if not FileExists(ACSVFile) then
exit;
LFile := TStringList.Create;
try
LFile.LoadFromFile(ACSVFile);
if LFile.Count = 0 then
exit;
AStringGrid.ColCount := Max(AStringGrid.ColCount, WordCount(LFile[0], [',', '"'], '"'));
AStringGrid.RowCount := LFile.Count;
for LRowIndex := 0 to LFile.Count - 1 do
begin
LStrLine := LFile[LRowIndex];
LColIndex := 0;
while LStrLine <> '' do
begin
if Pos('"', LStrLine) = 1 then
begin
Delete(LStrLine, 1, 1);
AStringGrid.Cells[LColIndex, LRowIndex] := Copy(LStrLine, 1, Pos('"', LStrLine) - 1);
Delete(LStrLine, 1, Pos('"', LStrLine));
end
else
begin
AStringGrid.Cells[LColIndex, LRowIndex] := Copy(LStrLine, 1, Pos(',', LStrLine) - 1);
Delete(LStrLine, 1, Pos(',', LStrLine));
end;
Inc(LColIndex);
end;
end;
finally
LFile.Free;
end;
For smaller CSV files, it does fine. I think it's reading up to 250-300 lines before. Some of the files it has to deal with now are 500+.
To be honest, I don't do much handling of the data of the CSV until it's been imported into the StringGrid, but once it's in the StringGrid, it's validated. I've got to make sure that commas within speech marks, ie "text, here", are ignored, as it's part of the value. Again, this appears to handle the reading fine.
Another issue I think I might run into is AStringGrid.RowCount := LFile.Count;, as some of the CSV files have blank lines. If there is a way to deal with this, I am happy to take suggestions.
There are a few versions of CSV files it should be able to read, ie the calculation of column counts and such. Code for WordCount:
function x.WordCount(const S: string; const WordDelims: TSysCharSet; const QuoteChar: Char) : Integer;
var
LInWord: Boolean;
LQuoteOpen: Boolean;
i: Integer;
begin
Result := 0;
LInWord := False;
LQuoteOpen := False;
for i := 1 to Length(S) do
begin
if S[i] in WordDelims then
begin
if not LInWord or LQuoteOpen then
LInWord := False
else
begin
LInWord := True;
Inc(Result);
end;
end
else
begin
if S[i] = QuoteChar then
LQuoteOpen := not LQuoteOpen;
LInWord := True;
end;
end;
if LInWord and (not LQuoteOpen) then
Inc(Result);
I've tried multiple files, for the most part this issue only happens with larger CSV files with more content. I've tried various versions of CSV-to-StringGrid procedures to see if there is something innately wrong with the example I took above. The example works, but only on smaller files.
Let me know if you need more information.
Memory issue
First you create a TStringList and then load it with data
LFile := TStringList.Create;
LFile.LoadFromFile(ACSVFile);
Because you load the whole file into the string list, you need that much of memory, plus equally much to hold the data in the TStringGrid.
Reduce memory requirement by reading the file in chunks of, say, 1000 lines at the time, which you then can throw away after they are moved to the string grid.
OTOH, your "Out of memory" problem might also be caused by the errors in your code. I experienced an "Out of memory" error with my very small test file when run with your unaltered code.
Issues with code
In my tests I used a simple file with a few records and a quoted field in different locations. The file content is:
one,two,"text, including comma",four,five
one,two,three,four,five
"text, including comma",two,three,four,five
one,two,three,four,"text, including comma"
You determine required number of columns in the TStringGrid, by calling the WordCount() function, to which you pass the first string from the string list.
WordCount(const S: string; const WordDelims: TSysCharSet; const QuoteChar: Char) : Integer;
When I pass in the first test string,
'one,two,three,four,five',
WordCount returns correctly 5
Then, control returns to LoadCSVtoGrid(), and after assigning AStringGrid.ColCount and RowCount the for LRowIndex loop starts to fill the grid with data for the current row. Pay attention to the second part, after else:
AStringGrid.Cells[LColIndex, LRowIndex] := Copy(LStrLine, 1, Pos(',', LStrLine) - 1);
Delete(LStrLine, 1, Pos(',', LStrLine));
The Delete() deletes from beginning of LStrLine to Pos(',', LStrLine). This works ok for items "one,", "two,", "three," and "four,", but not for "five" as there is no comma after the last item.
This is the major flaw in the code as it never deletes the last item. Instead, since the loop runs while LString <> '' it just continues incrementing LColIndex
On my machine it stops after a couple of minutes with an out-of-memory error.
Here is my take on WordCount (renamed WordCountNew) function:
function TForm50.WordCountNew(const s: string; const Delimiter: Char;
const QuoteChar: Char): Integer;
var
InWord, InQuote: boolean;
i: integer;
begin
if s = '' then // Just in case we are fed an empty string
Exit(0);
Result := 1; // Init, at least one data item
InWord := False; // Init
InQuote:= False; // Init
for i := 1 to Length(s) do
begin
if s[i] = QuoteChar then // The field is quoted
InQuote := not InQuote; // make note about it
if s[i] = Delimiter then // Delimiter found
begin
if not InQuote then // ... but only count it,
inc(Result); // if not within a quote
end;
end;
end;
Then the LoadCSVtoGrid procedure:
procedure TForm50.LoadCSVtoGrid(ACSVFile: String; AStringGrid: TStringGrid);
var
LRowIndex, LColIndex: Integer;
LStrLine: string;
LFile: TStringList;
CommaPos: integer; // added
begin
AStringGrid.RowCount := 0;
AStringGrid.ColCount := 0;
if not FileExists(ACSVFile) then
exit;
LFile := TStringList.Create;
try
LFile.LoadFromFile(ACSVFile);
if LFile.Count = 0 then
exit;
// When determining column count we should ONLY count the field separator, comma.
// A quote character is not an indication of a new column / field.
// Therefore we remove the array of chars, `[',', '"']` and replace with `','`
// AStringGrid.ColCount := Max(AStringGrid.ColCount, WordCount(LFile[0], [',', '"'], '"'));
AStringGrid.ColCount := Max(AStringGrid.ColCount, WordCountNew(LFile[0], ',', '"'));
AStringGrid.RowCount := LFile.Count;
for LRowIndex := 0 to LFile.Count - 1 do
begin
LStrLine := LFile[LRowIndex];
LColIndex := 0;
while LStrLine <> '' do
begin
if Pos('"', LStrLine) = 1 then
begin
Delete(LStrLine, 1, 1);
AStringGrid.Cells[LColIndex, LRowIndex] := Copy(LStrLine, 1, Pos('"', LStrLine) - 1);
AStringGrid.UpdateControlState;
Delete(LStrLine, 1, Pos('"', LStrLine));
Delete(LStrLine, 1, Pos(',', LStrLine));
end
else
begin
CommaPos := Pos(',', LStrLine);
if CommaPos = 0 then CommaPos := Length(LStrLine)+1;
AStringGrid.Cells[LColIndex, LRowIndex] := Copy(LStrLine, 1, CommaPos-1); //Pos(',', LStrLine) - 1);
AStringGrid.UpdateControlState;
Delete(LStrLine, 1, CommaPos); // Pos(',', LStrLine));
end;
Inc(LColIndex);
end;
end;
finally
LFile.Free;
end;
end;
I added the CommaPos variable, to make it easier to artificially simulate a comma at the end of the string.
With these changes the test file is properly read into the grid.
I have an app that reads a JSON data string from disk to create a string grid listing stocks (ticker, number held, cost) and then calls a stockbroker API to fill in current price and value. It works but the code below is causing memory leaks but whilst there are many internet posts on how to access data in a JSONArray none I could find discuss how to free allocated memory. Can anybody help ? I use Delphi Berlin 10.1 and Indy 10.6 if it matters. There are 3 pages of data, some stocks are on 2 pages, sTickers is a stringlist populated with each stock ticker (about 10 of them) and there are about 14 total stock holdings on the 3 stringgrids (tabGrids[0..2] which are on a page control.
The problem code is:
JSONArray := TJSONObject.ParseJSONValue(s) as TJSONArray;
if JSONarray = nil then
begin
ShowMessage('An error occurred reading the data file, section = [' +
iniSection[tabpage] + '].');
continue;
end;
for row := 0 to JSONArray.Count - 1 do
begin
s := (JSONArray.Items[row] as TJSONObject).Get('ticker').JSONValue.Value;
SL.Add(s);
end;
CombineStrings(sTickers, SL);
tabGrids[tabpage].RowCount := SL.Count + 2; //set row count
for row := 1 to SL.Count do
begin //add fixed data to each grid row
tabGrids[tabpage].Cells[0, row] := SL[row - 1];
tabGrids[tabpage].Cells[4, row] := (JSONArray.Items[row - 1] as TJSONObject).Get('qty').JSONValue.Value;
tabGrids[tabpage].Cells[6, row] := (JSONArray.Items[row - 1] as TJSONObject).Get('cost').JSONValue.Value;
tabGrids[tabpage].Cells[1, row] := (JSONArray.Items[row - 1] as TJSONObject).Get('name').JSONValue.Value;
if not tryStrToFloat(tabGrids[tabpage].Cells[4, row], qty) then qty := 0;
if not tryStrToFloat(tabGrids[tabpage].Cells[6, row], price) then price := 0;
tabGrids[tabpage].Cells[6, row] := FloatToStr(qty*price/100);
end;
tabGrids[tabpage].Width := tabGrids[tabpage].ColWidths[0] +
tabGrids[tabpage].ColWidths[1] + tabGrids[tabpage].ColWidths[2] +
tabGrids[tabpage].ColWidths[3] + tabGrids[tabpage].ColWidths[4] +
tabGrids[tabpage].ColWidths[5] + tabGrids[tabpage].ColWidths[6] + 18;
SL.Clear;
end;
JSONArray.Free;
I assume the (JSONArray.Items[row] as TJSONObject).Get('ticker').JSONValue.Value lines are allocating memory that I am not releasing but I do not see how to release it. Or maybe there is a better way to get the data.
You mention 3 pages of data. You are leaking 2 x TJasonArray, and you are freeing one TJasonArray on the last line right after an end; that doesn't have a corresponding begin.
From that I draw the conclusion that you have a loop (that you did not show) that you run three times. On each time you create a TJasonArray but you free only one, after the loop end;, Move the JSonArray.Free; to before the end;.
To do it simpler, you can just use a TJSONValue to parse and free it at end, without free array :
var
Value: TJsonValue
// ...
begin
Value := TJSONObject.ParseJSONValue(s);
try
Ar := Value.FindValue('item') as TJSONArray;
finally
FreeAndNil(Value);
end;
end;
Instead of :
tabGrids[tabpage].Cells[1, row] := (JSONArray.Items[row - 1] as TJSONObject).Get('name').JSONValue.Value;
You can do
tabGrids[tabpage].Cells[1, row] := JSONArray.Items[row - 1].GetValue<string>('name');
Then, you have a end; before you free the array, if it's a upper loop you will have a memory leaks. Use try finally block to free it and the TStringList.
I am taking over a project with code from another person. I have a PLC that currently has inputs in from pressure sensors and thermocouples. It then scales that data to PSI and temperature in fahrenheit. The way the data is set up from each of those sensors is to be formatted into an array. So, once the data is scaled it is in an array that is also in the Network Variable List of the program. I am trying to take each of these values from the array, record the value every certain amount of time (say 1 recording per second for sake of clarity), and then export each piece of data to a CSV file for every second. Not sure where to even go with this. This is the code I was left with, but I feel as if it it unnecessarily complicated?
//This is the support class for File_Handler
FUNCTION_BLOCK fileWrite
VAR_INPUT
xWrite : BOOL;
sData : STRING(200);
uiLineLength : INT := 200;
sDirectory : STRING := 'C:\ProgramData\CODESYS\CODESYSHMIWinV3\D5050FE1\PlcLogic\data';
//sDirectory : STRING := '/home/cds-apps/PlcLogic/data/';
sFilename : STRING;
END_VAR
VAR_OUTPUT
BytesWritten : __XWORD;
BytesWrittenTotal: DWORD;
xDone: BOOL;
END_VAR
VAR
hFile_: sysfile.RTS_IEC_HANDLE := sysfile.RTS_INVALID_HANDLE;
FileWriteResult: sysfile.RTS_IEC_RESULT;
FileOpenResult: sysfile.RTS_IEC_RESULT;
state: INT;
sys_Us_start: SYSTIME;
sys_Us_end: SYSTIME;
WriteTimeMS: ULINT;
END_VAR
sFilename := CONCAT(sDirectory, sFilename);
hFile_ := SysFileOpen(szFile:= sFilename, am:= ACCESS_MODE.AM_APPEND_PLUS, pResult:= ADR(FileOpenResult));
SysTimeGetUs(pUsTime:=sys_Us_start );
BytesWritten := SysFileWrite(hFile:= hfile_, pbyBuffer:= ADR(sData), ulSize:= uiLineLength, pResult:= ADR(FileWriteResult));
BytesWrittenTotal := BytesWrittenTotal + BytesWritten;
SysTimeGetUs(pUsTime:=sys_Us_end );
WriteTimeMS := (sys_Us_end - sys_Us_start)/1000;
SysFileClose(hFile:= hFile_);
I am not sure where to go with this code. It does create a CSV file, but I was looking to be able to create a CSV file for a piece of data every second? If anyone has any thoughts or resources I could check out that would be great.
A basic example of how to call this routine every second could be the following:
1)
You create a FuncBlock that takes care of calling your logger block.
Let's say you call it LoggerTask.
FUNCTION_BLOCK LoggerTask
VAR_INPUT
sData : STRING(200);
sFilename : STRING;
xExecute : BOOL;
END_VAR
VAR
fbRepeatTask : TON;
fbFileWrite : FileWrite;
uiStep : UINT;
END_VAR
2)
After that create a simple step chain:
(You can obviously extend and customize it as you like, you should add error handling in the case when FileWrite fails to write to file or writes less than expected for example.)
Implementation part:
fbRepeatTask(PT:=T#1S);
fbFileWrite(sData := sData, sFileName := sFileName);
IF xExecute
AND uiStep = 0
THEN
uiStep := 10;
ELSIF NOT xExecute
THEN
uiStep := 0;
fbFileWrite.xWrite := FALSE;
fbRepeatTask.IN := FALSE;
END_IF
CASE uiStep OF
10:
fbFileWrite.xWrite := TRUE;
IF fbFileWrite.xDone
THEN
fbFileWrite.xWrite := FALSE;
uiStep := 20;
END_IF
20:
fbRepeatTask.IN := TRUE;
IF fbRepeatTask.Q
THEN
fbRepeatTask.IN := FALSE;
uiStep := 10;
END_IF
END_CASE
3)
As you can see this block gets executed as soon as xExecute is set to true.
In order to reset the step chain set xExecute to false.
Just run this block cyclically for example like this fbLoggerTask(xExecute := TRUE);
I don't think you posted all the code of your FileWrite block because xDone is not set and xWrite is not checked anywhere.
So make sure that xDone is set to true for one cycle after the String is written to the file (if it's not already been implemented).
I am trying to change the function inside the following program into a procedure. The program is supposed to read 5 different integers and then sort them from small numbers to large ones. The version with the function works fine, but the one with the procedure doesn't sort the numbers. It only prints the numbers I typed in. For example, when I type 4, 5 , 7, 3, 1 into the console, it would print 4, 5, 7, 3, 1 instead of the desired 1, 3, 4, 5, 7.
So the question is: how do I get the procedure version to work in the same way as the function version?
I am pretty sure there is something here that I don't understand, but I cannot seem to find out... Any help is greatly appreciated!
This is the version that uses a function:
program FeldSortFunction(input, output); { sorts a field of integers}
FELDGROESSE = 5;
type tIndex = 1..FELDGROESSE; tFeld = array [tIndex] of integer;
var EingabeFeld : tFeld; MinPos,
i : tIndex; Tausch : integer;
function FeldMinimumPos (Feld : tFeld; von, bis:tIndex): tIndex; { finds the Position of the minimum inside the field between von and bis, 1 <= von <= bis <= FELDGROESSE }
var MinimumPos, j:tIndex;
begin
MinimumPos := von;
for j:= von + 1 to bis do
if Feld[j] < Feld[MinimumPos] then
MinimumPos := j;
FeldMinimumPos := MinimumPos
end; { FeldMinimumPos }
begin { Read the field } writeln ('Geben Sie ', FELDGROESSE, ' Werte ein:'); for i := 1 to FELDGROESSE do
readln (EingabeFeld[i]);
{ sort the integers }
for i := 1 to FELDGROESSE - 1 do begin
MinPos := FeldMinimumPos (EingabeFeld, i, FELDGROESSE);
{The minimum has been found, now we need to exchange this value with the element on position i}
Tausch := EingabeFeld[MinPos];
EingabeFeld[MinPos] := EingabeFeld[i];
Eingabefeld[i] := Tausch; end;
{ print the sorted field } for i := 1 to FELDGROESSE do
write (EingabeFeld[i]:6); writeln;
readln; end. { FeldSort }
And this is the version that uses a procedure:
program FeldSortProcedure(input, output);
{ sorts a field of integers and defines the value of the minimum}
const
FELDGROESSE = 5;
type
tIndex = 1..FELDGROESSE;
tFeld = array [tIndex] of integer;
var
SortierFeld : tFeld;
MinPos,MinimumPos,
i : tIndex;
MinimumWert : integer;
procedure FeldMinimumPosUndWert (Feld : tFeld; von, bis:tIndex; MinPos:tIndex; MinWert : integer);
{ finds Position and value of the Minimums inside Feld between von and bis }
var
ind:tIndex;
begin
MinPos := von;
MinWert := Feld[von];
for ind := von + 1 to bis do
begin
if Feld[ind] < Feld[MinPos] then
begin
MinPos := ind;
MinWert := Feld[ind]
end;
end;
end; { FeldMinPosUndWert }
begin
{ Read the field }
writeln ('Please key in ', FELDGROESSE, ' numbers:');
for i := 1 to FELDGROESSE do
readln (SortierFeld[i]);
{ sort the field }
FeldMinimumPosUndWert (SortierFeld, i, FELDGROESSE, MinimumPos, MinimumWert);
{ prints the sorted field }
for i := 1 to FELDGROESSE do
write (SortierFeld[i]:6);
writeln;
readln;
end. { FeldSort }
Obviously you aren't getting anywhere with this, so I'll give a hint:
turn your function
function FeldMinimumPos (Feld : tFeld; von, bis:tIndex): tIndex;
into a procedure with:
procedure FeldMinimumPos(feld: TFeld; von, bis: TIndex; var pos: TIndex);
{ finds the position of the minimum inside the field between von and bis,
1 <= von <= bis <= FELDGROESSE }
var
j: TIndex;
begin
pos := von;
for j := von + 1 to bis do
if feld[j] < feld[pos] then
pos := j;
end; { FeldMinimumPos }
and call it with:
FeldMimimumPos(EingabeFeld, i, FELDGROESSE, MinPos);
and you should be fine.
A few remarks, though:
Your way of sorting is less than optimal, even for a field of only 5 elements. Learn about selection sort or even bubble sort (just google them).
Format your code properly. It is very hard to read. Put comments on their own line or after the code. Put every end on its own line and align it properly, don't put it after the previous command. Align your variable declarations, and start loops on their own line too. Etc...
You forgot a const above the FELDGROESSE declaration. The code you posted doesn't compile. Always post the actual code, copied from your editor and pasted (verbatim) into the edit box for your question (or answer). Do not post code from memory or by typing it off a screen or a sheet of paper.
I am trying to use the DSiGetHtmlFormatFromClipboard function from the well known DSiWin32 library.
Edit: There is a much newer version of DSIWin32.pas 1.94 from 2016-10-19 which is contained in the current version of OmniThreadLibrary_3.07.1. The one I've linked to in the first line of my question is much older: 1.66 from 2012-04-20. However, also in this newer version of DSIWin32.pas the function DSiGetHtmlFormatFromClipboard does not work although I've made sure that no other clipboard programs are running.
So I put some text on the clipboard which includes the HTML format e.g. by copying some text from Chrome web-browser.
And then I use this code to get the HTML format from the clipboard:
if DSiWin32.DSiIsHtmlFormatOnClipboard then
begin
CodeSite.Send('HTML-Format string:', DSiWin32.DSiGetHtmlFormatFromClipboard);
end;
While the DSiIsHtmlFormatOnClipboard function does work (it gives back True if there is HTML Format on the clipboard and gives back False if there is no HTML Format on the clipboard), the DSiGetHtmlFormatFromClipboard function always gives back an empty string although there is HTML Format in the clipboard:
So I debugged function DSiGetHtmlFormatFromClipboard: string; in DSiWin32.pas:
On this line:
hClipData := GetClipboardData(GCF_HTML);
hClipData is always 0, so the following code is not executed.
GetClipboardData is a function from Winapi.Windows and according to MSDN documentation:
Retrieves data from the clipboard in a specified format. The clipboard
must have been opened previously.
Which is the case in the DSiWin32 code.
So why does the DSiGetHtmlFormatFromClipboard always give back an empty string?
OS: Windows 7 x64
GetLastError retrieved immediately after the line hClipData := GetClipboardData(GCF_HTML);:
ERROR_CLIPBOARD_NOT_OPEN 1418 (0x58A) Thread does not have a
clipboard open.
This is strange because the preceding line is: Win32Check(OpenClipboard(0)); and it does not fail.
Here is the relevant parts of the MCVE:
var
GCF_HTML: UINT;
function DSiIsHtmlFormatOnClipboard: boolean;
begin
Result := IsClipboardFormatAvailable(GCF_HTML);
end; { DSiIsHtmlFormatOnClipboard }
function DSiGetHtmlFormatFromClipboard: string;
var
hClipData : THandle;
idxEndFragment : integer;
idxStartFragment: integer;
pClipData : PChar;
begin
Result := '';
if DSiIsHtmlFormatOnClipboard then
begin
Win32Check(OpenClipboard(0));
try
hClipData := GetClipboardData(GCF_HTML);
if hClipData = 0 then
RaiseLastOSError;
pClipData := GlobalLock(hClipData);
Win32Check(assigned(pClipData));
try
idxStartFragment := Pos('<!--StartFragment-->', pClipData); // len = 20
idxEndFragment := Pos('<!--EndFragment-->', pClipData);
if (idxStartFragment >= 0) and (idxEndFragment >= idxStartFragment) then
Result := Copy(pClipData, idxStartFragment + 20, idxEndFragment - idxStartFragment - 20);
finally GlobalUnlock(hClipData); end;
finally Win32Check(CloseClipboard); end;
end;
end; { DSiGetHtmlFormatFromClipboard }
procedure TForm1.Button1Click(Sender: TObject);
begin
if DSiIsHtmlFormatOnClipboard then
ShowMessage(DSiGetHtmlFormatFromClipboard)
else
ShowMessage('No HTML Format on Clipboard');
end;
initialization
GCF_HTML := RegisterClipboardFormat('HTML Format');
end.