! inside the global Map Module('WINAPI') GetComputerName(*CSTRING,*ULONG),SIGNED,RAW,PASCAL,NAME('GetComputerNameA') WNetGetUser(ULONG,*CSTRING,*ULONG),LONG,RAW,PASCAL,NAME('WNetGetUserA') END ! data WIN:Computername CSTRING(32) WIN:Computerlen ULONG WIN:User CSTRING(32) WIN:Userlen ULONG WIN:Net ULONG ! code WIN:Computerlen = 32 WIN:Userlen = 32 ret# = GetComputerName(WIN:ComputerName,WIN:Computerlen) ! get the computername ret# = WNetGetUser(WIN:Net,WIN:User,WIN:Userlen) ! get the current user
Autorarchive: ralf
override message function before closedown
Close your application immediately without any messagebox like “Record changed, save?”.
!------------------------------------------------------------------------------------------ ! hook prototype mmessage (STRING,, , ,UNSIGNED=0,BOOL=FALSE),UNSIGNED,PROC ! hook message !------------------------------------------------------------------------------------------ ! Hook procudure mmessage function(msg,tit,ico,but,def,sty) code return(BUTTON:NO) !------------------------------------------------------------------------------------------ ! hook messagebox and now close the app system{Prop:MessageHook} = address(mmessage) post(Event:CloseDown,,1)
converting web colors to RGB
Jeff Slarve:
program Map RGBHex(Long pL),String WEBHexToColor(String pWebColor),Long end c Long Color Group,Over(c) Red Byte Green Byte Blue Byte Byte end RGB String(7) Window WINDOW('RGB Sample'),AT(,,135,63),FONT('MS Sans Serif',8,,),| CENTER,SYSTEM,GRAY,DOUBLE STRING('Red'),AT(3,3),USE(?String4::) SPIN(@n3),AT(28,3,29,10),USE(color.red),RANGE(0,255) STRING('Green'),AT(3,16),USE(?String4:) SPIN(@n3),AT(28,16,29,10),USE(color.green),RANGE(0,255) STRING('Blue'),AT(3,28),USE(?String4) SPIN(@n3),AT(28,28,29,10),USE(color.blue),RANGE(0,255) BOX,AT(60,2,59,57),USE(?Box1),COLOR(COLOR:Black),FILL(COLOR:Black) TEXT,AT(4,42,53,10),USE(RGB),SINGLE BUTTON('...'),AT(121,2,12,12),USE(?ColorButton) END Code Open(Window) c = Color:Red RGB = RGBHex(c) ?Box1{PROP:Fill}=c Accept Case Event() of Event:OpenWindow Select(?Color:Red) !Workaround for Display(?Text) Bug of Event:NewSelection Do DisplayColor of Event:Accepted Case Field() of ?RGB c = WebHexToColor(RGB) ?Box1{PROP:FILL} = c Display Do DisplayColor of ?Color:Red orof ?Color:Green orof ?Color:Blue Do DisplayColor Select(?) !Workaround for Display(?Text) Bug of ?ColorButton If ColorDialog('Pick Color',c) Do DisplayColor end end end end DisplayColor Routine ?Box1{PROP:Fill}=c RGB = RGBHex(c) Display(?RGB) RGBHex PROCEDURE (Long pL) HexDig STRING('0123456789ABCDEF'), STATIC HexMap GROUP, PRE(), OVER(pL) b4 BYTE b3 BYTE b2 BYTE b1 BYTE END HexVal STRING(8), AUTO CODE HexVal[1] = '#' HexVal[6] = HexDig[BSHIFT(b2, -4)+1] HexVal[7] = HexDig[BAND(b2, 0Fh)+1] HexVal[4] = HexDig[BSHIFT(b3, -4)+1] HexVal[5] = HexDig[BAND(b3, 0Fh)+1] HexVal[2] = HexDig[BSHIFT(b4, -4)+1] HexVal[3] = HexDig[BAND(b4, 0Fh)+1] RETURN HexVal WEBHexToColor Procedure(String pWebColor) LOC:WebColor String(7) Code LOC:WebColor = pWebColor LOC:WebColor = Clip(Left(LOC:WebColor[2:7])) & All('0',7) Return Evaluate('0' & LOC:WebColor[5:6] &| LOC:WebColor[3:4] &| LOC:WebColor[1:2] & 'h')
MYSQL: Umlaute ersetzen
SELECT name FROM test order by REPLACE(REPLACE(REPLACE(REPLACE(name,"ae","ä"),"oe","ö"), "ue","ü"), "ß","ss")
validate an email or url
This should be close for email, it assumes email must end with period and two or more letters, I think that’s correct.
IF ~MATCH(emailaddress,'^[-a-zA-Z0-9._]+@{{[-a-zA-Z0-9.]+\.}+[a-zA-Z][a-zA-Z]+$',Match:Regular+MatchNocase) Message('looks like a bad address buddy') END
Email must contain:
[a-z A-Z 0-9 or -._ ] 1 or more times
@
[a-z A-Z 0-9 or -._ ] 1 or more times
a period which is \.
then two letters or more, I think it should be limited to 2,3 or 4
Could simplify a little with UPPER ( [character sets] are case sensitive even if MatchNocase)
IF ~MATCH(UPPER(emailaddress),'^[-A-Z0-9._]+@{{[-A-Z0-9.]+\.}+[A-Z][A-Z]+$',Match:Regular) Message('looks like a bad address buddy') END
To allow only ending with 2,3 or 4 bytes change .[A-Z][A-Z]+$ to [A-Z][A-Z][A-Z]?[A-Z]?$
At ClaMag is an article about Match and includes a Match explorer App to help you play with Match. Note the double curly {{ is required in Clarion source but would not in Match Explorer. Also my Clarion Source Search utility has a Regular Expression helper.
—————————————————
Carl Barnes [Team SoftVelocity]
www carlbarnes com – Carlng@–myname.com–
Maker of CW Assistant and Clarion Source Search Utilities
enumerate windows printers
!-------------------------------------------------------------------------------------------- ! Ralf Schoeffler http://www.schoeffler.biz mailto:info@schoeffler.biz !-----------------------------snipp --------------------------------------------------------- ! inside the global map MODULE('WINAPI') EnumPrintersA(ULONG,*CSTRING,ULONG,*BYTE,ULONG,*ULONG,*ULONG),BOOL,PASCAL,RAW END !-------------------------------------------------------------------------------------------- !DATA flag ULONG pname CSTRING(255) level ULONG cbBuf ULONG cbBuffer STRING(65536) pcbNeed ULONG pcRetrun ULONG pPrinterEnum BYTE OVER(cbBuffer) ret LONG zeiger LONG,DIM(16384) OVER(cbBuffer) tstr STRING(250) tbyte BYTE pPrinter Queue Name STRING(32) Port STRING(60) SPrinter BYTE END !-------------------------------------------------------------------------------------------- !CODE flag = 2 ! PRINTER_ENUM_LOCAL pname = '' ! Cstring(255) level = 2 ! Printer_Info_2 cbBuf = 65536 ! Size of cbpBuffer pcbNeed = 0 ! Structur as bytes pcRetrun = 0 ! count of printers ret = EnumPrintersA(flag,pname,level,pPrinterEnum,cbBuf,pcbNeed,pcRetrun) loop p# = 0 to pcRetrun - 1 clear(pPrinter) !------------------------------------------------------------------------------------------- ! printername !------------------------------------------------------------------------------------------- tstr = '' loop i# = 0 to 32 peek(zeiger[2+(p#*21)]+i#, tbyte) if tbyte = 0 then break end tstr[i#+1] = chr(tbyte) end pPrinter:Name = tstr !------------------------------------------------------------------------------------------- ! Standard Printer !------------------------------------------------------------------------------------------- if clip(pPrinter:Name) = clip(PRINTER{PROPPRINT:Device}) then pPrinter:SPrinter = 1 end !------------------------------------------------------------------------------------------- ! Printerport !------------------------------------------------------------------------------------------- tstr = '' loop i#=0 to 32 peek(zeiger[4+(p#*21)]+i#,tbyte) if tbyte=0 then break end tstr[i#+1]=chr(tbyte) end pPrinter:Port = tstr pPrinters = pPrinter add(pPrinters) end !loop !-----------------------------snipp ---------------------------------------------------------
TAPI dialer
!-------------------------------------------------------------------------------------- !MAP MODULE('TAPI32.lib') TAPIRequestMakeCall(*CSTRING,<*CSTRING>,<*CSTRING>,<*CSTRING>),LONG,RAW,PASCAL END !-------------------------------------------------------------------------------------- !DATA l:Nummer CSTRING(81) l:Party CSTRING(81) l:Comment CSTRING(81) l:Programm CSTRING(81) !-------------------------------------------------------------------------------------- !CODE l:Nummer = GLO:TAPIPrefix & clip(pNummer) if pName then l:Party = clip(pName) end if pComment then l:Comment = clip(pComment) end l:Ret = tapiRequestMakeCall(l:Nummer,l:Programm,l:Party,l:Comment)
use winsock
This article only contains the equates and prototypes for the winsock api calls. The equates are at the top of the article, and the prototypes are at the bottom.
Courtesy of Bill Knopf, LEADS Software Group.
Equates for Winsock: !---------------------- WINSOCK EQUATES ---------------------- SOCK_STREAM EQUATE(1) SOCK_DGRAM EQUATE(2) INVALID_SOCKET EQUATE(-1) SOL_SOCKET EQUATE(0000ffffh) IPPROTO_TCP EQUATE(6) SOCKET_ERROR EQUATE(-1) AF_INET EQUATE(2) !TCP/IP Address Type AF_IPX EQUATE(6) !IPX/SPX Address Type INADDR_ANY EQUATE(0) INADDR_BROADCAST EQUATE(-1) !Broadcast Address SO_DEBUG EQUATE(0001h) SO_ACCEPTCONN EQUATE(0002h) SO_REUSEADDR EQUATE(0004h) SO_DONTROUTE EQUATE(0010h) SO_BROADCAST EQUATE(0020h) SO_USELOOPBACK EQUATE(0040h) SO_LINGER EQUATE(0080h) SO_OOBINLINE EQUATE(0100h) SO_SNDBUF EQUATE(1001h) SO_RCVBUF EQUATE(1002h) SO_SNDLOWAT EQUATE(1003h) SO_RCVLOWAT EQUATE(1004h) SO_SNDTIMEO EQUATE(1005h) SO_RCVTIMEO EQUATE(1006h) SO_ERROR EQUATE(1007h) SO_TYPE EQUATE(1008h) TCP_NODELAY EQUATE(0001h) SOMAXCONN EQUATE(5) MSG_OOB EQUATE(1h) MSG_PEEK EQUATE(2h) MSG_DONTROUTE EQUATE(4h) MSG_MAXIOVLEN EQUATE(16) MAXGETHOSTSTRUCT EQUATE(1024) FD_READ EQUATE(01h) FD_WRITE EQUATE(02h) FD_OOB EQUATE(04h) FD_ACCEPT EQUATE(08h) FD_CONNECT EQUATE(10h) FD_CLOSE EQUATE(20h) WSABASEERR EQUATE(10000) WSAEINTR EQUATE(WSABASEERR+4) WSAEBADF EQUATE(WSABASEERR+9) WSAEACCES EQUATE(WSABASEERR+13) WSAEFAULT EQUATE(WSABASEERR+14) WSAEINVAL EQUATE(WSABASEERR+22) WSAEMFILE EQUATE(WSABASEERR+24) WSAEWOULDBLOCK EQUATE(WSABASEERR+35) WSAEINPROGRESS EQUATE(WSABASEERR+36) WSAEALREADY EQUATE(WSABASEERR+37) WSAENOTSOCK EQUATE(WSABASEERR+38) WSAEDESTADDRREQ EQUATE(WSABASEERR+39) WSAEMSGSIZE EQUATE(WSABASEERR+40) WSAEPROTOTYPE EQUATE(WSABASEERR+41) WSAENOPROTOOPT EQUATE(WSABASEERR+42) WSAEPROTONOSUPPORT EQUATE(WSABASEERR+43) WSAESOCKTNOSUPPORT EQUATE(WSABASEERR+44) WSAEOPNOTSUPP EQUATE(WSABASEERR+45) WSAEPFNOSUPPORT EQUATE(WSABASEERR+46) WSAEAFNOSUPPORT EQUATE(WSABASEERR+47) WSAEADDRINUSE EQUATE(WSABASEERR+48) WSAEADDRNOTAVAIL EQUATE(WSABASEERR+49) WSAENETDOWN EQUATE(WSABASEERR+50) WSAENETUNREACH EQUATE(WSABASEERR+51) WSAENETRESET EQUATE(WSABASEERR+52) WSAECONNABORTED EQUATE(WSABASEERR+53) WSAECONNRESET EQUATE(WSABASEERR+54) WSAENOBUFS EQUATE(WSABASEERR+55) WSAEISCONN EQUATE(WSABASEERR+56) WSAENOTCONN EQUATE(WSABASEERR+57) WSAESHUTDOWN EQUATE(WSABASEERR+58) WSAETOOMANYREFS EQUATE(WSABASEERR+59) WSAETIMEDOUT EQUATE(WSABASEERR+60) WSAECONNREFUSED EQUATE(WSABASEERR+61) WSAELOOP EQUATE(WSABASEERR+62) WSAENAMETOOLONG EQUATE(WSABASEERR+63) WSAEHOSTDOWN EQUATE(WSABASEERR+64) WSAEHOSTUNREACH EQUATE(WSABASEERR+65) WSAENOTEMPTY EQUATE(WSABASEERR+66) WSAEPROCLIM EQUATE(WSABASEERR+67) WSAEUSERS EQUATE(WSABASEERR+68) WSAEDQUOT EQUATE(WSABASEERR+69) WSAESTALE EQUATE(WSABASEERR+70) WSAEREMOTE EQUATE(WSABASEERR+71) WSASYSNOTREADY EQUATE(WSABASEERR+91) WSAVERNOTSUPPORTED EQUATE(WSABASEERR+92) WSANOTINITIALISED EQUATE(WSABASEERR+93) WSANOSOCKETS EQUATE(WSABASEERR+94) WSAHOST_NOT_FOUND EQUATE(WSABASEERR+1001) HOST_NOT_FOUND EQUATE(WSAHOST_NOT_FOUND) WSATRY_AGAIN EQUATE(WSABASEERR+1002) TRY_AGAIN EQUATE(WSATRY_AGAIN) WSANO_RECOVERY EQUATE(WSABASEERR+1003) NO_RECOVERY EQUATE(WSANO_RECOVERY) WSANO_DATA EQUATE(WSABASEERR+1004) NO_DATA EQUATE(WSANO_DATA) WSANO_ADDRESS EQUATE(WSANO_DATA) NO_ADDRESS EQUATE(WSANO_ADDRESS) SOCKET EQUATE(UNSIGNED) WSAData GROUP,TYPE wVersion SHORT wHighVersion SHORT szDescription CSTRING(256) szSystemStatus CSTRING(128) iMaxSockets USHORT iMaxUdpDg USHORT lpVendorInfo CSTRING(30) END in_addr GROUP,TYPE S_addr ULONG S_un_b GROUP,OVER(S_addr) s_b1 BYTE s_b2 BYTE s_b3 BYTE s_b4 BYTE END S_un_w GROUP,OVER(S_addr) s_w1 USHORT s_w2 USHORT END END hostent GROUP,TYPE h_name CSTRING(35) h_aliases CSTRING(35) h_addrtype SHORT h_length SHORT h_IPStr CSTRING(20) END servent GROUP,TYPE s_name CSTRING(15) s_alias CSTRING(20) s_port SHORT s_proto CSTRING(3) END sockaddr GROUP,TYPE family SHORT port USHORT addr ULONG !LIKE(in_addr) zero CSTRING(16) END sockproto GROUP,TYPE sp_family USHORT sp_protocol USHORT END linger GROUP,TYPE l_onoff USHORT l_linger USHORT END !-------------------- WINSOCK PROTOTYPES --------------------- MODULE('WINSOCK.DLL') WSAStartup(UNSIGNED,LONG),SIGNED,PASCAL,NAME('WSASTARTUP'),DLL(dll_mode) WSACleanup(),SIGNED,PASCAL,NAME('WSACLEANUP'),DLL(dll_mode) htons(USHORT),USHORT,PASCAL,NAME('HTONS'),DLL(dll_mode) ntohs(USHORT),USHORT,PASCAL,NAME('NTOHS'),DLL(dll_mode) htonl(ULONG),ULONG,PASCAL,NAME('HTONL'),DLL(dll_mode) ntohl(ULONG),ULONG,PASCAL,NAME('NTOHL'),DLL(dll_mode) inet_addr(*CSTRING),ULONG,PASCAL,RAW,NAME('INET_ADDR'),DLL(dll_mode) inet_ntoa(ULONG),CSTRING,PASCAL,RAW,NAME('INET_NTOA'),DLL(dll_mode) getservbyname(*CSTRING,*CSTRING),LONG,RAW,PASCAL,NAME('GETSERVBYNAME'),DLL(dll_mode) getservbyport(SIGNED,*CSTRING),LONG,RAW,PASCAL,NAME('GETSERVBYPORT'),DLL(dll_mode) gethostname(*CSTRING,SIGNED),SIGNED,RAW,PASCAL,NAME('GETHOSTNAME'),DLL(dll_mode),PROC gethostbyname(*CSTRING),LONG,PASCAL,RAW,NAME('GETHOSTBYNAME'),DLL(dll_mode) WSAGetLastError(),SIGNED,RAW,PASCAL,NAME('WSAGETLASTERROR'),DLL(dll_mode) ssocket(SIGNED,SIGNED,SIGNED),UNSIGNED,PASCAL,NAME('SOCKET'),DLL(dll_mode) closesocket(UNSIGNED),SIGNED,PASCAL,NAME('CLOSESOCKET'),DLL(dll_mode) sbind(UNSIGNED,LONG,SIGNED),SIGNED,RAW,PASCAL,NAME('BIND'),DLL(dll_mode) getsockname(UNSIGNED,*sockaddr,*SIGNED),SIGNED,RAW,PASCAL,NAME('GETSOCKNAME'),DLL(dll_mode) getpeername(UNSIGNED,*sockaddr,*SIGNED),SIGNED,RAW,PASCAL, NAME('GETPEERNAME'),DLL(dll_mode) getsockopt(UNSIGNED,SIGNED,SIGNED,*CSTRING,*SIGNED),SIGNED,RAW,PASCAL,NAME('GETSOCKOPT'),DLL(dll_mode) setsockopt(UNSIGNED,SIGNED,SIGNED,LONG,SIGNED),SIGNED,RAW,PASCAL,NAME('SETSOCKOPT'),DLL(dll_mode) sshutdown(UNSIGNED,SIGNED),SIGNED,PASCAL,NAME('SHUTDOWN'),DLL(dll_mode) ioctlsocket(UNSIGNED,LONG,*ULONG),SIGNED,RAW,PASCAL,NAME('IOCTLSOCKET'),DLL(dll_mode) listen(UNSIGNED,SIGNED),SIGNED,PASCAL,NAME('LISTEN'),DLL(dll_mode) saccept(UNSIGNED,*sockaddr,*SIGNED),UNSIGNED,RAW,PASCAL,NAME('ACCEPT'),DLL(dll_mode) connect(UNSIGNED,*sockaddr,SIGNED),SIGNED,RAW,PASCAL,NAME('CONNECT'),DLL(dll_mode) ssend(UNSIGNED,LONG,SIGNED,SIGNED),SIGNED,RAW,PASCAL,NAME('SEND') recv(UNSIGNED,LONG,SIGNED,SIGNED),SIGNED,RAW,PASCAL, NAME('RECV'),DLL(dll_mode) sendto(UNSIGNED,LONG,SIGNED,SIGNED,LONG,SIGNED),SIGNED,RAW,PASCAL,NAME('SENDTO'),DLL(dll_mode) recvfrom(UNSIGNED,LONG,SIGNED,SIGNED,LONG,LONG),SIGNED,RAW,PASCAL,NAME('RECVFROM'),DLL(dll_mode) WSAAsyncgethostbyname(HANDLE,UNSIGNED,*CSTRING,*CSTRING,SIGNED), HANDLE,RAW,PASCAL,NAME('WSAASYNCGETHOSTBYNAME'),DLL(dll_mode) WSAAsyncgethostbyaddr(HANDLE,UNSIGNED,*CSTRING,SIGNED,SIGNED,*CSTRING,SIGNED),HANDLE,RAW,PASCAL,NAME('WSAASYNCGETHOSTBYADDR'),DLL(dll_mode) WSAAsyncSelect(UNSIGNED,HANDLE,UNSIGNED,LONG),SIGNED,PASCAL,NAME('WSAASYNCSELECT'),DLL(dll_mode) END
calculate elapsed time
This was presented at Devcon 97 by Sue Alchesay.
To calculate elapsed time in Clarion, use both time and date together….. create a real variable, with Clarion standard date on the left side of the decimal point and Clarion standard time on the right side, by dividing it by 8640000. (number of 1/100th of seconds in one day..)
That way, with only one variable, you can do standard calculations and get an age from 1/100th of a second to years, at once, in one single calculation.
Example :
program map end Beginning REAL Ending REAL ElapsedTime REAL ElapsedDays LONG EndDate LONG CODE beginning = Today() + (Clock()/8640000) ! age between now EndDate = DATE(Month(Today())+1,1,Year(Today())) ! and last day, this month Ending = EndDate - 1/8640000 ! at midnight (or first 1/100 of second,next month....) ElapsedDays = INT(Ending) -INT(beginning) ElapsedTime = Ending - Beginning Message('We are ' & ElapsedDays & ' Days, and ' & FORMAT(((ElapsedTime-Elapseddays)*8640000),@t4) & ' Hours before Midnight,next month')
sort list by header
Description
Clarion does not provide the ability to sort by columnheaders, but it is very easy to do. This example assumes a 2 column browse. Each column has a index associated with it in the dictionary. The first column is CODE and the second column is DESCRIPTION.
Define this local variable Loc:SortColumn BYTE Change the header column on the listbox From "CODE" to "CODE •" - This addes the sort order indicator to CODE Add the following 2 Conditional Behaviours to the browse control If Loc:SortColumn = 1 then set browse key is Cus:KeyCode If Loc:SortColumn = 2 then set browse key is Cus:KeyName Embed this in ThisWindow.Init, After opening Window ?list{prop:Alrt} = MouseLeftUp (Assuming ?list is the name of the control) Embed this in the Window's Alert key embed: if keycode() = MouseLeftUp if BRW2.ILC.GetControl(){proplist:MouseDownRow} = 0 and BRW2.ILC.GetControl(){proplist:MouseDownField} <> 0 Loc:SortColumn = ?List{Proplist:MouseDownField} Case ?List{Proplist:MouseDownField} Of 1 ?List{PROPList:Header,1} = 'CODE •' ?List{PROPList:Header,2} = 'NAME' Of 2 ?List{PROPList:Header,1} = 'CODE' ?List{PROPList:Header,2} = 'NAME •' End else BRW2.TakeNewSelection() end End
(Assuming BRW2 is the name of the browse object)