Usage of LOB's in progress 4GL - progress-4gl

As known Progress provides 4 large object datatypes data types MEMPTR,CLOB,BLOB,LONGCHAR.
But the string functions Can't be used either on CLOB or LONGCHAR datatypes.
How to use perform string operations on these LOB Datatypes.
"string operations" means substring ,replace,trim etc. functions which can be performed on the strings.To be more clear
Define vChar as Character INITIAL "ashdbi" NO_UNDO.
MESSAGE SUBSTRING(vChar,1,1)
VIEW-AS ALERT_BOX .
The same way can we perform string operations on LOB's?

A CLOB is stored in the database and LONGCHAR is the datatype used to manipulate it locally. If you store a BLOB you must use a MEMPTR if you want to handle it locally.
Since your asking about STRING-related functions I assume that CLOBS and LONGCHARs are what you're after (CLOB = Chararcter Large Object as supposed to BLOB = Binary Large Object).
Several (or some) string manipulation methods and functions can be used on LONGCHARS, for instance SUBSTRING. Regardless if you're using a CHARACTER or LONGCHAR the syntax is displayed. If you want to
Example - SUBSTRING, INDEX and COPY-LOB
DEFINE VARIABLE cStart AS LONGCHAR NO-UNDO.
DEFINE VARIABLE cEnd AS LONGCHAR NO-UNDO.
DEFINE VARIABLE cString AS CHARACTER NO-UNDO.
DEFINE VARIABLE i AS INTEGER NO-UNDO.
/* Fill the variable with lots of bogus data */
DO i = 1 TO 10000:
cStart = cStart + "ABCDEFGHIJKLMN".
/* Insert a _ once in 100 */
IF RANDOM(1, 100) = 100 THEN cStart = cStart + "_".
END.
DISPLAY LENGTH(cStart).
/* SUBSTRING */
cEnd = SUBSTRING(cStart, 1, 100000).
DISPLAY LENGTH(cEnd).
/* Is there a _ in the string - most likely! */
DISPLAY INDEX(cStart, "_").
/* SUBSTRING will convert output to CHARACTER if the length is less than roughly 32k */
cString = SUBSTRING(cStart, 1, 30000).
DISPLAY cString.
/* Lets save the CLOB so we can look at it */
COPY-LOB FROM cStart TO FILE "c:\temp\testing.txt".
/* Actually you can DISPLAY a LONGCHAR as well but why would you really? */
DISPLAY cStart
VIEW-AS EDITOR LARGE INNER-LINES 300 INNER-CHARS 300
WITH FRAME x1 WIDTH 320 .

There were some exceptions in older releases but "string functions" work very well on longchar data.
To get data between the various large objects (CLOB, BLOB, MEMPTR and files) and into a LONGCHAR and vice-verse you need to use the COPY-LOB statement. Is suspect that that is the "secret sauce" that you are missing.
For instance:
define variable cfgData as longchar no-undo.
assign file-info:file-name = search( "etc/stomp.cfg" ).
copy-lob from file file-info:full-pathname to cfgData no-error.
stompCfg = new dotr.Stomp.StompConfig().
assign
stompCfg:StompPort = "61613"
stompCfg:StompServer = entry( 1, cfgData, ":" )
stompCfg:StompPort = entry( 2, cfgData, ":" ) when num-entries( cfgData, ":" ) > 1
stompCfg:LargeMessageSupport = yes
.

Related

Convert the decimal value to get the split binary in Progress 4gl

