I am reading and writing data from a file using a filestream but am having a problem reading strings from my file.
In a test VCL form program I have written:
procedure tform1.ReadfromFile4;
var
fs: TFileStream;
arrayString: Array of String;
i, Len1 : Cardinal;
// s : string;
begin
fs := TFileStream.Create('C:\Users\Joe\Documents\Delphi\Streamtest.tst',
fmOpenRead or fmShareDenyWrite);
Memo1.lines.clear;
try
fs.ReadBuffer(Len1, SizeOf(Len1));
SetLength(arrayString, Len1);
FOR i := 0 to Len1-1 do begin
fs.ReadBuffer(Len1, SizeOf(Len1));
SetLength(arrayString[i], Len1);
Fs.ReadBuffer(arrayString[i], Len1);
memo1.lines.add (arrayString[i]);
end;
finally
fs.free;
end;
end;
procedure tform1.WriteToFile4;
var
fs: TFileStream;
arrayString: Array of String;
Len1, c, i: Cardinal;
begin
Memo1.lines.clear;
SetLength(arrayString, 4);
arrayString[0] := 'First string in this Array';
arrayString[1] := 'the Second Array string';
arrayString[2] := 'String number three of this Array';
arrayString[3] := 'this is the fourth String';
fs := TFileStream.Create('C:\Users\Joe\Documents\Delphi\Streamtest.tst',
fmCreate or fmOpenWrite or fmShareDenyWrite);
try
c := Length(arrayString);
Fs.WriteBuffer(c, SizeOf(c));
for i := 0 to c-1 do begin
Len1 := Length(arrayString[i]);
fs.WriteBuffer(Len1, SizeOf(Len1));
if Len1 > 0 then begin
fs.WriteBuffer(arrayString[i], Len1);
end;
end;
finally
fs.free;
end;
end;
The Save button action enters the four strings correctly, but the Load button (readFromFile4) fails to load the strings from the file. Using the Watch list, I find that the string lengths are set correctly for each string, but the data accessed is not the correct string values. I believe I am faithfully following the instructions on the website : http://www.angelfire.com/hi5/delphizeus/customfiles.html]1 in the section titled
Writing and Reading Dynamic Arrays of Non-Fixed Size Variables
Can anyone shed light on why this does not read the strings from the file correctly?
Related
I have a string containing letters, numbers and other chars.
I want to remove from that string all numbers, dots and commas
Before: 'Axis moving to new position - X-Pos: 5.4mm / Y-Pos: 3.5mm'
After: 'Axis moving to new position - X-Pos mm / Y-Pos mm'
Unfortunately string.replace() only replaces one character. So I need several lines.
How can I avoid writing every replacement line by line?
sString := sString.Replace('0', '');
sString := sString.Replace('1', '');
sString := sString.Replace('2', '');
sString := sString.Replace('3', '');
sString := sString.Replace('3', '');
...
sString := sString.Replace(':', '');
sString := sString.Replace('.', '');
Although the OP's own solution is fine, it is somewhat inefficient.
Just for completeness, here's a slightly more optimized version:
function RemoveCharsFromString(const AString, AChars: string): string;
begin
SetLength(Result, AString.Length);
var ActualLength := 0;
for var i := 1 to AString.Length do
begin
if SomePredicate(AString[i]) then
begin
Inc(ActualLength);
Result[ActualLength] := AString[i];
end;
end;
SetLength(Result, ActualLength);
end;
The algorithm is independent of the particular predicate. In this case, the predicate is Pos(AString[i], AChars) = 0.
There are multiple ways of how you can approach this. Here are three solution.
Solution 1
You can go and simply loop though the source string checking each character to se if it is one of the characters that needs to be removed.
//Simple function that loops through all characters of the source strings removing them one by one
//It is manipulating the same string all the time
function Removechars1(sourceString: string; sCharsToBeRemoved: string):string;
var I: Integer;
begin
//Assign value of the source string to the result so we can work with result strin from now on
result := SourceString;
//Loop throught the whole result sring starting at end searching for characters to be removed
//We start at the end because when we will be removing characters from the string its length
//will be decreasing.
for I := Length(result) downto 1 do
begin
//Use Pos function to see if specific character in the result string can also be found
//in the sCharsToBeRemoved and therefore needs to be removed
if Pos(result[i], sCharsToBeRemoved) <> 0 then
begin
//If so we delete the specific character
Delete(result,I,1);
end;
end;
end;
Solution 2
Second solution is similar to the first one but it relies on adding characters non removable characters to the result. It is slightly slower than the first solution
//Slightly faster function that also loops through the whole sourceString character by character
//and adds such characters to result string if they are not present in sCharsToBeRemoved string
function RemoveChars2(sourceString: string; sCharsToBeRemoved: string):string;
var I: Integer;
begin
//Prepare enpty string for our result strung to which we will be copying our end characters
result := '';
//Loop through the whole string
for I := 1 to Length(sourceString) do
begin
//If specific haracter can't be found in sCharsToBeRemoved copy that character to the
//result string
if Pos(sourceString[I], sCharsToBeRemoved) = 0 then
begin
result := result + sourceString[I];
end;
end;
end;
Solution 3
The third solution relies on string helpers for replacing specific characters. This one is by far the fastest of the three needing about half the time that is needed by the first solution to process the same job
//Another approach of removing characters from source string that relies on Replace string helper
function RemoveChars3(sourceString: string; sCharsToBeRemoved: string):string;
var I: Integer;
begin
//Assign value of the source string to the result so we can work with result strin from now on
result := sourceString;
//Loop through the sCharsToBeRemoved string so we can then call Replace string helper in order
//to replace all occurrences of such character in sourceString;
for I := 1 to Length(sCharsToBeRemoved) do
begin
result := result.Replace(sCharsToBeRemoved[I],'');
end;
end;
Main advantages of this approach is that it is quite fast and could easily modified to be able to remove whole substrings and not only individual characters.
PS: In my testing your solution was actually the slowest needing about 20% more time than my first solution
TestTring
jfkldajflkajdflkajlkčfjaskljflakjflkdasjflkčjdfkldafjadklfjadklfjaldkakljfkldajflkčadjslfkjadklfjlkadčjflkajdflčkjadlkfjladkdjfkladjflkadjflkčjadklčfjaldkjfkladjfklajflkadjfkadgfkljdklfjawdkojfkladsjflčaksdjdfklčasjdklčfdfklčjadslkdfjlka
CharsToBeRemoved
asjk
Solution 1
1230 ms
Solution 2
1263 ms
Solution 3
534 ms
Your solution
1574 ms
This solution works with a very small footprint of code lines.
I just split the string on each occurence of a char which should be removed. After that I put the pieces together without the removed chars.
uses System.SysUtils;
function RemoveCharsFromString(sFullString: string; sCharsToBeRemoved: string): string;
var
splitted: TArray<String>;
begin
splitted := sFullString.Split(sCharsToBeRemoved.ToCharArray());
Result := string.Join('', splitted);
end;
string.Replace has an overload where you can pass flags to replace all instead of just one. Example:
sString := sString.Replace('1', '', [rfReplaceAll, rfIgnoreCase]);
Edit: Stringlist equivalent:
sString.Text := sString.Text.Replace('1', '', [rfReplaceAll, rfIgnoreCase]);
Working with strings spends more time, use PChar instead.
I think here's a slightly more optimized version
function RemoveCharsFromString(const AString, AChars: String): String;
var
i, j, k, LenString, LenChars : Integer;
PString, PChars : PChar;
label
Ends;
begin
PString := Pointer(AString);
PChars := Pointer(AChars);
LenString := AString.Length;
LenChars := AChars.Length;
k := 0;
for i := 0 to LenString - 1 do
begin
for j := 0 to LenChars - 1 do
if PString[i] = PChars[j] then
Goto Ends;
PString[k] := PString[i];
Inc(k);
Ends :
end;
PString[k] := #0;
Result := StrPas(PString);
end;
If you don't like Labels, use this code :
function RemoveCharsFromString(const AString, AChars: String): String;
var
i, j, k, LenString, LenChars : Integer;
PString, PChars : PChar;
found : Boolean;
begin
PString := Pointer(AString);
PChars := Pointer(AChars);
LenString := AString.Length;
LenChars := AChars.Length;
k := 0;
for i := 0 to LenString - 1 do
begin
found := False;
for j := 0 to LenChars - 1 do
if PString[i] = PChars[j] then
begin
found := True;
Break;
end;
if not found then
begin
PString[k] := PString[i];
Inc(k);
end;
end;
PString[k] := #0;
Result := StrPas(PString);
end;
You can call it like this :
sString := RemoveCharsFromString(sString, '0123456789.,');
I have a string 123HEREWEGOMAMAMIAGOWILLYOULETMEGOMAMAMIATOLOVEYOUSOMAMAMIASOIHATEYOUMAMAMIAHEY How can i get all available MAMAMIA+ 2 string length ? I need : MAMAMIAGO, MAMAMIASO, etc.
My problem, on last substring found give me wrong output. It render the begining of string with length of substring given : 123HEREWE instead of MAMAMIAGO.
I am using this function:
function Occurrences(const Substring, Text: string): Integer;
var
offset: Integer;
begin
Result := 0;
offset := PosEx(Substring, Text, 1);
while offset <> 0 do
begin
inc(Result);
offset := PosEx(Substring, Text, offset + Length(Substring));
memo1.Lines.Add(Copy(Text, offset, Length(Substring)+2));
end;
end;
my procedure
procedure TFH129.btn1Click(Sender: TObject);
var
s: string;
i: Integer;
begin
s := '123HEREWEGOHEREWEGOMAMAMIAGOWILLYOULETMEGOMAMAMIATOLOVEYOUSOMAMAMIASOIHATEYOUMAMAMIAHEY00';
i := Occurrences('MAMAMIA', s);
end;
You are adding the matching text in the wrong place, without checking if the added match exceeds the string length.
When entering the while loop, first thing to do is to check if the added match does not exceed the search string length. Then you can add the match before starting a new search.
procedure ExtractSubStringsPlus2(const SubString, SearchString: string; list: TStringList);
// Extract found sub strings together with the next two characters into a list
// Use StrUtils.PosEx if Delphi version is older than XE3
var
offset,len: integer;
begin
list.Clear;
len := Length(SubString);
offset := Pos(Substring, SearchString, 1);
while offset <> 0 do
begin
// Test if added length is past length of search string
if (offset + len + 1 > Length(SearchString))
then break;
// Copy found match
list.Add(Copy(SearchString,offset,len+2));
// Continue search
offset := Pos(Substring, SearchString, offset + len);
end;
end;
Your problem is as described below in the added comment:
function Occurrences(const Substring, Text: string): Integer;
var
offset: Integer;
begin
Result := 0;
offset := PosEx(Substring, Text, 1);
while offset <> 0 do
begin
inc(Result);
offset := PosEx(Substring, Text, offset + Length(Substring));
// If the string isn't found any more, offset becomes 0, but
// you still add a new string to the memo...
memo1.Lines.Add(Copy(Text, offset, Length(Substring)+2));
end;
end;
Use this instead:
FUNCTION Occurrences(CONST SubString,Text : STRING): Cardinal;
CONST
HellFreezesOver = FALSE;
VAR
OFS : Cardinal;
BEGIN
Result:=0; OFS:=0;
REPEAT
OFS:=PosEx(SubString,Text,OFS+1);
// Here I terminate the loop, in case the string isn't found any more.
IF OFS=0 THEN BREAK;
INC(Result);
Memo1.Lines.Add(COPY(Text,OFS,LENGTH(SubString)+2))
UNTIL HellFreezesOver
END;
One very simple way using TstringList :
Var aList: TstringList;
i: integer;
begin
aList := TstringList.create;
try
aList.lineBreak := 'MAMAMIA';
aList.text := 'x' + '123HEREWEGOMAMAMIAGOWILLYOULETMEGOMAMAMIATOLOVEYOUSOMAMAMIASOIHATEYOUMAMAMIAHEY';
For I := 1 to aList.count-1 do
if length(aList[i]) >=2 then memo1.Lines.Add(aList.lineBreak + Copy(aList[i], 1, 2));
finally
aList.free;
end;
end;
I am running this code:
function CmdLineParamExists(const Value: string): Boolean;
var
I: Integer;
begin
Result := False;
for I := 1 to ParamCount do
begin
if CompareText(Copy(ParamStr(I), 1, Length(Value)), Value) = 0 then
begin
Result := True;
Exit;
end;
end;
end;
function GetAppName(Value: string): string;
begin
if CmdLineParamExists('/COMPONENTS=prog2') then
begin
Result := 'Программа 2'; //<----This shows up as ????????? 2
end
else
begin
Result := '{#SetupSetting("AppName")}';
end;
end;
procedure CurPageChanged(CurPageID: Integer);
var
S: string;
Begin
if CurPageID = wpSelectDir then
begin
S := SetupMessage(msgSelectDirLabel3);
StringChange(S, '[name]', GetAppName(''));
WizardForm.SelectDirLabel.Caption := S;
end;
end;
Now, I'm not sure what I'm doing wrong here. Every other string shows up correctly, except when I use the result of GetAppName. Should I convert anything to AnsiString at some point?
I'm assuming that you are using Ansi version of Inno Setup.
In the Ansi version, the culprit is probably the StringChange as it does not play nicely with non-Ansi character sets. Try using StringChangeEx.
Though you should be using Unicode version of Inno Setup anyway.
Only the most recent version of Inno Setup, 5.6, does support Unicode string literals. So make sure you have the latest version.
If you are stuck with an older version:
Encode the string like
#$041F#$0440#$043E#$0433#$0440#$0430#$043C#$043C#$0430 + ' 2'
Or, actually the most correct way is to add a new custom message to the language files (like Russian.isl):
[CustomMessages]
Program2=Программа 2
And load it like:
CustomMessage('Program2')
Something strange happens when I try to pass strings from the Lines of a TMemo control to an array of PChar. At the end of the routine, the last string in the array is duplicated. I was able to replicate this in this simple code:
procedure Test;
var
i: smallint;
arr: array of PAnsiChar;
strarr: array[0..1] of string;
begin
SetLength(arr, 2);
strarr[0] := 'abbb';
strarr[1] := 'baaa';
for i := 0 to Length(strarr) do
arr[i] := PAnsiChar(AnsiString(strarr[i]));
end;
If I run this procedure step by step, I can see arr[0] = 'abbb' however, at the end of the rutine, both values, arr[0] and arr[1] equal to baaa. I guess it has something to do with the typecast.
Can anyone see what is wrong ?
There are two problems with your code:
Your loop is exceeding the upper bound of the array. It needs to use for i := 0 to Length(strarr)-1 do or for i := 0 to High(strarr) do instead.
More importantly, when you type-cast an AnsiString to a PAnsiChar, it returns a pointer to the AnsiString's internal data if the AnsiString is not empty. You are type-casting a UnicodeString to an AnsiString and grabbing a pointer into it, so the compiler has to use a compiler-generated local variable for the AnsiString data. In other words, your code is effectively doing the same thing as the following:
procedure Test;
var
i: smallint;
arr: array of PAnsiChar;
strarr: array[0..1] of string;
compiler_temp: AnsiString;
begin
SetLength(arr, 2);
strarr[0] := 'abbb';
strarr[1] := 'baaa';
for i := 0 to Length(strarr) do
begin
compiler_temp := AnsiString(strarr[i]);
arr[i] := PAnsiChar(compiler_temp);
end;
end;
Depending on how the memory for compiler_temp gets managed by the RTL memory manager at run-time, it is certainly possible for arr[0] and arr[1] to end up pointing at the same physical memory block in this situation.
If you want an array of PAnsiChar values then you need to start with an array of Ansi data for them to point at:
procedure Test;
var
i: Integer;
arr: array of PAnsiChar;
strarr: array[0..1] of AnsiString;
begin
SetLength(arr, 2);
strarr[0] := 'abbb';
strarr[1] := 'baaa';
for i := 0 to Length(strarr)-1 do
arr[i] := PAnsiChar(strarr[i]);
end;
Saving, editing and loading information. The information that I want to load is something I will add myself. Each line of information will contain 4 pieces, (string, integer, string, integer). Via 4 seperate edit boxes and a button I will add this information to a 'database' (not sure if I need a database or if it can be done via something like a Tstringlist). Everytime the button is clicked it will added the content that is typed at that moment in the 'database'.
The only demand of the saved data is when I type the first string from the list it could place the rest of the information that belongs to it in a memobox or edit boxes as well. So I suppose I have to be able to search. Just want to keep it as simple as possible. There will only be about 10 to 15 lines of information. and if possible it would be good if I can load them again a later time.
Here's some very basic code that should get you on your way. There's no error checking, and you'll no doubt want to develop it and modify it further. The point is that there should be some ideas to help you write code that works for you.
Now that I have comma-separated the fields, but made no attempt to handle the appearance of commas in any of the values. If this is a problem then choose a different delimiter, or escape the commas. I had toyed with writing each field on its own line (effectively using a newline as the separator), but this makes the reading code more tricky to write.
Again, the main point is that this is not final production code, but is intended to give you a starting point.
function Split(const s: string; Separator: char): TStringDynArray;
var
i, ItemIndex: Integer;
len: Integer;
SeparatorCount: Integer;
Start: Integer;
begin
len := Length(s);
if len=0 then begin
Result := nil;
exit;
end;
SeparatorCount := 0;
for i := 1 to len do begin
if s[i]=Separator then begin
inc(SeparatorCount);
end;
end;
SetLength(Result, SeparatorCount+1);
ItemIndex := 0;
Start := 1;
for i := 1 to len do begin
if s[i]=Separator then begin
Result[ItemIndex] := Copy(s, Start, i-Start);
inc(ItemIndex);
Start := i+1;
end;
end;
Result[ItemIndex] := Copy(s, Start, len-Start+1);
end;
type
TValue = record
i1, i2: Integer;
s: string;
end;
TMyDict = class(TDictionary<string,TValue>)
public
procedure SaveToFile(const FileName: string);
procedure LoadFromFile(const FileName: string);
end;
{ TMyDict }
procedure TMyDict.SaveToFile(const FileName: string);
var
Strings: TStringList;
Item: TPair<string,TValue>;
begin
Strings := TStringList.Create;
Try
for Item in Self do begin
Strings.Add(Format(
'%s,%s,%d,%d',
[Item.Key, Item.Value.s, Item.Value.i1, Item.Value.i2]
));
end;
Strings.SaveToFile(FileName);
Finally
FreeAndNil(Strings);
End;
end;
procedure TMyDict.LoadFromFile(const FileName: string);
var
Strings: TStringList;
Item: TPair<string,TValue>;
Line: string;
Fields: TStringDynArray;
begin
Strings := TStringList.Create;
Try
Strings.LoadFromFile(FileName);
for Line in Strings do begin
Fields := Split(Line, ',');
Assert(Length(Fields)=4);
Item.Key := Fields[0];
Item.Value.s := Fields[1];
Item.Value.i1 := StrToInt(Fields[2]);
Item.Value.i2 := StrToInt(Fields[3]);
Add(Item.Key, Item.Value);
end;
Finally
FreeAndNil(Strings);
End;
end;
Note that you don't attempt to search the file on disk. You simply load it into memory, into the dictionary and look things up from there.
A dictionary is great when you always use the same key. If you have multiple keys then a dictionary is less convenient, but who cares about the performance impact if you've only got 15 records?!
Disclaimer: I've not run the code, I've not tested it, etc. etc.