I am an intermediate Delphi programmer that needs to learn a lot so I hope my question here is not to dumb. I have a file with 1546 strings that I need to place in a StringList and do a custom sort. The strings look like this:
2:X,X,2,2,2,X<A>11
7:5,7,7,6,5,5<A>08
3:3,X,0,0,1,0<C/D>11
5:X,2,4,2,5,2<Asus2/Gb>02
3:0,3,2,0,3,0<C/D>02
4:X,0,4,4,0,0<Asus2/Gb>11
4:X,X,4,4,4,2<B>01
3:3,2,1,0,0,3<B#5>11
I need them to look like this:
2:X,X,2,2,2,X<A>11
7:5,7,7,6,5,5<A>08
5:X,2,4,2,5,2<Asus2/Gb>11
4:X,0,4,4,0,0<Asus2/Gb>02
4:X,X,4,4,4,2<B>01
3:3,2,1,0,0,3<B#5>11
3:3,X,0,0,1,0<C/D>11
3:0,3,2,0,3,0<C/D>02
They need to be sorted by the portion of the string between the <...> and the last 2 chars. Any help would be much appreciated.
OK...done, Works quite well. Sorts a list with over 1500 strings in 62ms. Constructive criticism will be appreciated.
function SortChords(List:TStringList; idx1,idx2:integer): integer;
var
s1,s2:string;
begin
s1:=List[idx1];
s1:=copy(s1,pos('<',s1)+1,pos('>',s1)-pos('<',s1)-1);
s2:=List[idx2];
s2:=copy(s2,pos('<',s2)+1,pos('>',s2)-pos('<',s2)-1);
if s1 < s2 then
result:=-1
else if s1 > s2 then
result:=1
else
result:=0;
end;
You can write your own custom sort procedure and use TStringList.CustomSort to sort in the desired order.
The following demonstrates using the custom sort. It does not produce the exact output you describe, because you're not clear how you determine the precedence of two items that have the same value between the <> (as in lines 1 and 2, or 3 and 4, of your expected output; you can add code to decide the final order where I've indicated in the code comment. The sample is a complete console application that demonstrates sorting the values you've provided. It's slightly verbose in variable declarations for clarity.
program Project1;
{$APPTYPE CONSOLE}
uses
SysUtils, Classes;
function ListSortProc(List: TStringList; Index1, Index2: Integer): Integer;
var
StartPosA, EndPosA: Integer;
StartPosB, EndPosB: Integer;
TestValA, TestValB: string;
Comp: Integer;
begin
StartPosA := Pos('<', List[Index1]) + 1;
EndPosA := Pos('>', List[Index1]);
TestValA := Copy(List[Index1], StartPosA, EndPosA - StartPosA);
StartPosB := Pos('<', List[Index2]) + 1;
EndPosB := Pos('>', List[Index2]);
TestValB := Copy(List[Index2], StartPosB, EndPosB - StartPosB);
Result := CompareStr(TestValA, TestValB);
{ To do further processing for lines with the same value, add
code here.
if Result = 0 then
// Decide on the order of the equal values with whatever
// criteria you want.
}
end;
var
SL: TStringList;
s: String;
begin
SL := TStringList.Create;
try
SL.Add('2:X,X,2,2,2,X<A>11');
SL.Add('7:5,7,7,6,5,5<A>08');
SL.Add('3:3,X,0,0,1,0<C/D>11');
SL.Add('5:X,2,4,2,5,2<Asus2/Gb>02');
SL.Add('3:0,3,2,0,3,0<C/D>02');
SL.Add('4:X,0,4,4,0,0<Asus2/Gb>11');
SL.Add('4:X,X,4,4,4,2<B>01');
SL.Add('3:3,2,1,0,0,3<B#5>11');
SL.CustomSort(ListSortProc);
for s in SL do
WriteLn(s);
ReadLn;
finally
SL.Free;
end;
end.
The code above produces this output:
7:5,7,7,6,5,5<A>08
2:X,X,2,2,2,X<A>11
4:X,0,4,4,0,0<Asus2/Gb>11
5:X,2,4,2,5,2<Asus2/Gb>02
4:X,X,4,4,4,2<B>01
3:3,2,1,0,0,3<B#5>11
3:0,3,2,0,3,0<C/D>02
3:3,X,0,0,1,0<C/D>11
I want to count how many times a String occurs in another String in Pascal Script like shown in the below example.
I've seen the answer to Delphi: count number of times a string occurs in another string, but there is no PosEx function in Pascal Script.
MyString := 'Hello World!, Hello World!, Hello World!, Hello World!';
If I count the number of times Hello or World occurs here, the result should be 4.
If I count the number of times , (comma) occurs here, the result should be 3.
UPDATE
The following function works, but it copies given String again to a new Variable, and deletes parts of Strings, so it works slowly.
function OccurrencesOfSubString(S, SubStr: String): Integer;
var
DSStr: String;
begin
if Pos(SubStr, S) = 0 then
Exit
else
DSStr := S;
Repeat
if Pos(SubStr, S) <> 0 then
Inc(Result);
Delete(DSStr, Pos(SubStr, DSStr), Length(Copy(DSStr, Pos(SubStr, DSStr), Length(SubStr))));
Until Pos(SubStr, DSStr) = 0;
end;
Your implementation is generally correct.
There are some optimizations to be made and useless code to be removed:
The second test for if Pos(SubStr, S) <> 0 (within repeat) is pointless. It's true always. You are testing S, which was tested at the function start already. And the DSStr is already tested in the until.
You should save Pos(SubStr, DSStr) to a variable not to call it multiple times.
Length(Copy(DSStr, Pos(SubStr, DSStr), Length(SubStr))) is actually the same as Length(SubStr).
No need to copy the S to DSStr. You can work directly with the S. It's by-value parameter, so you do not modify the variable that you use to call the function.
Replace the initial Pos(SubStr, S) = 0 check with the same check in the loop to save one Pos call.
Optimized version of your code:
function OccurrencesOfSubString(S, SubStr: String): Integer;
var
P: Integer;
begin
Result := 0;
repeat
P := Pos(SubStr, S);
if P > 0 then
begin
Inc(Result);
Delete(S, P, Length(SubStr));
end;
until P = 0;
end;
But actually with the Inno Setup StringChange function (which Delphi does not have), you do not have to code any algorithm yourself.
function OccurrencesOfSubString(S, SubStr: String): Integer;
begin
Result := StringChange(S, SubStr, '');
end;
This was inspired by the #RobertFrank's answer to Delphi: count number of times a string occurs in another string.
While the use of the StringChange looks inefficient (as it has significant side effects), it's actually faster. Probably because it is implemented in Pascal, not in Pascal Script.
Tested with 3 million calls to:
OccurrencesOfSubString('Hello World!, Hello World!, Hello World!, Hello World!', 'Hello')
With StringChange: 11 seconds
My optimized version of your code: 49 seconds
Your original code: 99 seconds
Though for few calls, all implementations are good enough.
The program has several "encryption" algorithms. This one should blockwise reverse the input. "He|ll|o " becomes "o |ll|He" (block length of 2).
I add two strings, in this case appending the result string to the current "block" string and making that the result. When I add the result first and then the block it works fine and gives me back the original string. But when i try to reverse the order it just gives me the the last "block".
Several other functions that are used for "rotation" are above.
//amount of blocks
function amBl(i1:integer;i2:integer):integer;
begin
if (i1 mod i2) <> 0 then result := (i1 div i2) else result := (i1 div i2) - 1;
end;
//calculation of block length
function calcBl(keyStr:string):integer;
var i:integer;
begin
result := 0;
for i := 1 to Length(keyStr) do
begin
result := (result + ord(keyStr[i])) mod 5;
result := result + 2;
end;
end;
//desperate try to add strings
function append(s1,s2:string):string;
begin
insert(s2,s1,Length(s1)+1);
result := s1;
end;
function rotation(inStr,keyStr:string):string;
var //array of chars -> string
block,temp:string;
//position in block variable
posB:integer;
//block length and block count variable
bl, bc:integer;
//null character as placeholder
n : ansiChar;
begin
//calculating block length 2..6
bl := calcBl(keyStr);
setLength(block,bl);
result := '';
temp := '';
{n := #00;}
for bc := 0 to amBl(Length(inStr),bl) do
begin
//filling block with chars starting from back of virtual block (in inStr)
for posB := 1 to bl do
begin
block[posB] := inStr[bc * bl + posB];
{if inStr[bc * bl + posB] = ' ' then block[posB] := n;}
end;
//adding the block in front of the existing result string
temp := result;
result := block + temp;
//result := append(block,temp);
//result := concat(block,temp);
end;
end;
(full code http://pastebin.com/6Uarerhk)
After all the loops "result" has the right value, but in the last step (between "result := block + temp" and the "end;" of the function) "block" replaces the content of "result" with itself completely, it doesn't add result at the end anymore.
And as you can see I even used a temp variable to try to work around that.. doesnt change anything though.
I am 99.99% certain that your problem is due to a subtle bug in your code. However, your deliberate efforts to hide the relevant code mean that we're really shooting in the dark. You haven't even been clear about where you're seeing the shortened Result: GUI Control/Debugger/Writeln
The irony is that you have all the information at your fingertips to provide a small concise demonstration of your problem - including sample input and expected output.
So without the relevant information, I can only guess; I do think I have a good hunch though.
Try the following code and see if you have a similar experience with S3:
S1 := 'a'#0;
S2 := 'bc';
S3 := S1 + S2;
The reason for my hunch is that #0 is a valid character in a string: but whenever that string needs to be processed as PChar, #0 will be interpreted as a string terminator. This could very well cause the "strange behaviour" you're seeing.
So it's quite probable that you have at least one of the following 2 bugs in your code:
You are always processing 1 too many characters; with the extra character being #0.
When your input string has an odd number of characters: your algorithm (which relies on pairs of characters) adds an extra character with value #0.
Edit
With the additional source code, my hunch is confirmed:
Suppose you have a 5 character string, and key that produces block length 2.
Your inner loop (for posB := 1 to bl do) will read beyond the length of inStr on the last iteration of the outer loop.
So if the next character in memory happens to be #0, you will be doing exactly as described above.
Additional problem. You have the following code:
//calculating block length 2..6
bl := calcBl(keyStr);
Your assumption in the comment is wrong. From the implementation of calcBl, if keyStr is empty, your result will be 0.
I'm expanding a class of mine for storing generic size strings to allow more flexible values for user input. For example, my prior version of this class was strict and allowed only the format of 2x3 or 9x12. But now I'm making it so it can support values such as 2 x 3 or 9 X 12 and automatically maintain the original user's formatting if the values get changed.
The real question I'm trying to figure out is just how to detect if one character from a string is either upper or lower case? Because I have to detect case sensitivity. If the deliminator is 'x' (lowercase) and the user inputs 'X' (uppercase) inside the value, and case sensitivity is turned off, I need to be able to find the opposite-case as well.
I mean, the Pos() function is case sensitive...
Delphi 7 has UpperCase() and LowerCase() functions for strings. There's also UpCase() for characters.
If I want to search for a substring within another string case insensitively, I do this:
if Pos('needle', LowerCase(hayStack)) > 0 then
You simply use lower case string literals (or constants) and apply the lowercase function on the string before the search. If you'll be doing a lot of searches, it makes sense to convert just once into a temp variable.
Here's your case:
a := '2 x 3'; // Lowercase x
b := '9 X 12'; // Upper case X
x := Pos('x', LowerCase(a)); // x = 3
x := Pos('x', LowerCase(b)); // x = 3
To see if a character is upper or lower, simply compare it against the UpCase version of it:
a := 'A';
b := 'b';
upper := a = UpCase(a); // True
upper := b = UpCase(b); // False
try using these functions (which are part of the Character unit)
Character.TCharacter.IsUpper
Character.TCharacter.IsLower
IsLower
IsUpper
UPDATE
For ansi versions of delphi you can use the GetStringTypeEx functions to fill a list with each ansi character type information. and thne compare the result of each element against the $0001(Upper Case) or $0002(Lower Case) values.
uses
Windows,
SysUtils;
Var
LAnsiChars: array [AnsiChar] of Word;
procedure FillCharList;
var
lpSrcStr: AnsiChar;
lpCharType: Word;
begin
for lpSrcStr := Low(AnsiChar) to High(AnsiChar) do
begin
lpCharType := 0;
GetStringTypeExA(LOCALE_USER_DEFAULT, CT_CTYPE1, #lpSrcStr, SizeOf(lpSrcStr), lpCharType);
LAnsiChars[lpSrcStr] := lpCharType;
end;
end;
function CharIsLower(const C: AnsiChar): Boolean;
const
C1_LOWER = $0002;
begin
Result := (LAnsiChars[C] and C1_LOWER) <> 0;
end;
function CharIsUpper(const C: AnsiChar): Boolean;
const
C1_UPPER = $0001;
begin
Result := (LAnsiChars[C] and C1_UPPER) <> 0;
end;
begin
try
FillCharList;
Writeln(CharIsUpper('a'));
Writeln(CharIsUpper('A'));
Writeln(CharIsLower('a'));
Writeln(CharIsLower('A'));
except
on E:Exception do
Writeln(E.Classname, ': ', E.Message);
end;
Readln;
end.
if myChar in ['A'..'Z'] then
begin
// uppercase
end
else
if myChar in ['a'..'z'] then
begin
// lowercase
end
else
begin
// not an alpha char
end;
..or D2009 on..
if charInSet(myChar,['A'..'Z']) then
begin
// uppercase
end
else
if charInSet(myChar,['a'..'z']) then
begin
// lowercase
end
else
begin
// not an alpha char
end;
The JCL has routines for this in the JclStrings unit, eg CharIsUpper and CharIsLower. SHould work in Delphi 7.
AnsiPos() is not case-sensitive. You can also force upper or lower case, irrespective of what the user enters using UpperCase() and LowerCase().
Just throwing this out there since you may find it far more simple than the other (very good) answers.
We got OPC job. I cannot installed RsLinx to my Win7 (and XP mode too) because of errors, so I send my test app to the real place, and somebody testing it.
Because I don't have DLL, I cannot make Delphi interface, so I need to do OLE Calls only.
I got an interesting problem with Group Add.
I demonstrate it:
procedure TForm1.Button8Click(Sender: TObject);
var
r, g : variant;
s : string;
v : variant;
ws : WideString;
begin
Log('Connect');
r := CreateOleObject('RSI.OPCAutomation');
r.Connect('RSLinx OPC Server');
Log('Add as constant');
g := r.OPCGroups.Add('MONKEY_C');
Log('Name ' + g.Name);
Log('Add as string');
s := 'MONKEY_S';
g := r.OPCGroups.Add(s);
Log('Name ' + g.Name);
Log('Add as variant');
s := 'MONKEY_V';
v := s;
g := r.OPCGroups.Add(v);
Log('Name ' + g.Name);
Log('Add as ole variant');
s := 'MONKEY_OV';
v := VarAsType(s, varOleStr);
g := r.OPCGroups.Add(v);
Log('Name ' + g.Name);
Log('Add as widestring');
s := 'MONKEY_WS';
ws := WideString(s);
g := r.OPCGroups.Add(ws);
Log('Name ' + g.Name);
Log('Add as widestring var');
s := 'MONKEY_WSV';
ws := WideString(s);
v := ws;
g := r.OPCGroups.Add(v);
Log('Name ' + g.Name);
r := 0;
end;
The result was:
Connect
Add as constant
Name MONKEY_C
Add as string
Name _Group0
Add as variant
Name _Group1
Add as ole variant
Name _Group2
Add as widestring
Name _Group3
Add as widestring var
Name _Group4
So the problem that I cannot add any Group than constant defined...
I need to know HOW Delphi compile this constant to I can convert my variant value to this format.
Can anybody help me in this theme?
Thanks:
dd
Hi!
So the problem is mysterious.
I found another errors in the pure OLE calls.
function TDDRsOPCObject.IndexOfGroup(GroupName: string): integer;
var
ogs, g : variant;
i : integer;
s : string;
begin
CheckObject;
Result := -1;
ogs := FObj.OPCGroups;
s := '';
for i := 1 to ogs.Count do begin
g := ogs.Item(i); // This is working
if AnsiCompareText(g.Name, GroupName) = 0 then begin
Result := i;
Exit;
end;
end;
end;
function TDDRsOPCObject.GetGroupByName(GroupName: string): variant;
var
idx : integer;
ogs, g : variant;
begin
CheckObject;
VarClear(Result);
idx := IndexOfGroup(GroupName);
ogs := FObj.OPCGroups;
if idx <> -1
then begin
g := ogs.Item(idx); // HERE I GOT: The parameter is incorrect
Result := g;
end;
end;
So it is interesting: the IndexOfGroup with same call is working, the GetGroupByName is not... :-(
So I determined I do not continue my fighting with windmills (Don Q).
I got TLB from a dear user that have Delphi7 (in Win7 the Delphi6 cannot produce OLE interface), and I found Kassl.
May these interfaces can help me...
Thanks:
dd
As far as I know the constant and the strings are all converted to an OleString/BSTR (WideString). But since you are having these problems... probably not.
What does the documentation of OPCGroups.Add say? What is expected?
Do you have a type library? Maybe you can import them and use the interface directly.
Edit:
The documentation isn't very clear.
There are a few things you can try:
Check in CPU view what the Delphi compiler made of the code with the constant, maybe you see some hints there about what to do with your strings.
Try this code.
code:
const
OPC_GROUP_NAME: WideString = 'MONKEY_C';
<...>
g := r.OPCGroups.Add(OPC_GROUP_NAME);
Log('Name ' + g.Name);
When above code works, try this:
const
{$J+} //writable constants on
OPC_GROUP_NAME: WideString = 'dummy';
{$J-}
<...>
OPC_GROUP_NAME := 'MONKEY_BLA';
g := r.OPCGroups.Add(OPC_GROUP_NAME);
Log('Name ' + g.Name); //should be: 'Name MONKEY_BLA'
Note: I don't like step 2, but if it works.. why not. To me it seems like there is a bug in the com-library you use.
Edit2:
I looked at the code generated by using the constant and using a normal string. With the constant I see the address of the first character being pushed on the stack, with the string I see the address of a pointer to a string being pushed on the stack.
With the code below I can simulate the same behaviour as with the constant:
var
lWideArray: array[0..40] of WideChar;
s: string;
i: Integer;
<..>
s := 'MONKEY_FOO';
for i := 0 to Length(lWideArray) - 1 do
begin
if i < Length(s) then
lWideArray[i] := WideChar(s[i+1])
else
lWideArray[i] := #0;
end;
g := r.OPCGroups.Add(WideString(lWideArray));
Log('Name ' + g.Name);
There are some issues in your code, also it would be nice to know which version of Delphi you're using, and what parameter type the Add() call use. Anyway some hints:
ws := WideString(s);
That's a wrong typecast. It won't convert your string to a WideString, it will just force the memory to be interpreted as such. Use
ws := s;
The compile will take care to call the conversion routine.
You do not have to invent the wheel. There are a lot of libraries, examples and sample code how to use OPC with Delphi. For free Delphi OPC servers and clients, take a look here: http://www.opcconnect.com/delphi.php.