I have to make a program which has the output like this :
def var vbit as logical extent 64 initial "false".
def var x as char form "x(16)" /* to store the decimal input */
Input : 2220010000000000
convert the value into:
22=00100010
20=00100000
01=00000001
00=00000000
00=00000000
00=00000000
00=00000000
then if the binary is sorted,the output will be:
123456789012345678901234
00100010001000000000000100000000000000000000000000000000
from this binary, change the vbit [x] like on the image.
Thanks a lot for the answer.
This is a quick example, most likely not usable for production like enviroments...
As far as I know there are no built in functions or methods to create binary numbers. So I've borrowed a function from here:
http://knowledgebase.progress.com/articles/Article/P125416
I've modified the function to return the integers with a 4 digit format, this will work for this specific example but of course not for larger binary numbers.
DEFINE VARIABLE vbit AS LOGICAL EXTENT 64 NO-UNDO .
DEFINE VARIABLE cString AS CHARACTER NO-UNDO FORMAT "x(16)".
DEFINE VARIABLE cBinary AS CHARACTER NO-UNDO.
DEFINE VARIABLE i AS INTEGER NO-UNDO.
ASSIGN
cString = "2220010000000000".
FUNCTION getBinary RETURNS CHARACTER (INPUT piValue AS INTEGER):
DEFINE VARIABLE cReturn AS CHARACTER NO-UNDO .
DEFINE VARIABLE iReturn AS INTEGER NO-UNDO FORMAT "9999".
DO WHILE piValue > 0:
ASSIGN
cReturn = STRING( piValue MOD 2 ) + cReturn
piValue = TRUNCATE( piValue / 2, 0 )
.
END.
IF cReturn = "" THEN cReturn = "0".
iReturn = INTEGER(cReturn).
RETURN STRING(iReturn, "9999").
END FUNCTION.
/* Convert the string of integers into a binary format */
DO i = 1 TO LENGTH(cString):
cBinary = cBinary + getBinary(INTEGER(SUBSTRING(cString, i, 1))).
END.
/* Move the binary numbers into the boolean variable */
DO i = 1 TO LENGTH(cBinary).
IF SUBSTRING(cBinary, i, 1) = "1" THEN
vbit[i] = TRUE.
ELSE
vbit[i] = FALSE.
END.
/* Uncomment this to output
123456789012345678901234
00100010001000000000000100000000000000000000000000000000
*/
/*
DISP "123456789012345678901234" SKIP
cBinary FORMAT "x(70)" WITH FRAME fr1 4 DOWN WIDTH 90.
*/
/* Display the boolean variable in the specified format */
DISP vbit WITH FRAME fr2 SIDE-LABELS 4 COLUMNS WIDTH 90 25 DOWN.

How to get the field name dynamically and update it to main table in progress

