cdns = getdomaincontroller()
IF EMPTY(cdns)
	RETURN
ENDIF

clear
DO decl 

cServer = cdns  && empty value means local computer 
cUser = GetUsrName()  && current user 

= ListGroups(cServer, cUser)  && local groups 
= ListGroups(cServer, cUser, .T.)  && global groups 
RETURN

*--end of main 

PROCEDURE ListGroups(cServer, cUser, lGlobal) 
#DEFINE MAX_PREFERRED_LENGTH -1 

    LOCAL hBuffer, nBufsize, nReadCount, nTotalCount, nResult,; 
        cBuffer, nIndex, nPtr, nOffs, nLen, cGroup 

    STORE 0 TO nReadCount, nTotalCount, hBuffer 

    cServer = StrConv(cServer+Chr(0), 5) 
    cUser = StrConv(cUser+Chr(0), 5) 

    IF lGlobal 
        nResult = NetUserGetGroups(cServer, cUser, 0,; 
            @hBuffer, MAX_PREFERRED_LENGTH, @nReadCount, @nTotalCount) 
    ELSE 
        nResult = NetUserGetLocalGroups(cServer, cUser, 0,0,; 
            @hBuffer, MAX_PREFERRED_LENGTH, @nReadCount, @nTotalCount) 
    ENDIF 
     
    IF nResult <> 0 Or hBuffer=0 
        = NetApiBufferFree(hBuffer) 
        ? "Error code:", nResult 
        RETURN 
    ENDIF 

    *--size of the buffer allocated by the system 
    *--GlobalSize on Windows XP returns same result 
    nBufsize = 0 
    = NetApiBufferSize(hBuffer, @nBufsize) 

    *--copying data from memory buffer to FoxPro string 
    cBuffer = Repli(Chr(0), nBufsize) 
    CopyMemory(@cBuffer, hBuffer, nBufsize) 

    *--scanning group names 
    FOR nIndex=1 TO nTotalCount 
        *--retrieving 4-byte (DWORD) address of Unicode string 
        *--that specifies the group name 
        nPtr = buf2dword(SUBSTR(cBuffer, (nIndex-1)*4+1,4)) 

        *--matching memory addresses to cBuffer string 
        nOffs = nPtr - hBuffer + 1 
        cGroup = SUBSTR(cBuffer, nOffs)+Chr(0)+Chr(0) 
        nLen = AT(Chr(0)+Chr(0), cGroup) 
        cGroup = SUBSTR(cGroup, 1, nLen) 

        ? nIndex, StrConv(cGroup, 6) 
    ENDFOR 
    = NetApiBufferFree(hBuffer) 

FUNCTION GetUsrName 
*--actually SYS(0) is Ok too :) 
    LOCAL cBuffer, nBufsize 
    nBufsize = 32 
    cBuffer = Repli(Chr(0), nBufsize) 
    = GetUserName(@cBuffer, @nBufsize) 
	lcuser = STRTRAN(cBuffer, Chr(0), "") 
	?"Current User: "+lcuser
RETURN lcuser

PROCEDURE decl 
    DECLARE INTEGER NetUserGetGroups IN netapi32; 
        STRING servername, STRING username, INTEGER lvl,; 
        INTEGER @bufptr, INTEGER prefmaxlen,; 
        INTEGER @entriesread, INTEGER @totalentries 

    DECLARE INTEGER NetUserGetLocalGroups IN netapi32; 
        STRING servername, STRING username, INTEGER lvl,; 
        INTEGER flgs, INTEGER @bufptr, INTEGER prefmaxlen,; 
        INTEGER @entriesread, INTEGER @totalentries 

    DECLARE INTEGER GetUserName IN advapi32; 
        STRING  @lpBuffer, INTEGER @nSize 

    DECLARE RtlMoveMemory IN kernel32 As CopyMemory; 
        STRING @dst, INTEGER src, INTEGER bufsize 

    DECLARE INTEGER NetApiBufferFree IN netapi32 INTEGER buffer 

    DECLARE INTEGER NetApiBufferSize IN netapi32; 
        INTEGER Buffer, INTEGER @ByteCount 

