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.
Related
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).
I am new to progress and I am trying to figure out how to get this working. My task is to Get a list of integer values from user as semi colon separated and message the highest and lowest value on that list. Till now I have used an entry function to help me get just the integers entered by the user one after another. like so
repeat I = 1 to totalEntries:
m = entry (I, Userinput, ";").
display m.
end.
After this I would like to find out the maximum value of all the entries. how can I do this since maximum function accepts more than one value for comparison.
There is no built in function to give a maximum or minimum number from given list of numbers. You need to write your own logic as in most of the programming languages. Here is an example:
DEF VAR i AS INT.
DEF VAR nlist AS CHAR INIT "1;2;7;3;6;9".
DEF VAR imin AS INT.
DEF VAR imax AS INT.
imin = INTEGER(ENTRY (1, nlist, ";")).
imax = INTEGER(ENTRY (1, nlist, ";")).
REPEAT i = 2 TO NUM-ENTRIES(nlist, ";"):
IF INTEGER(ENTRY(i, nlist, ";")) > imax THEN
imax = INTEGER(ENTRY(i, nlist, ";")).
IF INTEGER(ENTRY(i, nlist, ";")) < imin THEN
imin = INTEGER(ENTRY(i, nlist, ";")).
END.
MESSAGE imax.
MESSAGE imin.
As Austin sad, there is no built-in function in Progress to give a maximum or minimum number from a list.
In your comment, you've mentioned that MAXIMUM(1,2,3) worked. Yes, it works, but you have to figure that you're passing three parameters to the function, not a list of numbers inside a single CHAR variable.
To solve your problem you can use the solution given by Austin or you can use two functions that receive a CHAR variable with semi colon separated values and return maximum or minimum values.
Here is an example, based on your code.
FUNCTION iMax RETURNS INTEGER
( INPUT pData AS CHAR ):
DEF VAR iOutput AS INT NO-UNDO.
DEF VAR iCount AS INT NO-UNDO.
iOutput = ?.
DO iCount = 1 TO NUM-ENTRIES(pData,';'):
IF iOutput = ? THEN DO:
iOutput = INT(ENTRY(iCount,pData,';')).
NEXT.
END.
iOutput = MAX(iOutput,INT(ENTRY(iCount,pData,';'))).
END.
RETURN iOutput.
END FUNCTION.
FUNCTION iMin RETURNS INTEGER
( INPUT pData AS CHAR ):
DEF VAR iOutput AS INT NO-UNDO.
DEF VAR iCount AS INT NO-UNDO.
iOutput = ?.
DO iCount = 1 TO NUM-ENTRIES(pData,';'):
IF iOutput = ? THEN DO:
iOutput = INT(ENTRY(iCount,pData,';')).
NEXT.
END.
iOutput = MIN(iOutput,INT(ENTRY(iCount,pData,';'))).
END.
RETURN iOutput.
END FUNCTION.
/****************/
Define variable NumberEntry as character view-as fill-in no-undo.
Define variable UsersInput as character no-undo.
Define variable i as integer no-undo.
Define variable totalEntries as integer no-undo.
Define variable m as character no-undo.
Define variable n as character no-undo.
Define button bFind.
Define frame main numberEntry label "Enter numbers separated by semi colon" skip
bFind label "Find Max and Min" with side-labels. /*Trigger for button*/
On choose of bFind in frame main do: /*Retrieve the users input*/
Usersinput = (numberEntry:screen-value). /*to find out how many characters the user has enterd.*/ totalEntries = num-entries(UsersInput,';'). Display totalentries. /*Logic to extract Users input values one by one.*/
Repeat i = 1 to totalEntries: M = entry(i, UsersInput, ";").
Display m.
End. /*Logic to find the maximum element. */ .....
MESSAGE 'MAXIMUM :' iMax(UsersInput) SKIP
'MINIMUM :' iMin(UsersInput)
VIEW-AS ALERT-BOX INFO BUTTONS OK.
END.
VIEW FRAME main.
ENABLE ALL WITH FRAME main.
WAIT-FOR CHOOSE OF bfind.
You can call iMax() or iMin() and get MAX or MIN values from Progress MAXIMUM and MINIMUM function using a CHAR list of INTEGER values separated by semi colons without need to make a full code block to do the comparision and get the information for each situation that presents necessary.
Hope it helps.
Given two arrays, ( for example 1,2,3,4,5 and 2,3,1,0). Find which number of first array is not present in the second array. How can i get Length of Arrays in progress 4gl ?
If the object in question is an ARRAY, rather than a LIST, you use the EXTENT() function to determine the number of elements. Using arrays:
define variable a1 as integer no-undo extent 5 initial [ 1, 2, 3, 4, 5 ].
define variable a2 as integer no-undo extent 4 initial [ 2, 3, 1, 0 ].
define variable i as integer no-undo.
define variable j as integer no-undo.
define variable ok as logical no-undo.
do i = 1 to extent( a1 ):
ok = no.
do j = 1 to extent( a2 ):
if a1[i] = a2[j] then ok = yes.
end.
if ok = no then message a1[i] "is not in a2".
end.
To have the length of a list (number of items of the list), you can use NUM-ENTRIES() function.
To know if an item is present in a list, you can use LOOKUP() function.
So for your example, you can do something like this:
DEFINE VARIABLE wclist1 AS CHARACTER NO-UNDO INITIAL "1,2,3,4,5".
DEFINE VARIABLE wclist2 AS CHARACTER NO-UNDO INITIAL "2,3,1,0".
DEFINE VARIABLE wc-list-no-present AS CHARACTER NO-UNDO.
DEFINE VARIABLE wi-cpt AS INTEGER NO-UNDO.
/* For each items of list1 */
DO wi-cpt = 1 TO NUM-ENTRIES(wclist1, ","):
/* Test if the item is in list 2 */
IF LOOKUP(ENTRY(wi-cpt, wclist1, ","), wclist2, ",") = 0
THEN
wc-list-no-present = wc-list-no-present + "," + ENTRY(wi-cpt, wclist1, ",").
END.
/* TRIM is to remove the first "," */
DISPLAY TRIM(wc-list-no-present, ",").
def var a as int extent 5 initial [1,2,3,4,5] no-undo.
def var b as int extent 4 initial [2,3,1,0] no-undo.
def var i as int no-undo.
def var j as int no-undo.
loop:
repeat i = 1 to extent(a):
repeat j = 1 to extent(b):
if a[i] = b[j]
then next loop.
end.
Display a[i] "not in b array" format "x(20)".
end.
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
.
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.