Program:It is a just maintenance program, in this one it displays the Item Code in one frame and it prompt for the input. if you enter the item code it has to displays what are the blank fields for that record in pt_mstr and display in one frame(No need to display all blank fields, just first 4 or 5 fields enough). and also in that frame only if user want to update it update directly to main table pt_mstr.
What i tried is, i just write the code for getting blank fields using buffer handle and after that i create one temp table and displaying the fields, i strucked there itself, i am unable to update fields.
My code:
/*Sample Item master Maintenance Program*/
/* DISPLAY TITLE */
{us/mf/mfdtitle.i "3+ "}
DEFINE VARIABLE hBuffer AS HANDLE NO-UNDO.
DEFINE VARIABLE i AS INTEGER NO-UNDO.
DEFINE VARIABLE j AS INTEGER NO-UNDO.
DEFINE VARIABLE hField AS HANDLE NO-UNDO.
define variable fldnm as character extent 10 no-undo.
define temp-table tt_temp no-undo
field tt_part like pt_part
field field1 as char extent 10.
form
pt_part colon 25
with frame a side-labels width 80.
setFrameLabels(frame a:handle).
/* DISPLAY */
view frame a.
repeat with frame a:
prompt-for pt_part
editing:
/* FIND NEXT/PREVIOUS RECORD */
{us/mf/mfnp.i pt_mstr pt_part "pt_mstr.pt_domain = global_domain and pt_part" pt_part pt_part pt_part }
if recno <> ? then
do:
display pt_part.
find pt_mstr where pt_part = input pt_part and pt_domain=global_domain no-lock no-error.
ASSIGN hBuffer = BUFFER pt_mstr:HANDLE.
empty temp-table tt_temp.
j = 1.
DO i = 1 TO 10:
ASSIGN hField = hBuffer:BUFFER-FIELD(i).
IF ((hField:BUFFER-VALUE = "" )) THEN
do:
/* message hField:NAME "test" view-as alert-box.*/
find first tt_temp where tt_part = pt_part no-lock no-error.
if not avail tt_temp then
do:
create tt_temp.
assign
tt_part = pt_part
field1[j] = hField:NAME.
j = j + 1.
end.
else do:
assign
field1[j] = hField:NAME.
j = j + 1.
end.
end.
end.
end.
for each tt_temp:
display field1[1] field1[2] field1[3] field1[4].
end.
end.
end.
Are you sure you need your temp-tables to do this? I've created an example using only the actual table (but created a fake temp-table instead). You would have to look into data error handling, data validation, transaction, locking etc before putting this into production of course.
/*First we need some fake data */
DEFINE TEMP-TABLE ttMockedData NO-UNDO
FIELD id AS INTEGER
FIELD dataName AS CHARACTER FORMAT "x(8)"
FIELD dataType AS CHARACTER FORMAT "x(8)"
FIELD dataDescrioption AS CHARACTER FORMAT "x(32)".
DEFINE VARIABLE iId AS INTEGER NO-UNDO.
DEFINE VARIABLE iSearch AS INTEGER NO-UNDO LABEL "Search".
PROCEDURE createData:
DEFINE INPUT PARAMETER pcName AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER pcType AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER pcDesc AS CHARACTER NO-UNDO.
iId = iId + 1.
CREATE ttMockedData.
ASSIGN
ttMockedData.id = iId
ttMockedData.dataName = pcName
ttMockedData.dataType = pcType
ttMockedData.dataDesc = pcDesc.
END PROCEDURE.
RUN createData("Test 1", "TESTTYPE", "A TEST").
RUN createData("Test 2", "", "ANOTHER TEST").
RUN createData("", "TESTTYPE 2", "").
RUN createData("4", "", "").
/* Program starts here */
updating:
REPEAT:
UPDATE iSearch WITH FRAME x0.
IF iSearch > 0 THEN DO:
FIND FIRST ttMockedData NO-LOCK WHERE ttMockedData.id = iSearch NO-ERROR.
IF NOT AVAILABLE ttMockedData THEN DO:
MESSAGE "Not found" VIEW-AS ALERT-BOX ERROR.
RETURN ERROR.
END.
ELSE DO:
DISP ttMockedData WITH FRAME x1 1 COLUMNS SIDE-LABELS.
/* Is there an empty field? - Then we update! */
IF ttMockedData.dataName = ""
OR ttMockedData.dataType = ""
OR ttMockedData.dataDescrioption = "" THEN DO:
DISPLAY
ttMockedData.dataName
ttMockedData.DataType
ttMockedData.dataDesc
WITH FRAME x2 1 COLUMN SIDE-LABELS TITLE "Complete the data...".
/* This isn't working with temp-tables of course! */
/* Just here to make sure you handle locking! */
FIND CURRENT ttMockedData EXCLUSIVE-LOCK.
UPDATE
ttMockedData.dataName WHEN ttMockedData.dataName = ""
ttMockedData.DataType WHEN ttMockedData.DataType = ""
ttMockedData.dataDesc WHEN ttMockedData.dataDesc = ""
WITH FRAME x2.
/* This isn't working with temp-tables of course! */
/* Just here to make sure you handle locking! */
FIND CURRENT ttMockedData NO-LOCK.
END.
END.
END.
ELSE LEAVE updating.
END.

How do you get the output value of a C(CDELC) function defined in an external library as char**

