get the whole word string after finding the word in a text - function

i have a problem developing this function, i have this text..
Testing Function
ok
US.Cool
rwgehtrhjyw54 US_Cool
fhknehq is ryhetjuy6u24
gflekhtrhissfhejyw54i
my function :
function TForm5.FindWordInString(sWordToFind, sTheString : String): Integer;
var
i : Integer; x:String;
begin
Result := 0;
for i:= 1 to Length(sTheString) do
begin
x := Copy(sTheString,i,Length(sWordToFind));
if X = sWordToFind then
begin
if X.Length > sWordToFind.Length then
begin
Result := 100;
break;
end else
begin
Result := i;
break;
end;
end;
end;
end;
now, i want X to be US.Cool, but here its always = US, because i want to check the length of sWordToFind and X.

After clarification, this question is about getting length of a word searched by its starting substring within a string. For example when having string like this:
fhknehq is ryhetjuy6u24
When you execute a desired function for the above string with the following substrings, you should get results like:
hknehq → 0 → substring is not at the beginning of a word
fhknehq → 7 → length of the word because substring is at the beginning of a word
yhetjuy6u24 → 0 → substring is not at the beginning of a word
ryhetjuy6u24 → 12 → length of the word because substring is at the beginning of a word
If that is so, I would do this:
function GetFoundWordLength(const Text, Word: string): Integer;
const
Separators: TSysCharSet = [' '];
var
RetPos: PChar;
begin
Result := 0;
{ get the pointer to the char where the Word was found in Text }
RetPos := StrPos(PChar(Text), PChar(Word));
{ if the Word was found in Text, and it was at the beginning of Text, or the preceding
char is a defined word separator, we're at the beginning of the word; so let's count
this word's length by iterating chars till the end of Text or until we reach defined
separator }
if Assigned(RetPos) and ((RetPos = PChar(Text)) or CharInSet((RetPos - 1)^, Separators)) then
while not CharInSet(RetPos^, [#0] + Separators) do
begin
Inc(Result);
Inc(RetPos);
end;
end;

I spend a few times on your idea, so i wrote below codes, but it is not a good way for develop a Start With search. with some research you can find builtin functions, that provide better performance. you can try StrUtils.SearchBuf Function it will provide a full function string search.
anyway this code are working with SPACE separator, I hope it will be useful for you:
function TForm5.FindWordInString(sWordToFind, sTheString : String): Integer;
var
i : Integer; x:String;
flag : Boolean;
begin
Result := 0;
i := 1;
flag := False;
while True do
begin
if i > Length(sTheString) then Break;
if not flag then
x := Copy(sTheString,i,Length(sWordToFind))
else
begin
if sTheString[i] = ' ' then Break;
x := x + sTheString[i];
end;
if (X = sWordToFind) then
begin
flag := True;
if (X.Length >= sWordToFind.Length) and
(sTheString[i + Length(sWordToFind)] = ' ') then
break
else
i := i + Length(sWordToFind) -1;
end;
i := i + 1;
end;
Result := Length(x);
end;

Related

Calling a caller to a DLL function from within the DLL

Is it possible to call a function that called a function in a DLL that is written in Delphi? The calling program that loads the DLL just has access to my DLL's exported functions and can not export it's own functions (it's Easylanguge programming language and does not have a command to export or the ability to pass pointers). I do not need to pass any parameters when I call the from the DLL, just execute the code again after the return address point.
So if a function in Easylanguage calls a function from the DLL, can the return address from the Easylanguage function be used in the DLL to later call the Easylanguage function at the point of the return address? Even a hack will do.
I want to get this concept code I wrote working correctly before I try to apply it to the actual DLL & Easylanguage platform. I sometimes get access violations.
Delphi demo that simulates the interaction of the DLL & Easylanguage:
type
Tra_func = function: Integer;
var
Form9: TForm9;
ra: pointer;
ra_func: Tra_func;
implementation
{$R *.dfm}
function dll_func: integer;
begin
ra := System.ReturnAddress;
Form9.ListBox1.Items.Add(Format('RA to "easylanguage_func": %p', [ra]));
Form9.ListBox1.Items.Add('END of "dll" function');
result := 1;
end;
function easylanguage_func: integer; // temp stand-in function for Easylanguage
begin
Form9.ListBox1.Items.Add('Call "dll" to get return address...');
dll_func();
Form9.ListBox1.Items.Add('END of "easylanguage_func" function');
result := 1;
end;
procedure TForm9.Button1Click(Sender: TObject);
begin
easylanguage_func; // * this call would be from Easylanguage to the DLL
ListBox1.Items.Add('Calling RA address of "easylanguage_func"');
ra_func := Tra_func(ra);
ra_func; // * this call would be located in the DLL
end;
end.
What an Easylanguage routine that calls a DLL function could look like:
external: "ra_test_dll.dll", INT, "GetRAFunction";
method void ReturnFunction() // * can not export this *
begin
Print("GetRAFunction");
GetRAFunction(); // calls function in DLL
// *** returns here, start execution here when call from the DLL later
Print("*RA - next line*");
end;
String passing as parameters and returns in both directions..
Easylanguage:
external: "ts_dll_str_test.dll", String, "StringTest", String; // Delphi DLL function def
method void StrFunction(String ss)
variables:
String ss2;
begin
ss2 = StringTest(ss+"abc");
Print(ss2); // Output = ABCD5FGHIJKLM
end;
Call: StrFunction("0123456789")
Delphi DLL:
var
ss: AnsiString;
myCharPtr: PAnsiChar;
function StringTest(StrIn: PAnsiChar): PAnsiChar; stdcall; // called by EL
begin
ss := 'ABCDEFGHIJKLM';
myCharPtr := #ss[1];
myCharPtr[4] := StrIn[5];
result := myCharPtr;
end;
exports StringTest;
Thanks.
I designed a demo with Delphi used in both the calling application and the DLL. You'll have to apply the same "trick" in your EasyLanguage programming.
The idea is that when the DLL need to call a function in the executable - function which is not exported in anyway - it simply returns with a special value transporting all the information required to call whatever EasyLanguage (here Delphi) function.
This means that at both the caller and the DLL, the function are loops. The EXE calls the DLL passing the initial argument, the DLL get it and return a special value describing the function call it needs. The EXE recognize that, call the required function in his code and then call again the same function in the DLL, this time passing the result of the function call. And the process loops for a second, thirds and so on. Finally the DLL is able to produce the final result and return it without the mark indicating a function call.
Everything is handled using AnsiString since EasyLaguage do not support pointers.
The code below has been simplified at maximum so that it is more readable. In a real application it is much better to validate many things to avoid unexpected behaviour.
Here is the code for executable:
unit CallingCallerDemoMain;
interface
uses
Winapi.Windows, Winapi.Messages,
System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,
ParamParsing;
type
TCallingCallerForm = class(TForm)
Button1: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
public
function CallDll(Value: Integer): String;
function DemoSquare(Arg1: Integer): Integer;
function DemoSum(Arg1: Integer): Integer;
end;
// Declaration for function in DLL
// In this demo, the function takes one integer argument and return a string
// looking like "Value=4 Square=16 Sum=8". The value is the argument, the
// square and the sum are computed by THIS executable: the DLL somehow call
// this executable.
// The use of AnsiChar is required for this demo because it is normally not
// written in Delphi but in EasyLanguage which has only ANSI strings.
function DllFunc(
StrIn : PAnsiChar
) : PAnsiChar; stdcall; external 'CallingCallerDemoDll.dll';
var
CallingCallerForm: TCallingCallerForm;
implementation
{$R *.dfm}
function TCallingCallerForm.DemoSquare(Arg1 : Integer) : Integer;
begin
Result := Arg1 * Arg1;
Memo1.Lines.Add('DemoSquare called');
end;
function TCallingCallerForm.DemoSum(Arg1 : Integer) : Integer;
begin
Result := Arg1 + Arg1;
Memo1.Lines.Add('DemoSum called');
end;
function TCallingCallerForm.CallDll(Value : Integer) : String;
var
S : String;
DllFctPrm : AnsiString;
Params : String;
FctName : String;
Arg1 : Integer;
Status : Boolean;
State : String;
Value1 : Integer;
Value2 : Integer;
begin
DllFctPrm := '4';
while TRUE do begin
S := String(DllFunc(PAnsiChar(DllFctPrm)));
if not ((S <> '') and (S[1] = '[') and (S[Length(S)] = ']')) then begin
Result := S;
Exit;
end
else begin
Params := Trim(Copy(S, 2, Length(S) - 2));
FctName := ParamByNameAsString(Params, 'FctName', Status, '');
State := ParamByNameAsString(Params, 'State', Status, '');
Memo1.Lines.Add('Callback="' + Params + '"');
if SameText(FctName, 'DemoSquare') then begin
Arg1 := ParamByNameAsInteger(Params, 'Arg1', Status, 0);
Value1 := DemoSquare(Arg1);
DllFctPrm := AnsiString('[' +
'State=' + State +';' +
'Value=' + IntToStr(Value1) +
']');
continue;
end
else if SameText(FctName, 'DemoSum') then begin
Arg1 := ParamByNameAsInteger(Params, 'Arg1', Status, 0);
Value2 := DemoSum(Arg1);
DllFctPrm := AnsiString('[' +
'State=' + State +';' +
'Value=' + IntToStr(Value2) +
']');
continue;
end
else
raise Exception.Create('Unexpected function name');
end;
end;
end;
procedure TCallingCallerForm.Button1Click(Sender: TObject);
begin
Memo1.Lines.Add('Result: ' + CallDll(4));
end;
end.
Here is the code for the DLL:
library CallingCallerDemoDll;
uses
System.SysUtils,
System.Classes,
ParamParsing in '..\DirectCompute\Mandel\Delphi\ParamParsing.pas';
{$R *.res}
var
GBuffer : AnsiString;
Value : Integer;
Value1 : Integer;
Value2 : Integer;
function DllFunc(StrIn : PAnsiChar) : PAnsiChar; stdcall;
var
S : String;
Params : String;
State : Integer;
Status : Boolean;
begin
S := String(StrIn);
if not ((S <> '') and (S[1] = '[') and (S[Length(S)] = ']')) then begin
// Normal call
State := 1;
Value := StrToInt(S);
Value1 := 0;
Value2 := 0;
end;
while TRUE do begin
if not ((S <> '') and (S[1] = '[') and (S[Length(S)] = ']')) then begin
// Call caller
{$WARN USE_BEFORE_DEF OFF}
case State of
1: GBuffer := '[FctName=' + '"DemoSquare";' +
'Arg1=' + AnsiString(IntToStr(Value)) + ';' +
'State=' + AnsiString(IntToStr(State)) + ']';
2: GBuffer := '[FctName=' + '"DemoSum";' +
'Arg1=' + AnsiString(IntToStr(Value)) + ';' +
'State=' + AnsiString(IntToStr(State)) + ']';
end;
Result := PAnsiChar(GBuffer);
Exit;
end
else begin
// Return from function
Params := Trim(Copy(S, 2, Length(S) - 2));
State := StrToInt(ParamByNameAsString(Params, 'State', Status, ''));
case State of
1: begin
Value1 := ParamByNameAsInteger(Params, 'Value', Status, 0);
State := 2;
S := '';
continue;
end;
2: begin
Value2 := ParamByNameAsInteger(Params, 'Value', Status, 0);
GBuffer := AnsiString(Format('Value=%d Square=%d Sum=%d',
[Value, Value1, Value2]));
Result := PAnsiChar(GBuffer);
Exit;
end;
end;
end;
end;
end;
exports
DllFunc;
begin
end.
And finally a support unit to parse values:
unit ParamParsing;
interface
uses
SysUtils;
function ParamByNameAsString(
const Params : String;
const ParamName : String;
var Status : Boolean;
const DefValue : String) : String;
function ParamByNameAsInteger(
const Params : String;
const ParamName : String;
var Status : Boolean;
const DefValue : Integer) : Integer;
implementation
// Parameters format = 'name1="value";name2="value2";....;nameN="valueN"
function ParamByNameAsString(
const Params : String;
const ParamName : String;
var Status : Boolean;
const DefValue : String) : String;
var
I, J : Integer;
Ch : Char;
begin
Status := FALSE;
I := 1;
while I <= Length(Params) do begin
J := I;
while (I <= Length(Params)) and (Params[I] <> '=') do
Inc(I);
if I > Length(Params) then begin
Result := DefValue;
Exit; // Not found
end;
if SameText(ParamName, Trim(Copy(Params, J, I - J))) then begin
// Found parameter name, extract value
Inc(I); // Skip '='
// Skip spaces
J := I;
while (J < Length(Params)) and (Params[J] = ' ') do
Inc(J);
if (J <= Length(Params)) and (Params[J] = '"') then begin
// Value is between double quotes
// Embedded double quotes and backslashes are prefixed
// by backslash
I := J;
Status := TRUE;
Result := '';
Inc(I); // Skip starting delimiter
while I <= Length(Params) do begin
Ch := Params[I];
if Ch = '\' then begin
Inc(I); // Skip escape character
if I > Length(Params) then
break;
Ch := Params[I];
end
else if Ch = '"' then
break;
Result := Result + Ch;
Inc(I);
end;
end
else begin
// Value is up to semicolon or end of string
J := I;
while (I <= Length(Params)) and (Params[I] <> ';') do
Inc(I);
Result := Trim(Copy(Params, J, I - J));
Status := TRUE;
end;
Exit;
end;
// Not good parameter name, skip to next
Inc(I); // Skip '='
if (I <= Length(Params)) and (Params[I] = '"') then begin
Inc(I); // Skip starting delimiter
while I <= Length(Params) do begin
Ch := Params[I];
if Ch = '\' then begin
Inc(I); // Skip escape character
if I > Length(Params) then
break;
end
else if Ch = '"' then
break;
Inc(I);
end;
Inc(I); // Skip ending delimiter
end;
// Param ends with ';'
while (I <= Length(Params)) and (Params[I] <> ';') do
Inc(I);
Inc(I); // Skip semicolon
end;
Result := DefValue;
end;
function ParamByNameAsInteger(
const Params : String;
const ParamName : String;
var Status : Boolean;
const DefValue : Integer) : Integer;
begin
Result := StrToInt(ParamByNameAsString(Params, ParamName, Status, IntToStr(DefValue)));
end;
end.
Everything tested OK with Delphi 10.4.2 (Should work with any other recent Delphi).

RandomStr Missing Operator or Semicolon error

function Randomstring(strLen: Integer): string;
var
ID: string;
begin
ID := 'QWERTYUIOPASDFGHJKLZXCVBNMqwertyuiopasdfghjklzxcvbnm1234567890';
Result := '';
Repeat
Result := Result + ID[Random(Length(ID)) + 1];
until (Length(Result) = strLen)
end;
All the semicolons seem just fine to me. What am I missing?
You are missing a semicolon at the end of the until statement:
until (Length(Result) = strLen); // <-- here

SUBSTRING_INDEX in HANA

I'm migrating the database engine an application from MySql to SAP HANA.
I found a little trouble. I have a query like this:
Select SUBSTRING_INDEX(id, "-", -2) as prod_ref From products;
I don't know how to "translate" the function substring_index, because the initial part of the id has a variable length.
Thanks.
This can be done using a regex:
select substr_regexpr( '.*-([^-]*-[^-]*)$' in 'varia-ble---part-part1-part2' group 1) from dummy;
select substr_regexpr( '.*-([^-]*-[^-]*)$' in 'variable-part-part1-part2' group 1) from dummy;
According to the HANA 2.0 SP0 doc you could use locate with a negative offset (and then using right()), but this does not work on my system ("...feature isn't supported...")
If you execute such queries on a regular basis on lots of records I would recommend extracting the part you are interested in during ETL into a separate field. Or, alternatively fill a separate field using " GENERATED ALWAYS AS...".
I have seen it more than once, that people calculate a field like this in complex SQL queries or complex CalcViews, and then wonder why performance is bad when selecting 100 million records and filtering on the calculated field etc... Performance is usually no problem when you have aggregated your intermediate result set to a reasonable size and then apply "expensive" functions.
I don't think there is any direct function like SUBSTRING_INDEX in SAP HANA. But you have a work around alternative by creating a function to pass the input string and delimiter.
And I am assuming that -2 in SUBSTRING_INDEX and providing the solution
Reverse the string and get the position of the second delimiter, '-' in your case, into "obtainedPosition"
Now subtract that "obtainedPosition" from the length of the string.
obtainedPosition = LENGTH(id) - obtainedPosition
Using that value in the inbuilt substring function you can get the required string and return it from the function.
SELECT SCHEMA.FN_SUBSTRING_INDEX(id,obtainedPosition) INTO ReturnValue FROM DUMMY;
CREATE FUNCTION FN_SUBSTRING_INDEX
(
id VARCHAR(500),
delim VARCHAR(2)
)
RETURNS SplitString VARCHAR(500)
LANGUAGE SQLSCRIPT AS
BEGIN
DECLARE reversedString VARCHAR(500);
DECLARE charString VARCHAR(2);
DECLARE i INT := LENGTH(:id);
DECLARE len INT := LENGTH(:id);
DECLARE obtainedPosition INT := 0;
DECLARE flag INT := 0;
reversedString := '';
--loop to reverse the inputstring
WHILE :i > 0
DO
reversedString = CONCAT(:reversedString, SUBSTRING(:id,:i,1));
i := :i - 1;
END WHILE;
--loop to get the second delimiter position
i := 1;
WHILE :i <= :leng
DO
charString := '';
charString := SUBSTRING(:reversedString,i,1);
IF((:charString = :delim ) AND (:flag < 2)) THEN
BEGIN
obtainedPosition := :i;
flag := :flag + 1;
END;
END IF;
i := :i + 1;
END WHILE;
--IF condition to check if at least 2 delimiters are available, else print complete string
IF(flag = 2) THEN
obtainedPosition := :len - :obtainedPosition + 2; --2 is added to avoid the character at that position and '-' from printing
ELSE
obtainedPosition := 1;
END IF;
--SplitString contains the string's splitted return value
SELECT SUBSTRING(:id,:obtainedPosition) INTO SplitString FROM DUMMY;
END;
The above function is modified from http://www.kodyaz.com/sap-abap/sqlscript-reverse-string-function-in-sap-hana.aspx
For string functions in SAP HANA refer to this: http://www.sapstudent.com/hana/sql-string-functions-in-sap-hana/3
You can use anonymous block in SAP HANA to call and check the function
DO
BEGIN
DECLARE id VARCHAR(500) := 'Test-sam-ple-func';
DECLARE delim VARCHAR(2) := '-';
SELECT SCHEMA.FN_SUBSTRING_INDEX(id,delim) AS "SplitStringIndex" FROM DUMMY;
END;
I would be glad to know reason for a downvote. :)

Call by result Example

Is there any proper example for explaining call-by-result ? (not pseudocode)
I have learned that ALGOL 68, Ada could use this way,
but I cannot find any clear example of Call-by-Result.
I just made by myself.
pseudocode
begin
integer n;
procedure p(k: integer);
begin
n := n+1;
k := k+4;
print(n);
end;
n := 0;
p(n);
print(n);
end;
Implement using Ada Language
call.adb
with Gnat.Io; use Gnat.Io;
procedure call is
x : Integer;
Procedure NonSense (A: in out integer) is
begin
x := x + 1;
A := A + 4;
Put(x);
end NonSense;
begin
x := 0;
NonSense (x);
Put(" ");
Put(x);
New_Line;
end call;
Since Ada uses call-by-result way, result should be 1 4. (It could be checked by entering this code into online-Ada-compiler "http://www.tutorialspoint.com/compile_ada_online.php")
And, other result applied different passing parameter types should be...
call by value: 1 1
call by reference: 5 5
(compare > call by value-result: 1 4)

Writing a program to calculate Happy Numbers in Pascal. Stuck with an infinite loop

I'm writing a procedure to do the calculating. The program asks the user for any number between 1 and 9999 and then calculates whether or not that number is a happy number.
program EindEvaluatieProceduresFuncties2;
uses wincrt, math;
var lucky: boolean;
num: longint;
i, j: integer;
arr: array [1..4] of integer;
sum: integer;
procedure HappyNumber;
begin
repeat
begin
repeat
begin
i:=i+1;
//writeln('i = ',i);
arr[i]:=num mod 10;
//writeln( 'a[i] = ', arr[i] );
num:=num div 10;
//writeln ( 'n = ', num );
end;
until num=0;
//writeln('Digits are : ');
//for j:=i downto 1 do
//writeln('a[j] = ', arr[j],' ', j);
//writeln('Calculating Happy Number');
for j := i downto 1 do
sum := sum + (Sqr(arr[j]));
for j := i downto 1 do
writeln('sum = ',sum);
num := sum;
end;
until sum < 10 ;
end;
begin
lucky := false;
writeln('Please give a positive number below 10000.');
readln(num);
while ( num < 1 ) or ( num > 9999 ) do
begin
writeln('Number must be positive and less than 10000. Try again.');
readln(num);
end;
HappyNumber;
if (lucky = True) then
begin
writeln(num, ' is a happy number.');
end
else
begin
writeln(num, ' is not a happy number.');
end;
writeln('');
writeln('Press < ENTER > to end the program.');
readln;
end.
Within the procedure I have the command i := 0; as seen below:
procedure HappyNumber;
begin
repeat
begin
repeat
begin
i:=0;
i:=i+1;
This is where the problem occurs. If I do this it becomes an infinite loop, however if I place the command outside of the repeat loop then i does not reset to 0 at the beginning of every iteration of the loop, which I need it to.
I should point out that much of the code is there at the moment simply to let me see what is happening and wont be a part of the final code. Wherever I have inserted "//" are those lines.
I am aware that there is perhaps a better way I could be doing this whole program. If anyone has any suggestions for how I can make it easier, I'd also appreciate that very much.
Thank you.
Never heard of happy / unhappy numbers and found it quite interesting to solve this task :-)
There is still a lot to optimize but I think you can use it for studying.
program EindEvaluatieProceduresFuncties2;
uses SysUtils, crt ;
var input: string;
number: integer;
code: integer;
function HapyNumber(num: integer):boolean;
var
erg: integer;
digit: integer;
begin
Result := true;
erg := 0;
if num = 4 then Result := false;
if num = 4 then exit;
if num = 1 then exit;
if num = 0 then exit;
// serialize the number into digits and calculate the next number
while num > 0 do begin
digit := num mod 10;
num := num div 10;
erg := erg + digit * digit;
write(IntToStr(digit) + ' ');
end;
write(IntToStr(num) + ' ');
writeln('=' + IntToStr(erg));
Result := HapyNumber(erg);
end;
begin
repeat
writeln('Please give a positive number below 10000.' + sLineBreak + 'Number must be positive and less than 10000.' + sLineBreak + 'Type x for exit!');
readln(input);
if lowerCase(input) = 'x' then exit;
val(input, number, code);
if code <> 0 then begin
ClrScr;
writeln('Invalid number "' + input + '" !');
end
else if (number > 0) and (number <= 9999) then begin
ClrScr;
writeln('Cheking ' + IntToStr(number) + '..');
if HapyNumber(number) then writeln(number, ' is a happy number.')
else writeln(number, ' is not a happy number.');
writeln('Press enter to continue');
readln;
ClrScr;
end;
until lowerCase(input) = 'x';
end.
The important codepart is
while num > 0 do begin
digit := num mod 10;
num := num div 10;
erg := erg + digit * digit;
write(IntToStr(digit) + ' '); // just output the tmp result
end;
It serialize a number into digits (1973 will be 3 7 9 1)
I used recursion just for fun and it is not really necessary :-)