The code sample below should evaluate an string.
function EvaluateString(const S: Ansistring): Ansistring;
var
i, L: Integer;
begin
L := Length(S);
i:=1;
if (L > 0) and (S[i] > ' ') and (S[L] > ' ') then
.....
end;
but if L=0 then (S[i] > ' ') will create an Access violation.
Can I avoid this problem while keeping the if condition?
You need to either put a {$B-} statement on top of your code, or enable boolean short circuit evaluation in the project settings.
Since {$B-} is the default, you may have already turned it on before, or there is a {$B+} directive somewhere that is turning it off.
In the short circuit evaluation mode {$B-}, Delphi creates code that is (roughly) equivalent to this:
if (L > 0) then begin
if (S[i] > ' ') then begin
if (S[L] > ' ') then begin
.....
end;
end;
end;
In contrast, with full boolean evaluation mode {$B+}, the equivalent could be something like this:
var a,b,c : Boolean;
a := (L > 0);
b := (S[i] > ' '); // always executed
c := (S[L] > ' '); // always executed
if a and b and c then .....
Related
This simply code is working fine to check if lines are different, already when i try check if are equals none element is found when have two files with the same string in same line index on both. What is missing here?
PS: SameStr() also was tested and not is working.
function compstr(s1, s2: string): boolean;
var
i: integer;
btemp: boolean;
begin
btemp := true;
if (length(s1) <> length(s2)) then
begin
btemp := false;
end
else
begin
for i := 1 to length(s1) do
begin
if (s1[i] <> s2[i]) then
begin
btemp := false;
exit;
end;
end;
end;
result := btemp;
end;
procedure compfile(filename1, filename2: string);
var
f1: system.textfile;
f2: system.textfile;
diff: system.textfile;
buf1: string;
buf2: string;
l: integer;
begin
assignfile(f1, filename1);
assignfile(f2, filename2);
assignfile(diff, 'C:\Equals.txt');
reset(f1);
reset(f2);
rewrite(diff);
l := 1;
while not eof(f1) do
begin
readln(f1, buf1);
readln(f2, buf2);
if {not} compstr(buf1, buf2) then
begin
writeln(diff, {extractfilename(filename1) + ' : ' +} inttostr(l) + ' - ' + buf1);
// writeln(diff, extractfilename(filename2) + ' : ' + inttostr(l) + ' - ' + buf2);
// writeln(diff, ' ');
end;
inc(l);
end;
closefile(f1);
closefile(f2);
closefile(diff);
end;
Your function compstr(s1, s2: string): boolean; has a couple of issues:
The btemp: boolean variable is unnecessary. You can set result directly as needed.
If the length of the two lines are equal, but the content differs (if (s1[i] <> s2[i])) you call exit which jumps to the end; of the function and result is never assigned the value of btemp. Thus, strings of equal length but different content are returning the value True, that you set at the beginning. Perhaps you were thinking about break which would exit the for loop and land on the result := btemp; line, which then would yield the correct value.
The whole function is a waste, you call it it in compfile() with:
...
if compstr(buf1, buf2) then
....
which can be replaced with direct comparison:
....
if buf1 = buf2 then
....
P.S. Your claim that SameStr() is not working is false. You probably did not use it correctly.
It seems there is no Ansi overload for StrToInt. Is this right? Or maybe I am missing something.
StrToInt insists to convert my ansistrings to string.
You are correct. There is no ANSI version of StrToInt. The place to find ANSI versions of standard function is the AnsiStrings unit, and there's nothing there.
Either write your own function to do the job, or accept the conversion required to use StrToInt.
It's not too hard to write your own function. It might look like this:
uses
SysConst; // for SInvalidInteger
....
{$OVERFLOWCHECKS OFF}
{$RANGECHECKS OFF}
function AnsiStrToInt(const s: AnsiString): Integer;
procedure Error;
begin
raise EConvertError.CreateResFmt(#SInvalidInteger, [s]);
end;
var
Index, Len, Digit: Integer;
Negative: Boolean;
begin
Index := 1;
Result := 0;
Negative := False;
Len := Length(s);
while (Index <= Len) and (s[Index] = ' ') do
inc(Index);
if Index > Len then
Error;
case s[Index] of
'-','+':
begin
Negative := s[Index] = '-';
inc(Index);
if Index > Len then
Error;
end;
end;
while Index <= Len do
begin
Digit := ord(s[Index]) - ord('0');
if (Digit < 0) or (Digit > 9) then
Error;
Result := Result * 10 + Digit;
if Result < 0 then
Error;
inc(Index);
end;
if Negative then
Result := -Result;
end;
This is a cut-down version of that found in StrToInt. It does not handle hexadecimal and is a bit more stringent regarding errors. Before using this code I'd want to test whether or not this really is your bottleneck.
It is quite interesting that this code, based on that in the RTL source, is incapable of returning low(Integer). It's not too hard to fix that up, but it would make the code more complex.
The code is actually very simple (hex strings aren't supported but prolly you don't need them):
function AnsiStrToInt(const S: RawByteString): Integer;
var
P: PByte;
Negative: Boolean;
Digit: Integer;
begin
P:= Pointer(S);
// skip leading spaces
while (P^ = Ord(' ')) do Inc(P);
Negative:= False;
if (P^ = Ord('-')) then begin
Negative:= True;
Inc(P);
end
else if (P^ = Ord('+')) then Inc(P);
if P^ = 0 then
raise Exception.Create('No data');
Result:= 0;
repeat
if Cardinal(Result) > Cardinal(High(Result) div 10) then
raise Exception.Create('Integer overflow');
Digit:= P^ - Ord('0');
if (Digit < 0) or (Digit > 9) then
raise Exception.Create('Invalid char');
Result:= Result * 10 + Digit;
if (Result < 0) then begin
if not Negative or (Cardinal(Result) <> Cardinal(Low(Result))) then
raise Exception.Create('Integer overflow');
end;
Inc(P);
until (P^ = 0);
if Negative then Result:= -Result;
end;
I followed this tip:
How to convert AnsiString to UnicodeString in Delphi XE4
Example:
var
a : AnsiString;
b : String;
c : Integer;
begin
a := '123';
b := String(a);
c := StrToInt(b);
I'm working with Delphi 2007 and SynEdit component.
I'm the main developer of an open source editor (Tinn-R) and I'm trying to switch from the SynEdit ANSI to UNICODE.
After some months of work everything is working fine except OnPaintTransient procedure.
To try to discover the source of the problem I have tried the original demo OnPaintTransientDemo.
This works perfectly in the latest ANSI version of SynEdit. However, I'm not getting the same result with the latest UNICODE version.
if the instruction occupies only one line, only one symbol "[] {} or ()" near at the cursor is mistakenly highlighted, which closes not.
In other words, when you click on the first bracket "(" the last bracket ")" doesn't change color.
It should color the start and end tag. For example, considering "|" as the cursor position:
(|aaaa) -> only ( is highlighted
(aaaa|) -> only ) is highlighted
However, if the symbols are in different lines both are correctly highlighted:
(|a
a
a
a) -> both () are highlighted
(a
a
a
a|) -> both () are highlighted
This is looking like a bug in the sources of the component!
(Doing debug I could not find the source of the bug.)
Anyone can help please?
The code below (IceMan is the original author) works fine for me:
procedure TForm1.EditorPaintTransient(Sender: TObject; Canvas: TCanvas; TransientType: TTransientType);
var
Editor: TSynEdit;
OpenChars: array of WideChar;//[0..2] of WideChar=();
CloseChars: array of WideChar;//[0..2] of WideChar=();
Attri: TSynHighlighterAttributes;
function IsCharBracket(AChar: WideChar): Boolean;
begin
case AChar of
'{',
'[',
'(',
'<',
'}',
']',
')',
'>':
Result:= True;
else
Result:= False;
end;
end;
function CharToPixels(P: TBufferCoord): TPoint;
begin
Result:=Editor.RowColumnToPixels(Editor.BufferToDisplayPos(P));
end;
procedure SetCanvasStyle;
begin
Editor.Canvas.Brush.Style:= bsSolid; //Clear;
Editor.Canvas.Font.Assign(Editor.Font);
Editor.Canvas.Font.Style:= Attri.Style;
if (TransientType = ttAfter) then begin
Editor.Canvas.Font.Color:= FBracketFG;
Editor.Canvas.Brush.Color:= FBracketBG;
end
else begin
Editor.Canvas.Font.Color:= Attri.Foreground;
Editor.Canvas.Brush.Color:= Attri.Background;
end;
if (Editor.Canvas.Font.Color = clNone) then
Editor.Canvas.Font.Color:= Editor.Font.Color;
if (Editor.Canvas.Brush.Color = clNone) then
Editor.Canvas.Brush.Color:= Editor.Color;
end;
var
P : TBufferCoord;
Pix: TPoint;
D : TDisplayCoord;
S : WideString;
I,
ArrayLength,
start: Integer;
TmpCharA,
TmpCharB: WideChar;
begin
try
// if Memo1.InReplaceStatus = False then
// begin
(*
if fMain.SyntaxHEnabled = False then exit;
if Memo1.Highlighter = nil then exit;
if fMain.BracketMatching = False then exit;
if TSynEdit(Sender).SelAvail then exit;
*)
Editor:= TSynEdit(Sender);
ArrayLength:= 3;
(*
if (Editor.Highlighter = SynHTMLSyn1) or (Editor.Highlighter = SynXMLSyn1) then
inc(ArrayLength);
*)
SetLength(OpenChars,
ArrayLength);
SetLength(CloseChars,
ArrayLength);
for i:= 0 to ArrayLength - 1 do
Case i of
0: begin
OpenChars[i]:= '(';
CloseChars[i]:= ')';
end;
1: begin
OpenChars[i]:= '{';
CloseChars[i]:= '}';
end;
2: begin
OpenChars[i]:= '[';
CloseChars[i]:= ']';
end;
3: begin
OpenChars[i]:= '<';
CloseChars[i]:= '>';
end;
end;
P:= Editor.CaretXY;
D:= Editor.DisplayXY;
Start:= Editor.SelStart;
if (Start > 0) and
(Start <= length(Editor.Text)) then
TmpCharA:= Editor.Text[Start]
else
TmpCharA:= #0;
if (Start < length(Editor.Text)) then
TmpCharB:= Editor.Text[Start + 1]
else
TmpCharB:= #0;
if not IsCharBracket(TmpCharA) and
not IsCharBracket(TmpCharB) then
Exit;
S:= TmpCharB;
if not IsCharBracket(TmpCharB) then begin
P.Char:= P.Char - 1;
S:= TmpCharA;
end;
Editor.GetHighlighterAttriAtRowCol(P,
S,
Attri);
if (Editor.Highlighter.SymbolAttribute = Attri) then begin
for i:= low(OpenChars) to High(OpenChars) do begin
if (S = OpenChars[i]) or
(S = CloseChars[i]) then begin
Pix:= CharToPixels(P);
SetCanvasStyle;
Editor.Canvas.TextOut(Pix.X,
Pix.Y,
S);
P := Editor.GetMatchingBracketEx(P);
if (P.Char > 0) and
(P.Line > 0) then begin
Pix:= CharToPixels(P);
if Pix.X > Editor.Gutter.Width then begin
SetCanvasStyle;
if S = OpenChars[i] then
Editor.Canvas.TextOut(Pix.X,
Pix.Y,
CloseChars[i])
else
Editor.Canvas.TextOut(Pix.X,
Pix.Y,
OpenChars[i]);
end; //if Pix.X >
end; //if (P.Char > 0)
end; //if (S = OpenChars[i])
end; //for i:= low(OpenChars)
Editor.Canvas.Brush.Style := bsSolid;
end; //if (Editor.Highlighter.SymbolAttribute = Attri)
except
// TODO
end; //try
end;
CharToPixels messes with the font color, I found. Setting font.color back to FBrackBG just before drawing seems to work.
For a registration code I want to convert an Int64 to base30 (30 so that only uppercase characters and excluding 0,O,I,1,etc.) and back.
This is not too difficult using functions like:
const
Base = 30;
Base30CharSet = '23456789ABCDEFGHJKLMNPRSTVWXYZ';
function ConvertIntToBase30(ANumber: Int64): string;
begin
if(ANumber = 0) then
Result := Copy(Base30CharSet, 1, 1)
else begin
Result := '';
while(ANumber <> 0) do begin
Result := Copy(Base30CharSet, (ANumber mod Base)+1, 1) + Result;
ANumber := ANumber div Base;
end;
end;
end;
function ConvertBase30ToInt(ANumber: string): Int64;
var
i: integer;
begin
Result := 0;
for i := 1 to Length(ANumber) do begin
Result := Result + (Pos(ANumber[i], Base30CharSet)-1);
if(i < Length(ANumber)) then
Result := Result * Base;
end;
end;
The snag is that I am interested in the Int64's bits, so I could be dealing with a number like $FFFFFFFFFFFFFFFF = -1.
To work around this I thought I would store and remove the sign (abs()) and include the sign as an extra character appended to the base30 result. The problem the occurs at the lower limit of Int64 as calling abs(-9223372036854775808) results in an overflow.
Does anyone have a solution or better algorithm to solve this problem?
The way to deal with it is having a character to indicate it is a negative number so that you can decode back. For negative number, just flip the bit from 1 to 0 and remove the sign bit before encoding and when decode, do a flip back and add the sign bit. Below is working codes
function InvertIntOff(const ANumberL, ANumberH: Integer): Int64;
asm
XOR EAX,$FFFFFFFF
XOR EDX,$FFFFFFFF
end;
function InvertIntOn(const ANumberL, ANumberH: Integer): Int64;
asm
XOR EAX,$FFFFFFFF
XOR EDX,$FFFFFFFF
OR EDX,$80000000
end;
function ConvertIntToBase(ANumber: Int64): string;
const
CBaseMap: array[0..31] of Char = (
'2','3','4','5','6','7','8','9', //0-7
'A','B','C','D','E','F','G','H', //8-15
'J','K','L','M','N', //16-20
'P','Q','R','S','T','U','V','X','W','Y','Z'); //21-31
var
I: Integer;
begin
SetLength(Result, 15);
I := 0;
if ANumber < 0 then
begin
Inc(I);
Result[I] := '1';
ANumber := InvertIntOff(ANumber and $FFFFFFFF, (ANumber and $FFFFFFFF00000000) shr 32);
end;
while ANumber <> 0 do
begin
Inc(I);
Result[I] := CBaseMap[ANumber and $1F];
ANumber := ANumber shr 5;
end;
SetLength(Result, I);
end;
function ConvertBaseToInt(const ABase: string): Int64;
var
I, Index: Integer;
N: Int64;
begin
Result := 0;
if Length(ABase) > 0 then
begin
if ABase[1] = '1' then
Index := 2
else
Index := 1;
for I := Index to Length(ABase) do
begin
case ABase[I] of
'2'..'9':
N := Ord(ABase[I]) - Ord('2');
'A'..'H':
N := Ord(ABase[I]) - Ord('A') + 8;
'J'..'N':
N := Ord(ABase[I]) - Ord('J') + 16;
'P'..'Z':
N := Ord(ABase[I]) - Ord('P') + 21;
else
raise Exception.Create('error');
end;
if I > Index then
Result := Result or (N shl ((I - Index) * 5))
else
Result := N;
end;
if ABase[1] = '1' then
Result := InvertIntOn(Result and $FFFFFFFF, (Result and $FFFFFFFF00000000) shr 32);
end;
end;
procedure TestBase32;
var
S: string;
begin
S := ConvertIntToBase(-1);
ShowMessage(S + ' / ' + IntToStr(ConvertBaseToInt(S)) + ' ? -1');
S := ConvertIntToBase(-31);
ShowMessage(S + ' / ' + IntToStr(ConvertBaseToInt(S)) + ' ? -31');
S := ConvertIntToBase(1);
ShowMessage(S + ' / ' + IntToStr(ConvertBaseToInt(S)) + ' ? 1');
S := ConvertIntToBase(123456789);
ShowMessage(S + ' / ' + IntToStr(ConvertBaseToInt(S)) + ' ? 123456789');
S := ConvertIntToBase(-123456789);
ShowMessage(S + ' / ' + IntToStr(ConvertBaseToInt(S)) + ' ? -123456789');
end;
I think you are almost there by considering abs()...
But rather than using abs() why not simply ignore the sign for processing the value of the Int64 itself ? As far as I can tell, you are in fact already doing this so only one minor addition is needed to the encoding routine:
if aNumber < 0 then
// negative
else
// positive;
The only problem then is the LOSS of sign information in the resulting Base30 string. So treat that as a separate problem to be solved using the new information gained from the aNumber < 0 test...
I see you have excluded all chars that could be confused for 0 or 1 but have also excluded 0 and 1 themselves. You could therefore use 0 and 1 to indicate positive or negative (or vice versa).
Depending on the purpose of these routines, the placement of the 0/1 in the result could be entirely arbitrary (if you wished to obfuscate things and make the placement of the 0/1 random rather than a consistent lead/trail character).
When encoding simply drop a sign indicator into the result string at random, and when decoding handle the 0/1 character whenever as the sign marker it is encountered, but skipped for the purposes of decoding the value.
Of course, if obfuscation is not an issue then simply consistently pre or post fix the sign indicator.
You could even simply choose to use '1' to indicate negative and the LACK of a '1' to indicate/assume positive (this would simplify the zero value case a little I think)
The easy answer is to turn range checking off, even just for the method that you're calling abs in.
If you don't care about an extra char or two you could split the int64 into words or dwords and string those together. I would be more tempted to go to base32 and use bit shifts for speed and ease of use. Then your encoding becomes
Base32CharSet[(ANumber shr 5) % 32]
and a similar pos() based approach for the decode.
I am using StringReplace to replace > and < by the char itself in a generated XML like this:
StringReplace(xml.Text,'>','>',[rfReplaceAll]) ;
StringReplace(xml.Text,'<','<',[rfReplaceAll]) ;
The thing is it takes way tooo long to replace every occurence of >.
Do you purpose any better idea to make it faster?
If you're using Delphi 2009, this operation is about 3 times faster with TStringBuilder than with ReplaceString. It's Unicode safe, too.
I used the text from http://www.CodeGear.com with all occurrences of "<" and ">" changed to "<" and ">" as my starting point.
Including string assignments and creating/freeing objects, these took about 25ms and 75ms respectively on my system:
function TForm1.TestStringBuilder(const aString: string): string;
var
sb: TStringBuilder;
begin
StartTimer;
sb := TStringBuilder.Create;
sb.Append(aString);
sb.Replace('>', '>');
sb.Replace('<', '<');
Result := sb.ToString();
FreeAndNil(sb);
StopTimer;
end;
function TForm1.TestStringReplace(const aString: string): string;
begin
StartTimer;
Result := StringReplace(aString,'>','>',[rfReplaceAll]) ;
Result := StringReplace(Result,'<','<',[rfReplaceAll]) ;
StopTimer;
end;
Try FastStrings.pas from Peter Morris.
You should definitely look at the Fastcode project pages: http://fastcode.sourceforge.net/
They ran a challenge for a faster StringReplace (Ansi StringReplace challenge), and the 'winner' was 14 times faster than the Delphi RTL.
Several of the fastcode functions have been included within Delphi itself in recent versions (D2007 on, I think), so the performance improvement may vary dramatically depending on which Delphi version you are using.
As mentioned before, you should really be looking at a Unicode-based solution if you're serious about processing XML.
The problem is that you are iterating the entire string size twice (one for replacing > by > and another one to replace < by <).
You should iterate with a for and simply check ahead whenever you find a & for a gt; or lt; and do the immediate replace and then skipping 3 characters ((g|l)t;). This way it can do that in proportional time to the size of the string xml.Text.
A simple C# example as I do not know Delphi but should do for you to get the general idea.
String s = "<xml>test</xml>";
char[] input = s.ToCharArray();
char[] res = new char[s.Length];
int j = 0;
for (int i = 0, count = input.Length; i < count; ++i)
{
if (input[i] == '&')
{
if (i < count - 3)
{
if (input[i + 1] == 'l' || input[i + 1] == 'g')
{
if (input[i + 2] == 't' && input[i + 3] == ';')
{
res[j++] = input[i + 1] == 'l' ? '<' : '>';
i += 3;
continue;
}
}
}
}
res[j++] = input[i];
}
Console.WriteLine(new string(res, 0, j));
This outputs:
<xml>test</xml>
When you are dealing with a multiline text files, you can get some performance by processing it line by line. This approach reduced time in about 90% to replaces on >1MB xml file.
procedure ReplaceMultilineString(xml: TStrings);
var
i: Integer;
line: String;
begin
for i:=0 to xml.Count-1 do
begin
line := xml[i];
line := StringReplace(line, '>', '>', [rfReplaceAll]);
line := StringReplace(line, '<', '<', [rfReplaceAll]);
xml[i] := line;
end;
end;
Untested conversion of the C# code written by Jorge Ferreira.
function ReplaceLtGt(const s: string): string;
var
inPtr, outPtr: integer;
begin
SetLength(Result, Length(s));
inPtr := 1;
outPtr := 1;
while inPtr <= Length(s) do begin
if (s[inPtr] = '&') and ((inPtr + 3) <= Length(s)) and
(s[inPtr+1] in ['l', 'g']) and (s[inPtr+2] = 't') and
(s[inPtr+3] = ';') then
begin
if s[inPtr+1] = 'l' then
Result[outPtr] := '<'
else
Result[outPtr] := '>';
Inc(inPtr, 3);
end
else begin
Result[outPtr] := Result[inPtr];
Inc(inPtr);
end;
Inc(outPtr);
end;
SetLength(Result, outPtr - 1);
end;
Systools (Turbopower, now open source) has a ReplaceStringAllL function that does all of them in a string.
it's work like charm so fast trust it
Function NewStringReplace(const S, OldPattern, NewPattern: string; Flags: TReplaceFlags): string;
var
OldPat,Srch: string; // Srch and Oldp can contain uppercase versions of S,OldPattern
PatLength,NewPatLength,P,i,PatCount,PrevP: Integer;
c,d: pchar;
begin
PatLength:=Length(OldPattern);
if PatLength=0 then begin
Result:=S;
exit;
end;
if rfIgnoreCase in Flags then begin
Srch:=AnsiUpperCase(S);
OldPat:=AnsiUpperCase(OldPattern);
end else begin
Srch:=S;
OldPat:=OldPattern;
end;
PatLength:=Length(OldPat);
if Length(NewPattern)=PatLength then begin
//Result length will not change
Result:=S;
P:=1;
repeat
P:=PosEx(OldPat,Srch,P);
if P>0 then begin
for i:=1 to PatLength do
Result[P+i-1]:=NewPattern[i];
if not (rfReplaceAll in Flags) then exit;
inc(P,PatLength);
end;
until p=0;
end else begin
//Different pattern length -> Result length will change
//To avoid creating a lot of temporary strings, we count how many
//replacements we're going to make.
P:=1; PatCount:=0;
repeat
P:=PosEx(OldPat,Srch,P);
if P>0 then begin
inc(P,PatLength);
inc(PatCount);
if not (rfReplaceAll in Flags) then break;
end;
until p=0;
if PatCount=0 then begin
Result:=S;
exit;
end;
NewPatLength:=Length(NewPattern);
SetLength(Result,Length(S)+PatCount*(NewPatLength-PatLength));
P:=1; PrevP:=0;
c:=pchar(Result); d:=pchar(S);
repeat
P:=PosEx(OldPat,Srch,P);
if P>0 then begin
for i:=PrevP+1 to P-1 do begin
c^:=d^;
inc(c); inc(d);
end;
for i:=1 to NewPatLength do begin
c^:=NewPattern[i];
inc(c);
end;
if not (rfReplaceAll in Flags) then exit;
inc(P,PatLength);
inc(d,PatLength);
PrevP:=P-1;
end else begin
for i:=PrevP+1 to Length(S) do begin
c^:=d^;
inc(c); inc(d);
end;
end;
until p=0;
end;
end;