Autorarchive: ralf

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')

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)

play mp3 file

This is what i do :
—–

After global includes:
Include('Winequ.clw')

In Global Map:
Module('Window's API')

MciGetErrorString(ULONG,*CSTRING,USHORT),SHORT,PASCAL,RAW,PROC,NAME('MciGetErrorStringA')

MciSendString(*CSTRING,*CSTRING,USHORT,USHORT),ULONG,PASCAL,RAW,PROC,NAME('MciSendStringA')
End

In Global Datas :
MciChaineRequise   Cstring(128)
MciValeurRetourne  Cstring(128)
MciNumeroErreur    Long
MciChaineErreur    Cstring(128)
FichierJoue        String(255)

Embed Accepted 'Play':
FichierJoue = 'C:\TestMp3\MyFile.Mp3'
MciChaineRequise = 'open mpegvideo!' & Clip(FichierJoue) &' alias Mp3' ; Do JouerMci
MciChaineRequise = 'play Mp3' ; Do JouerMci

Embed Accepted 'Stop' :
MciChaineRequise = 'stop Mp3'  ; Do JouerMci
MciChaineRequise = 'close Mp3' ; Do JouerMci

Procedure Routine:
JouerMci Routine
  Clear(MciValeurRetourne)
  Clear(MciNumeroErreur)
  Clear(MciChaineErreur)
  MciSendString(MciChaineRequise,MciValeurRetourne,128,0)
  MciGetErrorString(MciNumeroErreur,MciChaineErreur,128)

—-
For info, use this before play another file :
MciChaineRequise = ’status Mp3 mode‘ ; Do JouerMci

HTH. Eric

get windows version – 2

  MAP
    ReFlex__OS(BYTE Extended=0),BYTE
    MODULE('')
      GetVersionEx(LONG),SIGNED,PASCAL,NAME('GetVersionExA'),PROC
    END
  END
  
ReFlex__OS FUNCTION(BYTE Extended=0)
!
! If NOT "Extended"   return 0 = Win9x/ME, 1 = NT, 2 = W2K/Whistler(XP)
! If "Extended"       return 1 = Win95, 2 = Win98, 3 = NT3.51, 4 = NT4, 5 = W2K, 6 = ME, 7 = Whistler(XP)
! Returns 255 on error
!

OSVersionInfo       GROUP,PRE()
InfoSize              ULONG
MajorVersion          ULONG
MinorVersion          ULONG
BuildNumber           ULONG
PlatformID            ULONG
CSDVersion            STRING(128)
                    END

  !   OS          MajorVersion  MinorVersion  PlatformID
  ! =====================================================
  !  Win95             4             0            1
  !  Win98             4            >0            1
  !  ME                4            90            1
  !  NT3.51            3            51            2
  !  NT4               4             0            2
  !  W2K               5             0            2
  !  Whistler(XP)      5             1            2

  CODE
  CLEAR(OSVersionInfo)
  InfoSize = SIZE(OSVersionInfo)
  IF NOT GetVersionEx(ADDRESS(OSVersionInfo)) THEN RETURN(255).

  IF NOT Extended
    RETURN( CHOOSE(PlatformID = 1, 0, CHOOSE(PlatformID = 2, CHOOSE(MajorVersion < 5, 1, 2), 255)) )
  ELSE
    IF MajorVersion = 4 AND MinorVersion = 90
      RETURN(6)
    ELSIF MajorVersion = 5 AND MinorVersion = 1
      RETURN(7)
    END
    RETURN( CHOOSE(PlatformID = 1, CHOOSE(MinorVersion = 0, 1, 2), CHOOSE(PlatformID = 2, MajorVersion, 255)) )
  END