FUNCTION buf2dword(lcBuffer) 
RETURN Asc(SUBSTR(lcBuffer, 1,1)) + ; 
    BitLShift(Asc(SUBSTR(lcBuffer, 2,1)),  8) +; 
    BitLShift(Asc(SUBSTR(lcBuffer, 3,1)), 16) +; 
    BitLShift(Asc(SUBSTR(lcBuffer, 4,1)), 24) 


FUNCTION getdomaincontroller
CLEAR

#DEFINE NERR_Success 0
DO decl2

LOCAL nBuffer
nBuffer = 0

IF NetGetDCName(0,0, @nBuffer) = NERR_Success
	cdomain = GetStrFromMem(nBuffer)
	? "Primary Domain Controller:", cdomain
	RETURN cdomain
ELSE
	? "Error retrieving PDC name"
ENDIF

*--this buffer is allocated by the system and must be released
= NetApiBufferFree(nBuffer)
*--end of main
DO cleardlls
return
RETURN


FUNCTION GetStrFromMem(nAddr)
#DEFINE StrBufferLength  250
	LOCAL cBuffer
	cBuffer = SPACE(StrBufferLength)
	= Heap2String (@cBuffer, nAddr, StrBufferLength)
	cBuffer = SUBSTR(cBuffer, 1, AT(Chr(0)+Chr(0),cBuffer)-1)
RETURN STRTRAN(cBuffer, Chr(0),"")

PROCEDURE decl2
	DECLARE INTEGER NetGetDCName IN netapi32;
		INTEGER servername, INTEGER domainname, INTEGER @bufptr       

	DECLARE INTEGER NetApiBufferFree IN netapi32 INTEGER Buffer

	DECLARE RtlMoveMemory IN kernel32 As Heap2String;
		STRING @ Destination, INTEGER Source, INTEGER nLength


PROCEDURE cleardlls

IF MESSAGEBOX('Remove DLLS from memory?',1+32+4096,'CLEAR MEMORY') <> 1
	RETURN
ENDIF

?
?"---------------- CLEAR DLLS FUNCTION ----------------------"
?
flush
=sys(1104)
IF TYPE('adllarray')<> "U"
	RELEASE adllarray
ENDIF

=ADLLS(adllarray)

IF TYPE('ALEN(adllarray,1)') = "N" .and. ALEN(adllarray,1) > 0
	?"*---- DLLS in Memory ----"
	FOR i = 1 TO ALEN(adllarray,1)
		? adllarray(i)
	ENDFOR
	lccommand = ""
	IF .T.
		FOR i = 1 TO ALEN(adllarray,1)
			IF LEN(lccommand+","+["]+adllarray(i)+["]) > 200
				IF !EMPTY(lccommand)
					?lccommand
					&lccommand
				ENDIF
				lccommand = ''
			ENDIF
			? adllarray(i)
			IF EMPTY(lccommand)
				lccommand = "CLEAR DLLS "
			ELSE
				lccommand = lccommand +","
			ENDIF
			lccommand = lccommand +["]+adllarray(i)+["]
		ENDFOR
		IF !EMPTY(lccommand)
			?lccommand
			&lccommand
			?
		ENDIF
		iloop = 0
		DO WHILE .T. .and. iloop < 20
			iloop = iloop + 1
			RELEASE adllarray, abdllarray
			=ADLLS(abdllarray)
			IF TYPE('ALEN(abdllarray,1)') = "N" .and. ALEN(abdllarray,1) > 0
				?"*---- DLLS in Memory ----"
				FOR i = 1 TO ALEN(abdllarray,1)
					IF LEN(lccommand+","+["]+abdllarray(i)+["]) > 200
						IF !EMPTY(lccommand)
							?lccommand
							&lccommand
							?
						ENDIF
						lccommand = ''
					ENDIF
					? abdllarray(i)
					IF EMPTY(lccommand)
						lccommand = "CLEAR DLLS "
					ELSE
						lccommand = lccommand +","
					ENDIF
					lccommand = lccommand +["]+abdllarray(i)+["]
				ENDFOR
				IF !EMPTY(lccommand)
					?lccommand
					&lccommand
					?
				ENDIF
			ELSE
				?"*---- DLLS Removed From Memory ----"
				EXIT
			ENDIF
		ENDDO
	ENDIF
ELSE
	?"*---- NO DLLS in Memory ----"
ENDIF

RELEASE adllarray
RETURN