I want to be able to use the following function defined in a shared object file (lib.so) :
int encrypt_data (char* buffer_in, int size_in, char** buffer_out, int* size_out)
Basically, i want to be able to pass the content of a file to this function (buffer_in) and write the output content (buffer_out) into another file. Here is what i've tried so far :
PROCEDURE encrypt_data EXTERNAL "lib.so" CDECL :
DEFINE INPUT PARAMETER buffer_in AS MEMPTR.
DEFINE INPUT PARAMETER size_in AS LONG.
DEFINE OUTPUT PARAMETER buffer_out AS MEMPTR.
DEFINE OUTPUT PARAMETER size_out AS LONG.
DEFINE RETURN PARAMETER returnvalue AS LONG.
END PROCEDURE.
PROCEDURE pi_encryptHash:
DEFINE INPUT PARAMETER ipc_fullPathToEncrypt AS CHARACTER NO-UNDO.
DEFINE VARIABLE lm_bufferIn AS MEMPTR NO-UNDO.
DEFINE VARIABLE li_sizeIn AS INT NO-UNDO.
DEFINE VARIABLE lm_bufferFakeOut AS MEMPTR NO-UNDO.
DEFINE VARIABLE lm_bufferOut AS MEMPTR NO-UNDO.
DEFINE VARIABLE li_sizeOut AS INT NO-UNDO.
DEFINE VARIABLE li_returnedCode AS INTEGER NO-UNDO.
/* make sure MEMPTR is sized correctly */
FILE-INFO:FILE-NAME = ipc_fullPathToEncrypt.
SET-SIZE(lm_bufferIn) = FILE-INFO:FILE-SIZE.
li_sizeIn = GET-SIZE(lm_bufferIn).
/* the actual read */
INPUT FROM VALUE(ipc_fullPathToEncrypt) BINARY NO-MAP NO-CONVERT.
IMPORT lm_bufferIn.
INPUT CLOSE.
/* Call the encrypt proc a first time to get the output lenght */
SET-SIZE(lm_bufferFakeOut) = 2.
RUN encrypt_data(INPUT lm_bufferIn, INPUT li_sizeIn, OUTPUT lm_bufferFakeOut, OUTPUT li_sizeOut, OUTPUT li_returnedCode).
/* Call it a second time with a buffer large enough to get the output value */
SET-SIZE(lm_bufferOut) = li_sizeOut.
RUN encrypt_data(INPUT lm_bufferIn, INPUT li_sizeIn, OUTPUT lm_bufferOut, OUTPUT li_sizeOut, OUTPUT li_returnedCode).
/* Write MEMPTR to file */
OUTPUT TO VALUE(ipc_fullPathToEncrypt + ".sha") BINARY NO-MAP NO-CONVERT.
EXPORT lm_bufferOut.
OUTPUT CLOSE.
SET-SIZE(lm_bufferIn) = 0.
SET-SIZE(lm_bufferOut) = 0.
DISPLAY li_returnedCode.
RETURN "".
END PROCEDURE.
I think my problem is that i can't read the data of char** buffer_out, from what i understand it is a pointer to a pointer so what i'm really exporting here EXPORT lm_bufferOut. is the pointer address of the data i would like to export? But how can i export the data instead?
Maybe not an answer to your original question but be aware that there are built functions in Progress for encryption. For instance you can do like this (in this example the encrypted value is base64-encoded so the result is "viewable"):
DEFINE VARIABLE cClearText AS CHARACTER NO-UNDO.
DEFINE VARIABLE rBinaryKey AS RAW NO-UNDO.
DEFINE VARIABLE rEncryptedValue AS RAW NO-UNDO.
DEFINE VARIABLE cEncryptedText AS CHARACTER NO-UNDO.
DEFINE VARIABLE cDecryptedText AS CHARACTER NO-UNDO.
ASSIGN
cClearText = "This is the clear text string to be encrypted.".
MESSAGE "Original message: " cCleartext
VIEW-AS ALERT-BOX INFO BUTTONS OK.
ASSIGN
SECURITY-POLICY:SYMMETRIC-ENCRYPTION-ALGORITHM = "AES_OFB_256"
rBinaryKey = GENERATE-RANDOM-KEY
SECURITY-POLICY:SYMMETRIC-ENCRYPTION-KEY = rBinaryKey
SECURITY-POLICY:SYMMETRIC-ENCRYPTION-IV = ?
rEncryptedValue = Encrypt (cClearText)
cEncryptedText = BASE64-ENCODE(rEncryptedValue)
.
MESSAGE "Encrypted Message:" cEncryptedText
VIEW-AS ALERT-BOX INFO BUTTONS OK.
ASSIGN
SECURITY-POLICY:SYMMETRIC-ENCRYPTION-KEY = rBinaryKey
cDecryptedText = GET-STRING(DECRYPT (rEncryptedValue),1).
MESSAGE "Decrypted Message: " cDecryptedText
VIEW-AS ALERT-BOX INFO BUTTONS OK.
This example is based on this knowledge base entry.
You can do:
MESSAGE SECURITY-POLICY:SYMMETRIC-SUPPORT VIEW-AS ALERT-BOX.
to see supported symmetric encryption algorithms supported.
Here's an SO question regarding different versions of AES algorithms:
How to choose an AES encryption mode (CBC ECB CTR OCB CFB)?
A solution has been found, below is the program used :
PROCEDURE pi_encryptDecrypt:
DEFINE INPUT PARAMETER ipc_inputFile AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER ipc_outputFile AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER ipi_codeOp AS INTEGER NO-UNDO.
DEFINE VARIABLE lm_bufferIn AS MEMPTR NO-UNDO.
DEFINE VARIABLE li_sizeIn AS INT NO-UNDO.
DEFINE VARIABLE lm_bufferFakeOut AS MEMPTR NO-UNDO.
DEFINE VARIABLE lm_bufferOut AS MEMPTR NO-UNDO.
DEFINE VARIABLE li_sizeOut AS INT NO-UNDO.
DEFINE VARIABLE li_returnedCode AS INTEGER NO-UNDO.
define variable mtarget as memptr.
/* make sure MEMPTR is sized correctly */
FILE-INFO:FILE-NAME = ipc_inputFile.
SET-SIZE(lm_bufferIn) = FILE-INFO:FILE-SIZE.
li_sizeIn = GET-SIZE(lm_bufferIn).
/* the actual read */
copy-lob from file ipc_inputFile to lm_bufferIn.
/* set a buffer large enough to get the output value */
SET-SIZE(lm_bufferOut) = 8.
if ipi_codeOp = 1 then
RUN encrypt_data(INPUT lm_bufferIn, INPUT li_sizeIn, OUTPUT lm_bufferOut, OUTPUT li_sizeOut, OUTPUT li_returnedCode).
else
RUN decrypt_data(INPUT lm_bufferIn, INPUT li_sizeIn, OUTPUT lm_bufferOut, OUTPUT li_sizeOut, OUTPUT li_returnedCode).
set-size(mtarget) = li_sizeOut.
SET-POINTER-VALUE(mtarget) = GET-INT64(lm_bufferOut, 1).
/* Write MEMPTR to file */
os-delete value(ipc_outputFile).
COPY-LOB FROM mtarget for /* FOR est SUPER IMPORTANT !! - ne pas enlever */ li_sizeOut TO FILE (ipc_outputFile).
SET-SIZE(lm_bufferIn) = 0.
SET-SIZE(lm_bufferOut) = 0.
set-size(mtarget) = 0.
/*DISPLAY li_returnedCode.
DISPLAY li_sizeOut.*/
RETURN "".
END PROCEDURE.
As i stated in my question, the problem was indeed that char** buffer_out returns a pointer to a pointer to the data in the memory.
The trick was to use a second MEMPTR (mtarget) that will point to the actual data, size it to be large enough with SET-SIZE and then sets it to the value of a particular memory location (using SET-POINTER-VALUE), which we get from GET-INT64(lm_bufferOut, 1).

