i have made this piece of code while trying to get split one string into 2 pieces which i would save onto database later. For now i have succeed with geting 3 word string like " word word number" into 3 fields but when im trying to split string with only 1 word and number like "word number" into 2 fields i got error message which i cant understand.
procedure Split
(const Delimiter: Char;
Input: string;
const Strings: TStrings) ;
begin
Assert(Assigned(Strings)) ;
Strings.Clear;
Strings.Delimiter := Delimiter;
Strings.DelimitedText := Input;
end;
procedure TForm2.Button64Click(Sender: TObject);
var
A: TStringList; i,c:integer;
begin
c:=0;
//for i:= 0 to ListBox1.Items.Count do
//begin
A := TStringList.Create;
// try
// Split(' ',listbox1.Items.Strings[0], A) ;
Split(' ',ListBox1.Items.Strings[ListBox1.ItemIndex], A) ;
// finally
// A.Free;
for i := 48 to 57 do
if A[1]<>char(i) then
c:=1
else
if A[1]=char(i) then
c:=2;
if c=1 then
begin
edit81.Text:=(A[0]+' '+A[1]);
edit82.Text:=A[2];
end
else
if c=2 then
begin
edit81.Text:=A[0];
edit82.Text:=A[1];
end;
end;
the error message is:
First chance exception at $7C812FD3. Exception class EStringListError with message 'List index out of bounds (2)'. Process paligs.exe (732)
Im trying to get all words from string in edit81 field and numbers in edit 82 field.
my image from form: http://i.stack.imgur.com/7vnS8.jpg
The most important thing for you to learn here is how to interpret the error messages that the compiler produces. Sometimes they don't help that much, but in this case the messages tells you all you need to know.
The error message is:
List index out of bounds (2)
That means that you are accessing element 2 of the list and that element two does not exist. This means that the list has a could of 0 or 1. When you write A[2], the list raises an exception because A[2] does not exist.
This is entirely to be expected. If you split 'word number' then the result is:
A[0] = 'word'
A[1] = 'number'
and there is no element indexed 2.
The reason that your code accesses A[2] can be found here:
for i := 48 to 57 do
if A[1]<>char(i) then
c:=1
else
if A[1]=char(i) then
c:=2;
Clearly 'number' is never equal to char(i) for any value of i and so set c to be 1. Which then leads to this code executing:
if c=1 then
begin
edit81.Text:=(A[0]+' '+A[1]);
edit82.Text:=A[2]; // BOOM!
end
Related
I am trying to write a procedure that counts all the words in a text file in Pascal. I want it to handle multiple space characters, but I have no idea how to do it.
I tried adding a boolean function Space to determine whether a character is a space and then do
while not eof(file) do
begin
read(file,char);
words:=words+1;
if Space(char) then
while Space(char) do
words:=words;
but that doesnt work, and basically just sums up my(probably bad) idea about how the procedure should look like. Any ideas?
Basically, as Tom outlines in his answer, you need a state machine with the two states In_A_Word and Not_In_A_Word and then count whenever your state changes from Not_In_A_Word to In_A_Word.
Something along the lines of (pseudo-code):
var
InWord: Boolean;
Ch: Char;
begin
InWord := False;
while not eof(file) do begin
read(file, Ch);
if Ch in ['A'..'Z', 'a'..'z'] then begin
if not InWord then begin
InWord := True;
Words := Words + 1;
end;
end else
InWord := False
end;
end;
Use a boolean variable to indicate whether you are processing a word.
Set it true (and increment the counter) on first only non-space character.
Set it false on a space character.
Another method could be to read whole file in one string and then use following steps to count words:
{$mode objfpc}
uses sysutils;
var
fullstr: string = 'this is a test string. ';
ch: char;
count: integer=0;
begin
{trim string- remove spaces at beginning and end: }
fullstr:= trim(fullstr);
{replace all double spaces with single: }
while pos(' ', fullstr) > 0 do
fullstr := stringreplace(fullstr, ' ', ' ', [rfReplaceAll, rfIgnoreCase]);
{count spaces: }
for ch in fullstr do
if ch=' ' then
count += 1;
{add one to get number of words: }
writeln('Number of words: ',count+1);
end.
The comments in above code explain the steps.
Output:
Number of words: 5
I have a text file with user information stored in it line by line. Each line is in the format: UserID#UserEmail#UserPassword with '#' being the delimiter.
I have tried to use this coding to perform the task:
var sl:TStringList;
begin
sl:=TStringList.Create;
sl.LoadFromFile('filename');
sl.Delete(Index);
sl.SaveToFile('filename');
sl.free;
end;
But I'm not sure what to put in the "index" space.
Is there any way I can receive the User ID as input and then delete the line of text from the text file that has this user ID in? Any help would be appreciated.
You can set the NameValueSeparator to # then use IndexOfName to find the user, as long as the username is the first value in the file.
sl.NameValueSeparator := '#';
Index := sl.IndexOfName('455115')
So in your example, like so
var sl:TStringList;
begin
sl:=TStringList.Create;
sl.LoadFromFile('filename');
sl.NameValueSeparator := '#';
Index := sl.IndexOfName('455115')
if (Index <> -1) then
begin
sl.Delete(Index);
sl.SaveToFile('filename');
end;
sl.free;
end;
This may be slow on large files as IndexOfName loops though each line in the TStringList and checks each string in turn until it finds a match.
Disclaimer: Tested/ works with Delphi 2007, Delphi 7 may be diffrent.
I don't see why so many people make this so hard. It is quite simple:
function ShouldDeleteLine(const UserID, Line: string): Boolean;
begin
// Remember: Pos(Needle, Haystack)
Result := Pos(UserID + '#', Line) = 1; // always 1-based!
end;
procedure DeleteLinesWithUserID(const FileName, UserID: string);
var
SL: TStringList;
I: Integer;
begin
if not FileExists(FileName) then
Exit;
SL := TStringList.Create;
try
SL.LoadFromFile(FileName); // Add exception handling for the
// case the file does not load properly.
// Always work backward when deleting items, otherwise your index
// may be off if you really delete.
for I := SL.Count - 1 downto 0 do
if ShouldDeleteLine(SL[I], UserID) then
begin
SL.Delete(I);
// if UserID is unique, you can uncomment the following line.
// Break;
end;
SL.SaveToFile(FileName);
finally
SL.Free;
end;
end;
As Arioch'The says, if you save to the same file name, you risk losing your data when the save fails, so you can do something like
SL.SaveToFile(FileName + '.dup');
if FileExists(FileName + '.old') then
DeleteFile(FileName + '.old');
RenameFile(FileName, FileName + '.old');
RenameFile(FileName + '.dup', FileName);
That keeps a backup of the original file as FileName + '.old'.
Explanations
Working backward
Why work backward? Because if you have the following items
A B C D E F G
^
And you delete the item at ^, then the following items will shift downward:
A B C E F G
^
If you iterate forward, you will now point to
A B C E F G
^
and E is never examined. If you go backward, then you will point to:
A B C E F G
^
Note that E, F and G were examined already, so now you will indeed examine the next item, C, and you won't miss any. Also, if you go upward using 0 to Count - 1, and delete, Count will become one less and at the end, you will try to access past the boundary of the list. This can't happen if you work backwards using Count - 1 downto 0.
Using + '#'
If you append '#' and test for Pos() = 1, you will be sure to catch the entire UserID up to the delimiter, and not a line with a user ID that only contains the UserID you are looking for. IOW, if UserID is 'velthuis', you don't want to delete lines like 'rudyvelthuis#rvelthuis01#password' or 'velthuisresidence#vr#password2', but you do want to delete 'velthuis#bla#pw3'.
E.g. when looking for a user name, you look for '#' + UserName + '#' for the same reason.
There is the only way to actually "delete a line from the text file" - that is to create a new file with changed content, to REWRITE it.
So you better just do it explicitly.
And don't you forget about protecting from errors. Your current code might just destroy the file and leak memory, if any error occurs...
var sl: TStringList;
s, prefix: string;
i: integer; okay: Boolean;
fs: TStream;
begin
prefix := 'UserName' + '#';
okay := false;
fs := nil;
sl:=TStringList.Create;
Try /// !!!!
sl.LoadFromFile('filename');
fs := TFileStream.Create( 'filename~new', fmCreate or fmShareExclusive );
for i := 0 to Prev(sl.Count) do begin
s := sl[ i ];
if AnsiStartsStr( prefix, Trim(s) ) then
continue; // skip the line - it was our haunted user
s := s + ^M^J; // add end-of-line marker for saving to file
fs.WriteBuffer( s[1], length(s)*SizeOf(s[1]) );
end;
finally
fs.Free;
sl.Free;
end;
// here - and only here - we are sure we successfully rewritten
// the fixed file and only no are able to safely delete old file
if RenameFile( 'filename' , 'filename~old') then
if RenameFile( 'filename~new' , 'filename') then begin
okay := true;
DeleteFile( 'filename~old' );
end;
if not okay then ShowMessage(' ERROR!!! ');
end;
Note 1: See if check for username should be case-sensitive or case-ignoring:
http://www.freepascal.org/docs-html/rtl/strutils/ansistartsstr.html
http://www.freepascal.org/docs-html/rtl/strutils/ansistartstext.html
Note 2: in Delphi 7 SizeOf( s[1] ) is always equal to one because string is an alias to AnsiString. But in newer Delphi version it is not. It might seems tedious and redundant - but it might save a LOT of headache in future. Even better would be to have a temporary AnsiString type variable like a := AnsiString( s + ^m^J ); fs.WriteBuffer(a[1],Length(a));
So far everyone has been suggesting the use for a For..Then Loop but can I suggest a Repeat..While.
The traditional For..Loop is a good option but could be inefficient if you have a long list of Usernames (they are usually unique). Once found and deleted the For Loop continues until the end of the list. That's ok if you have a small list but if you have 500,000 Usernames and the one you want is at position 10,000 there is no reason to continue beyond that point.
Therefore, try this.
Function DeleteUser(Const TheFile: String; Const TheUserName: String): Boolean;
Var
CurrentLine: Integer;
MyLines: TStringlist;
Found: Boolean;
Eof: Integer;
Begin
MyLines := TStringlist.Create;
MyLines.LoadFromFile(TheFile);
CurrentLine := 0;
Eof := Mylines.count - 1;
Found := false;
Repeat
If Pos(UpperCase(TheUserName), UpperCase(MyLines.Strings[CurrentLine])) = 1 Then
Begin
MyLines.Delete(CurrentLine);
Found := True;
End;
Inc(CurrentLine);
Until (Found) Or (CurrentLine = Eof); // Jump out when found or End of File
MyLines.SaveToFile(TheFile);
MyLines.Free;
result := Found;
End;
Once called the function returns True or False indicating the Username was deleted or not.
If Not DeleteUsername(TheFile,TheUsername) then
ShowMessage('User was not found, what were you thinking!');
Just for fun, here's a compact solution, which I like for its readability.
const fn = 'myfile.txt';
procedure DeleteUser(id: integer);
var s:string; a:TStringDynArray;
begin
for s in TFile.ReadAllLines(fn) do
if not s.StartsWith(id.ToString + '#') then
a := a + [s];
TFile.WriteAllLines(fn, a);
end;
Obviously it's not the most efficient solution. This could run faster by not appending single items to the array, or by caching the search string.
And to search for other fields, you could use s.split(['#'])[0] to find the username, s.split(['#'])[1] for email, etc.
For those who like one-liners. This works too:
const fn = 'users.txt';
procedure DeleteUserRegExp(id: string);
begin
TFile.WriteAllText(fn,TRegEx.Replace(TFile.ReadAllText(fn),''+id+'\#.*\r\n',''))
end;
Explanation
It loads the content of a file into a string.
The string is sent to TRegEx.Replace
The regular expression searches for the username followed by the hash sign, then any character, and then a CRLF. It replaces it with an empty string.
The resulting string is then written to the original file
This is just for fun though, because I saw long code where I thought that this would be possible with a single line of code.
When compiling the following code:
procedure TMainWin.FormActivate(Sender: TObject);
var LineRaw : String;
LinesFile : TextFile;
i, i2 : integer;
tempChar : String;
CurTempCharPos : integer;
begin
AssignFile(LinesFile, 'Lines.txt');
Reset(LinesFile);
i := 0;
tempChar := '';
CurTempCharPos := 1;
while not EoF(LinesFile) do begin
i := i+1; //ticker
ReadLn(LinesFile, LineRaw);
for i2 := 0 to 4 do begin
tempChar := LineRaw[CurTempCharPos] + LineRaw[CurTempCharPos +1];
Lines[i,i2] := IntToStr(tempChar);
tempChar := '';
CurTempCharPos := CurTempCharPos + 3;
end;
end;
CloseFile(LinesFile);
end;
With Lines being defined in another form:
unit uGlobal;
interface
type
aLines = array[1..5] of integer;
aLinesFinal = array of aLines;
var
Lines : aLinesFinal;
implementation
end.
I get the following error: There is no overloaded version of 'IntToStr' that can be called with these arguments. The error points to the line:
Lines[i,i2] := IntToStr(tempChar);
Here is the declaration of tempChar:
tempChar : String;
It is a string. And here is the call that the compiler rejects:
Lines[i,i2] := IntToStr(tempChar);
The IntToStr function, which has various overloads, accepts integer input parameters and returns strings. You cannot pass a string to IntToStr. Perhaps you meant to write:
Lines[i,i2] := StrToInt(tempChar);
Some other comments:
I doesn't look like you initialised Lines. This means that whilst the code might compile, it will fail at runtime.
Since you declared aLines as array[1..5] of integer, the valid values for i2 are 1 to 5 inclusive. You use 0 to 4 inclusive. Again, that's going to bite at runtime.
You really should enable range checking as a matter of urgency, since when you start executing this code that setting will reveal the errors above, and no doubt more besides.
In my view tempChar is a poor name for something that can hold more than a single character.
As #TLama points out, OnActivate seems to be an unusual place to execute this code. This event will run multiple times. Perhaps you should be executing this code at start up. In any case, code like this should not be in an event handler and should be moved to a separate method which an event handler can call.
I have written a program in Delphi to compute, display and save a Pascals' triangle for a user-defined number of rows. It works fine (displays the triangle, and allows me to save it), except that it comes up with an access violation at the end! Here is the message:
Access violation at address 004031DB in module 'Project1.exe'. Read of address 00000000.
I have a 2D dynamic array in the procedure but I release the memory at the end (:= nil). Why is it still giving me an access violation? Very frustrating!
I searched the archives for an answer but could not find an appropriate answer. Any help will be greatly appreciated.
Here is the code (I was a little hesitant as there is a bit of code:
procedure TForm1.btnPTClick(Sender: TObject);
var
I, J, K, N, MidCol: integer;
PT: array of array of integer;
Row: string;
begin
K := StrToInt(lblNumRows.Text);
N := StrToInt(lblNumRows.Text);//# values in row = row number
try
//initiatlize the array
SetLength(PT, K, (N*2)-1);
for I := 0 to K-1 do
for J := 0 to (N*2-1) do
PT[I,J] := 0;
MidCol := (N*2 div 2)-1;//MidCol already 0-based
for I := 0 to K-1 do
begin
if (I = 0) then
PT[I,MidCol] := 1//first row gets 1 in the middle column
else if I = 1 then
begin
PT[I,MidCol-1] := 1;
PT[I,MidCol+1] := 1; //first and last value in second = 1
end
else //if any other row
begin
//Middle column
PT[I, MidCol] := PT[I-1,MidCol-1] + PT[I-1,MidCol+1];
//right triangle
for J := MidCol+1 to (N*2-1) do
begin
if (PT[I-1, J-1]=1) then//if already at the end of prev row
begin
PT[I,J] := 1;
break;
end
else
PT[I,J] := PT[I-1,J-1] + PT[I-1,J+1];
end;
//left triangle
for J := MidCol-1 downto 0 do
begin
if (PT[I-1, J+1] = 1) then //if already at the end of prev row
begin
PT[I,J] := 1;
break;
end
else
PT[I,J] := PT[I-1,J-1] + PT[I-1,J+1];
end;
end;
end;
//now add the pyramid to the memo
Application.ProcessMessages;
for I := 0 to K-1 do
begin
Row := '';
for J := 0 to N*2-1 do
begin
if (PT[I,J] = 0) then Row := Row + ' '
else Row := Row + IntToStr(PT[I,J]);
end;
Memo.Lines.Add(Row);
end;
finally
SetLength(PT, 0, 0);
end;
end;
Read of address 00000000
This indicates that you are trying to access memory using a pointer that is nil. To know why that is so one would need code. At present only you have code, and so only you can explain.
Run the program in the debugger. Enable Debug DCUs in case the error is raised in RTL/VCL code. Ensure that the debugger is configured to break on exceptions. The run your program and trigger the error. The debugger will show you which nil object is being de-referenced. Then you have to work out why that reference is nil.
The code you have added to the answer has a buffer overrun which could certainly explain the problem. Your SetLength is incorrect and should read:
SetLength(PT, K, N*2);
Your code writes to memory out-of-bounds and so corrupts the heap. You should ask the compiler to produce runtime checks on your array bounds. Enable the compiler's range checking option. Had you done so, you would have found this error yourself.
For what it is worth you do not need that try/finally block since the compiler will automatically insert a hidden block. There's no need for two when one suffices. A dynamic array is a managed type whose memory is disposed when the variable leaves scope.
Press F7, to start the project in the debugger.
Look in the main menu for the "Find Error..." option (in Delphi 7 it was under the Search menu)
then enter the address from the exception: 004031DB.
This will show you the exact line where the exception occurred.
Read of address 00000000 generally indicates you are using a pointer that has a nil value.
I'm playing around with the comp 1 pre release material, but I can't seem to asnwer this properly in Pascal compiling in delphi...
This question refers to the function RollBowlDie.
This function has no validation of the input value.
What you have to do....
Make a copy of the Skeleton Program. Add additional statements to the function RollBowlDie so that it ensures that the input BowlDieResult is in the range 1 to 6 before allowing the game to continue and outputs an error message if not.
Add further statements to the function RollBowlDie so that it also checks that the input
BowlDieResult does not cause the program to crash if it is the wrong data type and instead outputs an error message when this is detected.
Test the amended function to show that it does not allow inputs that are out of range.
Test the amended function to show that it does not crash if an incorrect data type is added.
This is the RollBowlDie function.
Function RollBowlDie(VirtualDiceGame : Boolean) : Integer;
Var
BowlDieResult : Integer;
Begin
If VirtualDiceGame
Then BowlDieResult := Random(6) + 1
Else
Begin
Writeln('Please roll the bowling die and then enter your result.');
Writeln;
Writeln('Enter 1 if the result is a 1');
Writeln('Enter 2 if the result is a 2');
Writeln('Enter 3 if the result is a 4');
Writeln('Enter 4 if the result is a 6');
Writeln('Enter 5 if the result is a 0');
Writeln('Enter 6 if the result is OUT');
Writeln;
Write('Result: ');
Readln(BowlDieResult);
Writeln;
End;
RollBowlDie := BowlDieResult;
End;
I have tried putting this in, but the message error message didnt come up, and the program crashed when trying in a letter.
Function RollBowlDie(VirtualDiceGame : Boolean) : Integer;
Var
BowlDieResult : Integer;
Begin
If VirtualDiceGame
Then BowlDieResult := Random(6) + 1
Else
Begin
Repeat
Writeln('Please roll the bowling die and then enter your result.');
Writeln;
Writeln('Enter 1 if the result is a 1');
Writeln('Enter 2 if the result is a 2');
Writeln('Enter 3 if the result is a 4');
Writeln('Enter 4 if the result is a 6');
Writeln('Enter 5 if the result is a 0');
Writeln('Enter 6 if the result is OUT');
Writeln;
Write('Result: ');
Try
Readln(BowlDieResult)
Except
Writeln('Not a valid number')
End;
Writeln;
Until (BowlDieResult >= 1) and (BowlDieResult <= 6);
End;
RollBowlDie := BowlDieResult;
End;
I's not sure how to solve the question, any help would be appreciated greatly!
Probably you need to read a string or a char-typed variable instead of an integer one, and then convert the string/char to integer in an controlled way.
Of course it crashes if you type in a letter ... you're specifically asking to
read an integer, and a letter isn't an integer.
Before commenting more on that issue, why not just say:
writeln ('Please enter the number rolled, or 0 if it is an OUT: ');
rather than having 6 writelns? Also, what if a 3 or 5 was rolled (you're only
giving (somewhat odd) directions for the values 1, 2, 4, 6, and 0 ... leaving
out 3 and 5. Keep in mind that you can't get a 0 from "BowlDieResult := Random(6) + 1".
How do you intend the user to indicate "stop" if you're looping until you have
a value between 1 and 6?
Back to the "how do I read a letter" question...
Use a variable of type "char" (or "packed array of char") to read arbitrary text ...
then, compare the character read to '1', '2', ..., '6', or (say) 'Q' (for Quit).
E.g.:
var
answer : char;
attempts : integer; {prevent infinite loop}
done : boolean;
attempts := 0;
saw_quit := false;
done := false; {loop until we get a good number or a QUIT command}
{Or until 9 attempts have been made to enter a #. }
while not done do
begin
writeln ('Please enter a number (1..6) or Q to quit: ');
readln (answer);
if answer in ['1'..'6'] then
begin {we got a number in range 1..6...}
BowlDieResult := ord (answer) - ord ('0'); {convert char to int}
done := true;
end
else if answer in ['Q', 'q'] then {upper or lower case :) }
begin
saw_quit := true;
done := true;
end
else
begin
writeln ('Sorry, that is not a number from 1 to 6 or a "Q"!');
attempts := attempts + 1;
if attempts > 9 then
begin
writeln ('Sorry, too many mistakes ... assuming QUIT');
saw_quit := true;
done := true;
end;
end;
end; {while not done}
Note: the above not tested for compilation ... I NEVER use Pascal's built-in I/O,
for performance and reliability reasons, so I'm rusty with it.
Note: see http://www.allegro.com/papers/htpp.html
for some philosophy of Pascal programming.
Stan