Pascal Counting the number of words in a line - char

I am trying to write a program that will count the number of words in each line. But the loop is not interrupted by a newline.
`
program StringSymbols;
var
c : char;
i : integer;
begin
i := 1;
c := ' ';
writeln('Enter your string');
while c <> '#13' do
begin
read(c);
if c = ' ' then i := i + 1;
end;
writeln('count words: ', i)
end.
`
Please tell me how to write correctly. It is important that it was character-by-character reading.

The most common way to test whether a file is at end of line is to use the eoln function. So in your program, this would be
while not eoln do
begin
read(c);
if c = ' ' then i := i + 1;
end;

The character literal #13 for Carriage-Return should not be placed inside apostrophes, as then you got a three letter string.
read(c);
while (c <> #13) and (c <> #10) do
begin
if c = ' ' then inc(i);
read(c);
end;

Related

PL/SQL Get Dimensions of JPEG Image

Support for Oracle Multimedia was dropped in Oracle 19c, so my code to extract dimensions from a JPEG image is throwing an error. Is there a workaround to this issue?
For Oracle 12, my code looked like this:
BEGIN
img := ORDSYS.ORDImage.init('FILE', my_dir, my_img_name);
img.setProperties();
w := img.getWidth();
h := img.getHeight();
EXCEPTION
WHEN OTHERS THEN
w := NULL;
h := NULL;
END;
Based on code found in a response to "Getting Image size of JPEG from its binary" (I'm not sure which language), I came up with this procedure:
PROCEDURE p_jpegstats(directory_in IN VARCHAR2,
filename_in IN VARCHAR2,
height_out OUT INTEGER,
width_out OUT INTEGER,
bpc_out OUT INTEGER, -- bits per channel
cps_out OUT INTEGER -- colors per component
) IS
file bfile;
pos INTEGER:=1;
h VARCHAR2(4);
w VARCHAR2(4);
mrkr VARCHAR2(2);
len VARCHAR2(4);
bpc VARCHAR2(2);
cps VARCHAR2(2);
-- Declare a quick helper procedure for readability
PROCEDURE next_byte(buf out varchar2, amt INTEGER:=1) IS
cnt INTEGER;
BEGIN
cnt := amt;
dbms_lob.read(file, cnt, pos, buf);
pos := pos + cnt;
END next_byte;
BEGIN
-- This code is based off of code found here: https://stackoverflow.com/a/48488655/3303651
-- Open the file
file := bfilename(directory_in, filename_in);
dbms_lob.fileopen(file);
-- Init the output variables in case something goes awry.
height_out := NULL;
width_out := NULL;
bpc_out := NULL;
cps_out := NULL;
LOOP
BEGIN
LOOP
next_byte(mrkr);
EXIT WHEN mrkr <> 'FF';
END LOOP;
CONTINUE WHEN mrkr = 'D8'; -- Start of image (SOI)
EXIT WHEN mrkr = 'D9'; -- End of image (EOI)
CONTINUE WHEN mrkr BETWEEN 'D0' AND 'D7';
CONTINUE WHEN mrkr = '01'; -- TEM
next_byte(len, 2);
IF mrkr = 'C0' THEN
next_byte(bpc); -- bits per channel
next_byte(h, 2); -- height
next_byte(w, 2); -- width
next_byte(cps); -- colors per component
EXIT;
END IF;
pos := pos + to_number(len, 'XXXX') - 2;
EXCEPTION WHEN OTHERS THEN EXIT; END;
END LOOP;
-- Write back the values we found
height_out := to_number(h, 'XXXX');
width_out := to_number(w, 'XXXX');
bpc_out := to_number(bpc, 'XX');
cps_out := to_number(cps, 'XX');
-- close out the file
dbms_lob.fileclose(file);
END p_jpegstats;
This will throw an error if the directory is invalid or the file can't be opened. If the outputs are NULL, then there was some other issue.
It's probably not the most efficient or elegant code (I'm not a pro with PL/SQL [yet!]), but it works. Here is an example usage:
DECLARE
h INTEGER;
w INTEGER;
bpc INTEGER;
cps INTEGER;
BEGIN
p_jpegstats('MY_DIR', 'my_image.jpg', h, w, bpc, cps);
DBMS_OUTPUT.PUT_LINE(w || ' x ' || h || ' ' || bpc || ' ' || cps);
END;
/
This ought to return something like
800 x 200 8 3
Edit: Removed unused variable.

Lazarus function to find 8 digit numbers in a string

I have e-mail subject lines and I want to find ticket references in them it could be the TT ref is like 12345678. One subject line (string) can have multiple 8 digit numbers!
I have been using the below code but it is merely stripping out the first 8 digits then doing a check if that is 8 char long:
function StripNumbers(const aString: string): string;
var
C: char;
begin
Result := '';
for C in aString do
begin
if CharInSet(C, ['0'..'9']) then
begin
Result := Result + C;
end;
end;
end;
Example:
my string variable is
subject := "yada yada XF12345678 blabla XF87654321 duh XF11.223344"
function GetTTRefs(subject) should result "12345678;87654321;"
Thank you for answers.
function GotTTRefs(Subject:string;Digits:Byte):string;
var
i:integer;
TT:string;
begin
i:=1;
while i <= Length(Subject)-Digits+1 do
begin
if Subject[i] in ['1'..'9'] then
begin
TT:=Copy(Subject,i,Digits);
if (StrToQWordDef(TT, 0) <> 0) then
Result:=Result+TT+';';
end;
inc(i);
end;
end;

How to find a dbms_output.put_line() alternative to print contents line by line every time when it gets called in every iteration?

I want to view the output as the program goes while processing some records. Reading the line will not help, as it just retrieves is from the buffer and nothing else. For example:
DECLARE
CURSOR cEmploee IS SELECT * FROM g_emploees;
iTotal INTEGER := 0;
iCount INTEGER := 0;
BEGIN
SELECT COUNT(*) FROM g_emploees INTO iTotal;
FOR rLine IN cEmploee loop
dbms_output.put_line('Porcessed['||rLine.id||']: '|| ((iCount/iTotal)*100) || '%')
iCount := iCount + 1;
END LOOP;
END;
I cannot use dbms_output.get_line(), So stop marking it answered !
I cannot pipe the output to a file for read-only reasons !
Is there a command/setting for DBMS that I can use in order to view the processed % and print the line for processed in EVERY ITERATION and not at the end as a whole bunch of lines persisting in the buffer (The line printed must show every and exact time in PL/SQL when "dbms_output.put_line" is called not like 500 lines at the end of the execution) ??
CREATE OR REPLACE FUNCTION test_pipe
RETURN sys.DBMS_DEBUG_VC2COLL
pipelined
as
CURSOR cEmploee IS
SELECT * FROM g_emploees;
iTotal INTEGER := 0;
iCount INTEGER := 0;
BEGIN
SELECT COUNT(*)
INTO iTotal
FROM g_emploees ;
FOR rLine IN cEmploee loop
PIPE row('Porcessed['||rLine.id||']: '|| ((iCount/iTotal)*100) || '%');
iCount := iCount + 1;
END LOOP;
END;
/
--execute below statements ON command window :
SQL >set arraysize 1
SQL > SELECT * FROM TABLE(test_pipe);

Checking if word is palindrome with function

I have to write a program in Pascal which checks whether a word is a palindrome.
For example:
if I input "abba" then write 'TRUE'
input 'abb a' then write 'TRUE'
input 'abca' write 'FALSE'
I wrote this:
program palindromek;
var i,j,delka,pul:integer;
str:string;
function palindrom(slovo:string):boolean;
const mezera=32;
begin
delka:=length(str);
if (delka mod 2) = 0 then pul:=delka div 2
else pul:=(delka-1) div 2;
for i:=1 to delka do
begin
if (ord(slovo[i])>=ord('a')) and (ord(slovo[i])<=ord('z')) then
begin
if (delka>=4)and(delka<=100) then
begin
if (length(str) mod 2) = 0 then {slovo se sudym poctem pismen}
begin
for j:=1 to pul do
begin
if slovo[j]=slovo[length(str)-j+1]
then palindrom:=true else palindrom:=false
end
end else
begin
for j:=1 to pul do
begin
if slovo[j]=slovo[length(str)-j+1]
then palindrom:=true else palindrom:=false
end
end
end else if slovo[1]=slovo[delka]
then palindrom:=true else palindrom:=false
end
end;
end;
begin
readln(str);
writeln(palindrom(str));
end.
but it has to ignore spaces. Do you have any idea please?
To remove all spaces, you can use function like this:
procedure RemoveSpacesInplace(var s: string);
var
i, SpaceCount: Integer;
begin
SpaceCount := 0;
for i := 1 to Length(s) do
if s[i] = ' ' then
Inc(SpaceCount)
else
s[i - SpaceCount] := s[i];
SetLength(s, Length(s) - SpaceCount);
end;
You can modify it for other non-letter chars.
Note that your logic for odd and even length is excessive. Try to simplify it.
You can use the functions StringReplace and ReverseString for your task.
program palindromek;
uses SysUtils, StrUtils;
var
str:string;
function palindrom(slovo:string):boolean;
begin
slovo := StringReplace(slovo, ' ', '', [rfReplaceAll]);
Result := slovo = ReverseString(slovo)
end;
begin
readln(str);
writeln(palindrom(str));
readln;
end.
If you are not allowed to use SysUtils and StrUtils then you can manually reverse your string and then compare if the original string and the reversed string are equal.
This would look something like this: (not tested!)
function palindrom(slovo:string):boolean;
var slovofor: string;
slovorev: string;
i: integer;
begin
for i:= length(slovo) downto 1 do begin
if slovo[i] <> ' ' then begin
slovofor := slovofor + slovo[length(slovo)-i+1];
slovorev := slovorev + slovo[i];
end;
end;
writeln(slovofor);
Result := slovofor = slovorev
end;

read() strings of variable length

I've got rows of two values (input from console) that look likes this:
David 89000
Peter 99500
Jim 23999
END 1
is there a way to save the string and number into a variable other than to loop-read a char when you don't know the string length?
str:=''; salary:=0; i:=1;
while str<> 'END' do
begin
str:=''; salary:=0;
read(ch);
while ch <> ' ' do
begin
str:=str+ch;
read(ch);
end;
read(salary);
array[i].name:=str;
array[i].salary:=salary;
i:=i+1;
readln;
end;
You can do it with a single call to ReadLn and then parse the input yourself:
var
TextIn: string;
Person: string;
Salary: Integer;
begin
while true do
begin
ReadLn(TextIn); // Requires user to hit Enter
if Copy(TextIn, 1, 3) <> 'END' then
begin
Person := Copy(TextIn, 1, Pos(' ', TextIn) - 1);
Salary := StrToInt(Copy(TextIn, Pos(' ', TextIn) + 1, 255);
end
else
Exit;
end;
end;
I didn't include any error checking (which should be there), because your original code doesn't have any either.
Not with standard I/O functions. Of course you can put that code in a separate procedure, or split with tstringlist.

Resources