How to test if string is numeric using Progress 4GL

Does Progress 4GL have a function for testing whether a string is numeric, like PHP's is_numeric($foo) function?
I've seen the function example at http://knowledgebase.progress.com/articles/Article/P148549 to test if a character in a string is numeric. Looks like it has a typo, btw.
But I would think the language would be a built-in function for this.
I was looking at this myself recently. The approved answer given to this doesn't work in 100% situations.
If the user enters any of the following special string characters: ? * - or + the answer won't work.
A single plus or minus(dash) is converted to 0 which you may not want.
A single question mark character is valid value which progress recognises as unknown value at which again you may not want.
A single or group asterisks on their own also get converted to 0.
If you run the following code you'll see what I mean.
DISP DECIMAL("*")
DECIMAL("**")
DECIMAL("?")
DECIMAL("+")
DECIMAL("-").
The following additional code maybe useful to get around this
DEFINE VARIABLE iZeroCode AS INTEGER NO-UNDO.
DEFINE VARIABLE iNineCode AS INTEGER NO-UNDO.
DEFINE VARIABLE chChar AS CHARACTER NO-UNDO.
ASSIGN iZeroCode = ASC("0")
iNineCode = ASC("9")
chChar = SUBSTRING(cNumber,1,1).
IF NOT(ASC(chChar) >= iZeroCode AND ASC(chChar) <= iNineCode) THEN DO:
MESSAGE "Invalid Number..." VIEW-AS ALERT-BOX.
END.
Do not need a function can jsut do a straight conversion.
ASSIGN dNumber = DECIMAL(cNumber) NO-ERROR.
IF ERROR-STATUS:ERROR THEN
DO:
{Handle issues}
END.
or if it is always whole numbers can use INTEGER instead of DECIMAL.
The language does not have a built-in "isNum()" type of function.
An alternative to the kbase method would be:
function isNum returns logical ( input s as character ):
define variable n as decimal no-undo.
assign
n = decimal( s )
no-error
.
return ( error-status:num-messages = 0 ).
end.
display isNum( "123" ) isNum( "xyz" ).
This code handles any numeric strings - even if the used Character is longer than the max Decimal length etc.
FUNCTION isNumeric RETURNS LOGICAL (textvalue AS CHAR):
DEF VAR i AS INT NO-UNDO.
IF textvalue = ? THEN RETURN TRUE.
DO i = 1 TO (LENGTH(textvalue) - 1):
INT(SUBSTRING(textvalue, i, (i + 1))) NO-ERROR.
IF ERROR-STATUS:ERROR THEN RETURN FALSE.
END.
RETURN TRUE.
END FUNCTION.
Works 100% of the time
FUNCTION is-num RETURNS LOGICAL
(INPUT cString AS CHARACTER):
DEFINE VARIABLE iZeroCode AS INTEGER NO-UNDO.
DEFINE VARIABLE iNineCode AS INTEGER NO-UNDO.
DEFINE VARIABLE cChar AS CHARACTER NO-UNDO.
DEFINE VARIABLE iCount AS INTEGER NO-UNDO.
DO iCount = 1 TO LENGTH(cString):
ASSIGN iZeroCode = ASC("0")
iNineCode = ASC("9")
cChar = SUBSTRING(cString,iCount,1).
IF NOT(ASC(cChar) >= iZeroCode AND ASC(cChar) <= iNineCode) THEN DO:
RETURN FALSE.
END.
END.
RETURN TRUE.
END.

