Define variable cWord as Character no-undo.
cWord = "Web Development Tool".
Needed OUTPUT
Development
How do i get the longest word from this when its a 1 variable only,
This is a progress4gl code btw
DEFINE VARIABLE cWord AS CHARACTER NO-UNDO.
DEFINE VARIABLE iWord AS INTEGER NO-UNDO.
DEFINE VARIABLE iLongest AS INTEGER NO-UNDO.
DEFINE VARIABLE iLength AS INTEGER NO-UNDO.
DEFINE VARIABLE iLongestLength AS INTEGER NO-UNDO.
DEFINE VARIABLE iEntries AS INTEGER NO-UNDO.
ASSIGN cWord = "Web Development Tool"
iEntries = NUM-ENTRIES (cWord, " ").
DO iWord = 1 TO iEntries:
ASSIGN iLength = LENGTH (ENTRY (iWord, cWord, " ")) .
IF iLength > iLongestLength THEN
DO:
ASSIGN iLongest = iWord
iLongestLength = iLength .
END.
END.
MESSAGE ENTRY (iLongest, cWord, " ")
VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
Just because my favorite hammer is a temp-table ;-)
def var cword as longchar no-undo init "Web Development Tool".
define temp-table tt no-undo
field cc as char
.
temp-table tt:read-json(
"longchar",
'~{"tt":[~{"cc":"' + replace( cword, ' ', '"},~{"cc":"' ) + '"}]}'
).
for each tt by length( cc ) descending:
message tt.cc.
leave.
end.
https://abldojo.services.progress.com:443/#/?shareId=5e56f4a84b1a0f40c34b8c3c
If you have two words with same length, this will return first.
DEF VAR iCount AS INT NO-UNDO.
DEF VAR cLongest AS CHAR NO-UNDO.
DEF VAR cString AS CHAR NO-UNDO INIT 'Web Development Tool'.
DO iCount = 1 TO NUM-ENTRIES(cString,' '):
cLongest = (IF LENGTH(ENTRY(iCount,cString,' ')) > LENGTH(cLongest) THEN ENTRY(iCount,cString,' ') ELSE cLongest).
END.
MESSAGE cLongest
VIEW-AS ALERT-BOX INFO BUTTONS OK.
Related
New to MS Access. Had a question regarding formatting of a MAC Address in one of my Access forms. There is a field I have set up using an input mask aa:aa:aa:aa:aa:aa;;a where users can manually enter a 48 bit hexidecimal address. e.x 11:44:5E:33:53:AF.
However sometimes there are missing values that occur in this data entry e.x 0:A:B:11:22:C (happens from time to time) but I would like be able to automatically fill the missing values with leading zeros to be like 00:0A:0B:11:22:0C.
I realize that this may not be possible through just MS Access Input masks, but all of the VBA codes and after updates code building I have been looking at so far have not lead me to the desired format.
Thanks for your time and appreciate any help in this!
I tried Format(fieldname, "00000000") code, but it just fills from the left-hand side instead of between the colons. e.x 00:00:0A:B1:12:2C instead of the desired 00:0A:0B:11:22:0C.
My function FormatMacAddress is for you:
' Formats a MAC address using one of the four de facto formats used widely.
' Thus, the format can and will be defined by the specified delimiter to use.
' The default is no delimiter and uppercase.
' Optionally, the case of the returned string can be specified as lowercase.
'
' Examples:
' None -> "1234567890AB"
' Dot -> "1234.5678.90AB"
' Dash -> "12-34-56-78-90-AB"
' Colon -> "12:34:56:78:90:AB"
'
' Lowercase -> "1234567890ab"
'
' 2019-09-23, Cactus Data ApS, Gustav Brock
'
Public Function FormatMacAddress( _
ByRef Octets() As Byte, _
Optional Delimiter As IpMacAddressDelimiter, _
Optional TextCase As VbStrConv = VbStrConv.vbProperCase) _
As String
Dim LastFrame As Integer
Dim ThisFrame As Integer
Dim FrameLength As Integer
Dim Index As Integer
Dim Symbol As String
Dim MacAddress As String
' Only accept an array with six octets.
If LBound(Octets) = 0 And UBound(Octets) = OctetCount - 1 Then
' Calculate the frame length.
FrameLength = DigitCount / DelimiterFrameCount(Delimiter)
' Format the octets using the specified delimiter.
For Index = LBound(Octets) To UBound(Octets)
ThisFrame = (Index * OctetLength) \ FrameLength
Symbol = ""
If LastFrame < ThisFrame Then
Symbol = DelimiterSymbol(Delimiter)
LastFrame = ThisFrame
End If
MacAddress = MacAddress & Symbol & Right("0" & Hex(Octets(Index)), OctetLength)
Next
End If
If MacAddress <> "" Then
Select Case TextCase
Case VbStrConv.vbLowerCase
MacAddress = StrConv(MacAddress, TextCase)
Case Else
' Leave MacAddress in uppercase.
End Select
End If
FormatMacAddress = MacAddress
End Function
As it requires a Byte() input, you may need the function MacAddressParse as well:
' Parses a string formatted MAC address and returns it as a Byte array.
' Parsing is not case sensitive.
' Will by default only accept the four de facto standard formats used widely.
'
' Examples:
' "1234567890AB" -> 1234567890AB
' "1234.5678.90AB" -> 1234567890AB
' "12-34-56-78-90-AB" -> 1234567890AB
' "12:34:56:78:90:AB" -> 1234567890AB
'
' If argument Exact is False, a wider variation of formats will be accepted:
' "12-34:56-78:90-AB" -> 1234567890AB
' "12 34 56-78 90 AB" -> 1234567890AB
' "56 78 90 AB" -> 0000567890AB
' "1234567890ABDE34A0" -> 1234567890AB
'
' For unparsable values, the neutral MAC address is returned:
' "1K34567890ABDEA0" -> 000000000000
'
' 2019-09-23, Cactus Data ApS, Gustav Brock
'
Public Function MacAddressParse( _
ByVal MacAddress As String, _
Optional Exact As Boolean = True) _
As Byte()
Dim Octets() As Byte
Dim Index As Integer
Dim Expression As String
Dim Match As Boolean
' Delimiters.
Dim Colon As String
Dim Dash As String
Dim Dot As String
Dim Star As String
' Create neutral MAC address.
ReDim Octets(0 To OctetCount - 1)
' Retrieve delimiter symbols.
Colon = DelimiterSymbol(ipMacColon)
Dash = DelimiterSymbol(ipMacDash)
Dot = DelimiterSymbol(ipMacDot)
Star = DelimiterSymbol(ipMacStar)
If Exact = True Then
' Verify exact pattern of the passed MAC address.
Select Case Len(MacAddress)
Case TotalLength1
' One frame of six octets (no delimiter).
Expression = Replace(Space(DigitCount), Space(1), HexPattern)
Match = MacAddress Like Expression
If Match = True Then
' MAC address formatted as: 0123456789AB.
End If
Case TotalLength3
' Three frames of two octets.
Expression = Replace(Replace(Replace(Space(DigitCount / FrameLength3), Space(1), Replace(Replace(Space(FrameLength3), Space(1), HexPattern), "][", "]" & Star & "[")), "][", "]" & Dot & "["), Star, "")
Match = MacAddress Like Expression
If Match = True Then
' MAC address formatted as: 0123.4567.89AB.
MacAddress = Replace(MacAddress, Dot, "")
End If
Case TotalLength6
' Six frames of one octets.
Expression = Replace(Replace(Replace(Space(DigitCount / FrameLength6), Space(1), Replace(Replace(Space(FrameLength6), Space(1), HexPattern), "][", "]" & Star & "[")), "][", "]" & Colon & "["), Star, "")
Match = MacAddress Like Expression
If Match = True Then
' MAC address formatted as: 01:23:45:67:89:AB.
MacAddress = Replace(MacAddress, Colon, "")
Else
Expression = Replace(Expression, Colon, Dash)
Match = MacAddress Like Expression
If Match = True Then
' MAC address formatted as: 01-23-45-67-89-AB.
MacAddress = Replace(MacAddress, Dash, "")
End If
End If
End Select
Else
' Non-standard format.
' Clean MacAddress and try to extract six octets.
MacAddress = Replace(Replace(Replace(Replace(MacAddress, Colon, ""), Dash, ""), Dot, ""), Space(1), "")
Select Case Len(MacAddress)
Case Is > DigitCount
' Pick leading characters.
MacAddress = Left(MacAddress, DigitCount)
Case Is < DigitCount
' Fill with leading zeros.
MacAddress = Right(String(DigitCount, "0") & MacAddress, DigitCount)
End Select
' One frame of six possible octets.
Expression = Replace(Space(DigitCount), Space(1), HexPattern)
Match = MacAddress Like Expression
If Match = True Then
' MAC address formatted as: 0123456789AB.
End If
End If
If Match = True Then
' Fill array Octets.
For Index = LBound(Octets) To UBound(Octets)
Octets(Index) = Val("&H" & Mid(MacAddress, 1 + Index * OctetLength, OctetLength))
Next
End If
MacAddressParse = Octets
End Function
Full code at GitHub: VBA.MacAddress.
This is my desired output
{ "event_type": "LOAD_AVAILABLE",
"event_data": {
"load": [
{
"Ord": "ORDER12344",
"ShipReqDt": "2021-10-29",
"load_items": [
{
"ItemDesc": "Apple 12oz English Domestic: 10004-000",
"Qty": 320
},
{
"ItemDesc": "Apple CTN 12",
"Qty": 980
}
]
}
]
}}
this is my code
def temp-table ttOrd serialize-name "load"
field Ord like Ord.Ord
field ShipReqDt like Ord.ShipReqDt.
def temp-table ttItem serialize-name "load_items"
field Ord like OrdDet.Ord serialize-hidden
field ItemDesc as char
field Qty like OrdDet.ActBox.
def dataset dsOrd serialize-name "event_data" for
ttOrd, ttItem
data-relation Rel1 for ttOrd, ttItem nested relation-fields(Ord, Ord).
procedure WriteJSON:
def var dFilename as char no-undo.
dFilename = dSessTmpDir + "/Test1.xml".
find Ord no-lock where
Ord.Ord = "ORDER12344"
no-error.
create ttOrd.
assign
ttOrd.Ord = Ord.Ord
ttOrd.ShipReqDt = Ord.ShipReqDt.
for each OrdDet where OrdDet.Ord = Ord.Ord on error undo, return error on stop undo, return error:
Create ttItem.
assign
ttItem.Ord = OrdDet.Ord
ttItem.ItemDesc = OrdDet.Descr
ttItem.Qty = OrdDet.Qty.
end.
dataset dsOrd:write-json("FILE", dFilename, true).
end procedure. /* WriteJSON */
the only thing missing from my output from the desired output is the one object in the first line
"event_type": "LOAD_AVAILABLE"
any suggestions on how to add them?
thank you
You can load the datasets's JSON into a JSON object first:
At the top of your program (first statement):
USING Progress.Json.ObjectModel.* FROM PROPATH.
DEFINE VARIABLE oJsonObject AS JsonObject NO-UNDO .
DEFINE VARIABLE oJsonObject2 AS JsonObject NO-UNDO .
and instead of your dsOrd:WRITE-JSON
oJsonObject = NEW JsonObject () .
dataset dsOrd:write-json("JsonObject", oJsonObject, true).
oJsonObject2 = NEW JsonObject () .
oJsonObject2:Add ("event_type", "LOAD_AVAILABLE") .
oJsonObject2:Add ("event_data", oJsonObject:GetJsonObject ("event_data") .
oJsonObject2:WriteFile(dFileName, TRUE) .
I need help. I ENCRYPT json packages with our clients' data with AES_CBC_256 and a different key for each package. Out of about a million data packets generated, the first several dozen cannot be DECRYPT, which returns "?" Subsequent data packets are properly encrypted and can be decrypted properly. MEMPTR is extended by data size + 1024 bytes. The package is first encrypted and then encoded Base64. I do not use IV.
The code below is devoid of all error handling for better readability. Any suggestions?
FUNCTION {&Modul}-encrypt RETURN CHAR(INPUT pInput AS LONGCHAR, INPUT pKey AS RAW, OUTPUT pOut AS LONGCHAR).
DEF VAR mMemPtr AS MEMPTR NO-UNDO.
FIX-CODEPAGE(pOut) = "UTF-8".
SECURITY-POLICY:SYMMETRIC-ENCRYPTION-ALGORITHM = "AES_CBC_256".
SECURITY-POLICY:SYMMETRIC-ENCRYPTION-KEY = pkey.
SET-SIZE(mMemPtr) = LENGTH(pInput) + 1024.
mMemPtr = ENCRYPT(pInput) NO-ERROR.
pOut = BASE64-ENCODE(mMemPtr) NO-ERROR.
RETURN "OK".
END.
FUNCTION {&Modul}-decrypt RETURN LONGCHAR(INPUT pInput AS LONGCHAR, INPUT pkey AS RAW).
DEF VAR pOut AS LONGCHAR NO-UNDO.
FIX-CODEPAGE(pOut) = "UTF-8".
DEF VAR mMemPtrIn AS MEMPTR NO-UNDO.
DEF VAR mMemPtrOut AS MEMPTR NO-UNDO.
SECURITY-POLICY:SYMMETRIC-ENCRYPTION-ALGORITHM = "AES_CBC_256".
SECURITY-POLICY:SYMMETRIC-ENCRYPTION-KEY = pkey.
mMemPtrIn = BASE64-DECODE(pInput) NO-ERROR.
mMemPtrOut = DECRYPT(mMemPtrIn) NO-ERROR.
COPY-LOB FROM mMemPtrOut TO pOut CONVERT SOURCE CODEPAGE "utf-8" NO-ERROR.
SET-SIZE(mMemPtrIn) = 0.
SET-SIZE(mMemPtrOut) = 0.
RETURN pOut.
END.
so this should be pretty simple. I'm trying to get data from a XML file in an URL and parsing it into a temp-table so I can use the data in the rest of my program. I've written a code but at the end, DISPLAY PAPEL DESCRICAO. doesn't show anything. Am I doing something wrong?
The entire code with the XML link:
DEF TEMP-TABLE CMA NO-UNDO
FIELD PAPEL AS CHAR
FIELD DESCRICAO AS CHAR
FIELD ULTIMO AS DEC
FIELD DIFERENCIAL AS DEC
FIELD VARIACAO AS DEC
FIELD FECHANT AS DEC
FIELD COMPRA AS DEC
FIELD MINIMA AS DEC
FIELD MAXIMA AS DEC
FIELD VENCIMENTO AS INT
FIELD HORA AS CHAR
FIELD DATA AS DATE.
DEF VAR cSourceType AS CHAR NO-UNDO.
DEF VAR cFile AS CHAR NO-UNDO.
DEF VAR cReadMode AS CHAR NO-UNDO.
DEF VAR cSchemaLocation AS CHAR NO-UNDO.
DEF VAR lOverrideDefaultMapping AS LOGICAL NO-UNDO.
DEF VAR cFieldTypeMapping AS CHAR NO-UNDO.
DEF VAR cVerifySchemaMode AS CHAR NO-UNDO.
DEF VAR lReturn AS LOGICAL NO-UNDO.
ASSIGN
cSourceType = "FILE"
cFile = "http://sfeed-cot01.cma.com.br/clientes/cocamar/cbot.xml"
cReadMode = "EMPTY"
cSchemaLocation = ?
lOverrideDefaultMapping = ?
cFieldTypeMapping = ?
cVerifySchemaMode = ?.
lReturn = TEMP-TABLE CMA:READ-XML(cSourceType, cFile, cReadMode,
cSchemaLocation, lOverrideDefaultMapping, cFieldTypeMapping,
cVerifySchemaMode).
IF lReturn THEN
FOR EACH CMA NO-LOCK:
DISPLAY CMA.PAPEL CMA.DESCRICAO.
END.
Any help is much appreciated.
Super close. CMA is not corresponding to the table but to a container tag that could be represented by a Prodataset in this case. Instead just use "QUOTES".
I would not use xml like this in production, you might not have any way to interfere if the source is down etc. I would pull the xml down another way and then load it.
But that's another story...
DEF TEMP-TABLE QUOTES NO-UNDO
FIELD PAPEL AS CHAR
FIELD DESCRICAO AS CHAR
FIELD ULTIMO AS DEC
FIELD DIFERENCIAL AS DEC
FIELD VARIACAO AS DEC
FIELD FECHANT AS DEC
FIELD COMPRA AS DEC
FIELD MINIMA AS DEC
FIELD MAXIMA AS DEC
FIELD VENCIMENTO AS INT
FIELD HORA AS CHAR
FIELD DATA AS DATE.
DEF VAR cSourceType AS CHAR NO-UNDO.
DEF VAR cFile AS CHAR NO-UNDO.
DEF VAR cReadMode AS CHAR NO-UNDO.
DEF VAR cSchemaLocation AS CHAR NO-UNDO.
DEF VAR lOverrideDefaultMapping AS LOGICAL NO-UNDO.
DEF VAR cFieldTypeMapping AS CHAR NO-UNDO.
DEF VAR cVerifySchemaMode AS CHAR NO-UNDO.
DEF VAR lReturn AS LOGICAL NO-UNDO.
ASSIGN
cSourceType = "FILE"
cFile = "http://sfeed-cot01.cma.com.br/clientes/cocamar/cbot.xml"
cReadMode = "EMPTY"
cSchemaLocation = ?
lOverrideDefaultMapping = ?
cFieldTypeMapping = ?
cVerifySchemaMode = ?.
lReturn = TEMP-TABLE QUOTES:READ-XML(cSourceType, cFile, cReadMode,
cSchemaLocation, lOverrideDefaultMapping, cFieldTypeMapping,
cVerifySchemaMode).
DISP lReturn.
IF lReturn THEN
FOR EACH QUOTES NO-LOCK:
DISPLAY QUOTES.PAPEL QUOTES.DESCRICAO.
END.
How do you store a certain part of a string into a variable?
For example:
x = myString // - But store the 9th character into a variable
Try this,
x = string_char_at(myString , 9);
This gets a single character from a string:
var x = string_char_at("This is my string", 4); //X == "s"
And you can use the string_copy function to copy parts of a string;
var x = string_copy("This is my string", 8, 2); //X == "my"