I am using the latest version of Lazarus IDE and I have a Memo1 on my TForm1. I have to load a text file in Memo1 and then edit every line of the Memo (I use Memo1.Lines.Strings[i] := ...). At the end I must save the edited memo at a particular path.
Question: I am looking for the faster way between:
Load the whole text inside the memo, edit its content and save into a new file (load all -> edit all -> write all)
Do a while loop (until the end of my *.txt file) that reads the file line by line, edit the content and save it in the new file. (load line -> edit -> write | load -> edit -> write | load line -> edit -> write | ...)
I am pretty new with Delphi developing, and I have also read some pages about TStringLists. My text file is going to have a lot of lines (It could have 5000+ lines) and I don't want that my program loses performance.
Any suggestion? Should I use TStringList or one of the two methods I listed before?
5000 lines isn't a lot, unless the strings are very long.
The easiest way is to use a TStringList. There's no need to use a GUI control unless the user needs to see or edit the content.
var
SL: TStringList;
i: Integer;
begin
SL := TStringList.Create;
try
SL.LoadFromFile(YourFileNameHere);
for i := 0 to SL.Count - 1 do
begin
SL[i] := IntToStr(i) + ' ' + SL[i];
// Do any other processing
end;
SL.SaveToFile(YourFileNameHere);
finally
SL.Free;
end;
end;
If (as you say in a comment above) you need to do this in a TMemo for testing purposes, you can do it the same way:
Memo1.Lines.LoadFromFile(YourFileNameHere);
for i := 0 to Memo1.Lines.Count - 1 do
Memo1.Lines[i] := IntToStr(i) + ' ' + Memo1.Lines[i];
Memo1.Lines.SaveToFile(YourFileNameHere);
Of course, the easiest way to do this would be to write a procedure that accepts a plain TStrings descendent of any sort:
procedure AppendValueToStrings(const SL: TStrings;
StartingValue: Integer);
var
i: Integer;
begin
Assert(Assigned(SL)); // Make sure a valid TStrings has been passed in
for i := 0 to SL.Count - 1 do
begin
SL[i] := IntToStr(StartingValue) + ' ' + SL[i];
Inc(StartingValue);
end;
end;
Then you can call it with either one:
SL := TStringList.Create;
try
SL.LoadFromFile(YourFileNameHere);
AppendValueToStrings(SL, 10);
SL.SaveToFile(YourFileNameHere);
finally
SL.Free;
end;
Memo1.Lines.LoadFromFile(YourFileNameHere);
AppendValueToStrings(Memo1.Lines, 10);
Memo1.Lines.SaveToFile(YourFileNameHere);
Related
I have just installed Delphi Community Edition and thought as a newbie I was doing well until I hit the FindFirst() procedure.
What I have is a directory list:
c:\BFUtils\01Utils
\02Utils
\03Utils
\04Utils
Then, to try out FindFirst() to get the subdirectories of BFUtils, I wrote the following code, which I feel is needed to simply count the number of subdirectories:
sStartPath := 'c:\BFUtils';
Result := 0;
res := FindFirst(sStartPath, faDirectory, SearchRec);
if res = 0 then begin
try
while res = 0 do begin
if SearchRec.FindData.dwFileAttributes and faDirectory <> 0 then begin
Name := SearchRec.FindData.cFileName;
if (Name <> '.') and (Name <> '..') then begin
inc(Result);
end;
end;
res := FindNext(SearchRec);
end;
finally
FindClose(SearchRec);
end;
end;
This, as it is, compiles and runs, but it only finds the BFUtils directory.
Searching the Internet, I feel that the file mask (sStartPath) is not correct. So I have tried:
sStartPath + '\'
sStartPath + '\*'
sStartPath + '\*.'
sStartPath + '\*.*
All these options will compile and link without errors, but when the program runs it displays an error:
"'.'" is an Invalid Item.
What else can I try here?
In modnern Delphi versions you don't necessarily need to work with FindFirst, FindNext and FindClose directly anymore!
Add the unit System.IOUtils to a uses section in your unit.
There is, among some others, the record TDirectory:
Contains a large number of static utility methods used in directory manipulations.
TDirectory is a record containing only static methods used to perform
various operations on directories. You should not declare variables of
type TDirectory, since TDirectory has no instance methods or fields.
Possible operations that can be completed using TDirectory include:
Creating, renaming, and deleting directories.
Traversing directories (also recursively).
Manipulating directory attributes and timestamps.
For finding all subdirectories you can then use one of the overloaded GetDirectories methods:
Use GetDirectories to obtain a list of subdirectories in a given
directory. The return value of GetDirectories is a dynamic array of
strings in which each element stores the name of a subdirectory.
There are three forms of the GetDirectories method:
The first form only accepts the path of the directory for which subdirectories are enumerated.
The second form includes a search pattern used when matching subdirectory names.
The third form includes an option specifying whether a recursive mode will be used while enumerating.
So for counting all subdirectories you can simply do the following:
function SubDirCount(const Path: string): integer;
begin
result := Length(TDirectory.GetDirectories(Path));
end;
// somewhere else
ShowMessage(SubDirCount('C:\BFUtils').ToString);
And for your original code use this as a FileMask: sStartPath + '\.*'
You are asking FindFirst() to locate your c:\BFUtils folder itself. To enumerate the contents of that folder, you need to use a wildcard mask instead:
function CountSubDirs(const Path: string): Integer;
var
sMask: string;
SearchRec: TSearchRec;
res: Integer;
begin
Result := 0;
sMask := IncludeTrailingPathDelimiter(Path) + '*'; // or '*.*'
res := FindFirst(sMask, faDirectory, SearchRec);
if res <> 0 then
begin
if res <> ERROR_FILE_NOT_FOUND then
RaiseLastOSError(res);
end else
begin
try
repeat
if (SearchRec.FindData.dwFileAttributes and faDirectory) = faDirectory then
begin
if (StrComp(SearchRec.FindData.cFileName, '.') <> 0) and
(StrComp(SearchRec.FindData.cFileName, '..') <> 0) then
begin
Inc(Result);
end;
end;
res := FindNext(SearchRec);
until res <> 0;
if res <> ERROR_NO_MORE_FILES then
RaiseLastOSError(res);
finally
FindClose(SearchRec);
end;
end;
end;
var NumSubDirs: Integer;
NumSubDirs := CountSubDirs('c:\BFUtils');
That has always worked fine for me. If it is not working for you, then something else is wrong with code you have not shown yet, as there is nothing in the code actually shown that can cause the "'.'" is an Invalid Item error message you claim.
I have a total of 3214 .doc. I need to open the first file, copy its contents, paste it in a RichEdit, extract some text, insert it into a database then move on to the next file and repeat the procedure.
So far I've managed to:
Open the 1st .doc/any 1 .doc only
Copy the content and paste it in the RichEdit
Extract the text from the RichEdit
Insert the extracted text into the database
Close the opened .doc and clear the content of RichEdit
I've loaded all 3214 filenames, in order, into a Memo.
Once I finish with the 1st file from the list, how do I now make it move to the next .doc from the list and do the same thing, repeating this till I finish all the 3214 .doc files? Currently reading about loops but I can't figure it out yet.
Code so far:
procedure TForm1.Button4Click(Sender: TObject);
var
content: string;
StartPos: Integer;
endPos: Integer;
i: integer;
fname: string;
WordApp : Variant;
begin
WordApp := CreateOleObject('Word.Application');
for i := 1 to 1 do
fname := Memo1.Lines[i - 1];
WordApp.Visible := True;
WordApp.Documents.Open('C:\Users\tcsh\Desktop\all\'+fname);
WordApp.ActiveDocument.Select;
WordApp.Selection.Copy;
RichEdit1.Lines.Add(WordApp.Selection);
WordApp.documents.item(1).Close;
WordApp.Quit;
content:= RichEdit1.Text;
//<text extract code is here>
begin
//<sql code is here>
end;
RichEdit1.Clear;
Edit1.Clear;
Edit2.Clear;
Edit3.Clear;
Edit4.Clear;
Edit5.Clear;
Edit7.Clear;
Edit8.Clear;
//the TEdit's hold the extracted text so the sql can retrieve it from them and insert into the database
end;
for i := 1 to 1 do
Hmmm, that will only run once..
You may also want to try:
Create the WordApp object in each iteration ,
Add a time delay in between each iteration (using Sleep and Application.ProcessMessages) (as LU RD points out this is not necessary)
Code sample below:
for i := 0 to Memo1.Lines.Count - 1 do
begin
WordApp := CreateOleObject('Word.Application');
fname := Memo1.Lines[i];
WordApp.Visible := True;
WordApp.Documents.Open(fname);
WordApp.ActiveDocument.Select;
WordApp.Selection.Copy;
Memo2.Lines.Add(WordApp.Selection);
Memo2.Lines.Add('===');
WordApp.documents.item(1).Close;
WordApp.Quit;
//Sleep(1000); -> not needed
//Application.ProcessMessages;
end;
Try it with System.IOUtils.TDirectory.GetFiles
GetFiles('C:\temp\', '*.doc');
Here is an example
You'll find a few here on SO.
Update
...
var
line: string;
...
for line in Memo1.Lines do begin
<your code per file>
ShowMessage(line);
end
Im working in a Tdbadvgrid from TMS. I am adding colums dynamically based on a sql query length. Everything works great, with the exception of the column width saving.
Adding the columns:
//Captions
for i := 0 to oRow.Count - 1 do
begin
grdFieldData.Columns.Insert(1);
grdFieldData.Cells[i + 1, 0] := TabelList.Captions[i].Caption;
end;
//Data
for r := 0 to TabelList.Count - 1 do //rows
begin
for c := 0 to oRow.Count - 1 do //cols
begin
grdFieldData.Cells[c+1, r+1] := TabelList.Rows[r].Fields[c].Value;
end;
if r <> TabelList.Count - 1 then
grdFieldData.RowCount := grdFieldData.RowCount + 1;
end;
Now the save function is built into the TMS TDBAdvGrid, and looks like this:
I have tried messing with all the options with no luck.
The table has 1 fixed row (for captions) and one empty row. The row is only there because the number of fixed rows must be smaller then the number of rows.
When saving the data to either .ini file or to registry, it saves and loads the first column, but the dynamicly added ones get written in as default value (64) but never saved/loaded when i drag them to adjust size. The .ini file table looks like this:
[Recept]
Col0=20
Col1=97
Col2=64
Col3=64
Col4=64
Col5=64
Col6=64
Col7=64
Col8=64
Col9=64
Col10=64
Col11=64
Col12=64
Col13=64
Col14=64
When loaded in it looks like this:
Does anyone know what I can do to make the columns save properly so the widths will be saved?
So, after a few hours of sitting with it, I decided that there was no reason to struggle so much with something built in when I could just build something simple myself.
In this instance, it simply saves to a chosen ini file at a chosen directory. The filename and directory are currently hardcoded to each inhreited class. A feature to change them could easily be implemented. Perhaps even a directory selecter to a button or something like it.
The code for loading (called on FormShow):
procedure TfrmReceptEditor.LoadColWidths;
var
Ini: TIniFile;
i: Integer;
path: String;
filename: String;
begin
inherited;
path := 'C:\';
filename := 'grid.ini';
Ini := TIniFile.Create(path + filename);
try
for i := 0 to grdFieldData.ColCount - 1 do
begin
grdFieldData.Columns.Items[i].Width := Ini.ReadInteger('Recept','col'+IntToStr(i),75);
end;
grdFieldData.FixedColWidth := 20;
finally
Ini.Free;
end
end;
And the code for saving the data (on FormClose):
procedure TfrmReceptEditor.SaveColWidths;
var
Ini: TIniFile;
i: Integer;
path: String;
filename: String;
begin
inherited;
path := 'C:\';
filename := 'grid.ini';
Ini := TIniFile.Create(path + filename);
try
for i := 0 to grdFieldData.ColCount - 1 do
begin
Ini.WriteInteger('Recept', 'col'+IntToStr(i), grdFieldData.Columns.Items[i].Width);
end;
finally
Ini.Free;
end;
end;
Some might want to build in features to check if the Ini files exists (aka if the entered path is correct). But it will work smoothly even if the file doesnt exist, it will simply create it.
I pass the parameter value '*1.dat' to FindFirst, still the first file that the FindFirst() routine return is 46checks5.dat, very consistently.
Is this a known problem?
vpath:=trim(vpath);
result:=true;
try
res:=findfirst(vpath+'\'+vmask,faarchive,search); //vmask = *1.dat
try
while res=0 do
begin
vlist.add(search.name); //searchname returned is 46checks5.dat!!!
res:=findnext(search);
end;
finally
findclose(search);
end;
except
result:=false;
end;
The reason is that the file has a "long" name, i.e. with more than 8 characters. For such files Windows also creates "short" names, that usually are created in the form longna~1.dat and this short name is found via *1.dat wildcard.
You can easily reproduce the same behaviour in command prompt in an empty directory:
C:\TEMP>echo. > 46checks5.dat
C:\TEMP>dir /x *1.dat
Volume in drive C has no label.
Volume Serial Number is 5C09-D9DE
Directory of C:\TEMP
2011.04.15 21:37 3 46CHEC~1.DAT 46checks5.dat
1 File(s) 3 bytes
The documentation for FindFirstFile(), which is the underlying API for FindFirst states:
The search includes the long and short
file names.
To workaround this issue, then, rather than using Delphi's wrapper to FindFirstFile(), call the Win32 API FindFirstFileEx(). Pass FindExInfoBasic to the fInfoLevelId parameter.
You have something else wrong.
I created a folder C:\Temp\Test, and put three files in it:
TestFile1.txt
TestFile2.txt
TestFile3.txt
I then dropped a TMemo on a new blank form in a new project, and added this code to the 'FormCreate' event:
procedure TForm1.FormCreate(Sender: TObject);
var
sPath: string;
sFile: string;
SR: TSearchRec;
begin
sPath := 'C:\Temp\Test';
sFile := '*1.txt';
Memo1.Lines.Clear;
if FindFirst(sPath + '\' + sFile, faArchive, SR) = 0 then
begin
try
repeat
Memo1.Lines.Add(SR.Name);
until FindNext(SR) <> 0;
finally
FindClose(SR);
end;
end;
end;
When the form was shown, the TMemo showed exactly one file, TestFile1.txt, just as I would expect.
In my application I need to copy over 1000 small files
Here is the code I am using but it is VERY SLOW
Is there a better way of doing this ?
procedure Tdatafeeds.RestotreTodaysFiles;
var
SearchRec: TSearchRec;
FromFn, ToFn: string;
Begin
if DirectoryExists(BackupPath1) then
begin
try
if FindFirst(BackupPath1 + '\*.*', (faAnyFile AND NOT(faDirectory)), SearchRec) = 0 then
begin
repeat
FromFn := BackupPath1 + '\' + SearchRec.name;
ToFn := DatafeedsPath1 + '\' + SearchRec.name;
CopyFile(Pchar(FromFn), Pchar(ToFn), false);
until FindNext(SearchRec) <> 0;
end;
finally
FindClose(SearchRec);
end;
end;
End;
Definitely go with SHFileOperation() as suggested above, CopyFile is way too slow for that many files. It looks like you are basically restoring an entire folder so the search function may be unnecessary and slow things down further. Something like this may be of help:
uses ShellApi;
function CopyDir(const fromDir, toDir: string): Boolean;
var
fos: TSHFileOpStruct;
begin
ZeroMemory(#fos, SizeOf(fos));
with fos do
begin
wFunc := FO_COPY;
fFlags := FOF_FILESONLY;
pFrom := PChar(fromDir + #0);
pTo := PChar(toDir)
end;
Result := (0 = ShFileOperation(fos));
end;
This function will raise a prompt to overwrite existing files though (maybe it can be tweaked to skip that) but the user can select "All" so it's a one-click procedure, much faster, has a progress bar and can be canceled if desired.
You can use the SHFileOperation() API call and use a wildcard in the file name of the struct. That way one call would be used to copy all of the files in one go. There's even the possibility to show the progress (via a callback function) and allow the user to cancel the operation.
I can't test your code right now, but check out this corrected version
// (!) faAnyFile-faDirectory <--- this is wrong
// we don't subtract flag values because the value will be meaningless
if FindFirst(BackupPath1 + '\*.*', faAnyFile, SearchRec) = 0 then
begin
repeat
if not (SearchRec.Attr and faDirectory)
And SearchRec.Name <> "."
And SearchRec.Name <> ".." Then
Begin
FromFn := BackupPath1 + '\' + SearchRec.name;
ToFn := DatafeedsPath1 + '\' + SearchRec.name;
CopyFile(Pchar(FromFn), Pchar(ToFn), false);
End;
until FindNext(SearchRec) <> 0;
FindClose(SearchRec);
end;
Perhaps you might experiment with reading a bunch of files into memory and then writing them all to disk at once (like XCOPY). That might be nicer on the filesystem.