command to find the number of entries in a temp table

What is the command to find the number of entries/rows in a temp table? version 10.2b
/* create a temp-table so that we can test this technique
*/
define temp-table ttTest
field id as int
.
create ttTest.
id = 1.
create ttTest.
id = 2.
/* how many records?
*/
define query q for ttTest cache 0.
open query q preselect each ttTest.
display num-results( "q" ).
or you can use clasic FOR EACH:
DEFINE VARIABLE iCount AS INT NO-UNDO.
FOR EACH ttTest:
iCount = iCount + 1.
END.
DISPLAY iCount.
Here's mine, that works for any temp-table :
FUNCTION TT_NBREC RETURNS INTEGER ( INPUT pr_hd_temptable AS HANDLE ) :
DEFINE VARIABLE in_nbrec AS INTEGER NO-UNDO INITIAL 0.
DEFINE VARIABLE hd_buffer AS HANDLE NO-UNDO.
DEFINE VARIABLE hd_query AS HANDLE NO-UNDO.
DEFINE VARIABLE ch_query AS CHARACTER NO-UNDO.
DEFINE VARIABLE ch_table AS CHARACTER NO-UNDO.
DEFINE VARIABLE lg_error AS LOGICAL NO-UNDO.
ASSIGN
ch_table = pr_hd_temptable:NAME
ch_query = "FOR EACH " + ch_table + " NO-LOCK".
CREATE BUFFER hd_buffer FOR TABLE ch_table.
CREATE QUERY hd_query.
hd_query:ADD-BUFFER( hd_buffer ).
lg_error = hd_query:QUERY-PREPARE( ch_query ) NO-ERROR.
hd_query:QUERY-OPEN().
hd_query:GET-FIRST().
DO WHILE NOT hd_query:QUERY-OFF-END :
ASSIGN in_nbrec = in_nbrec + 1.
hd_query:GET-NEXT().
END.
hd_query:QUERY-CLOSE().
DELETE OBJECT hd_query.
DELETE OBJECT hd_buffer.
ASSIGN
hd_query = ?
hd_buffer = ?.
RETURN in_nbrec.
END FUNCTION.
Just pass it the handle of your temp-table and you get the number of records.
It can certainly be improved, but it works fast enough for me.