Sorry your browser is not supported!

print GetProfileName()
wait key
end

function getProfileName()
p$=""
dll=freeDll()

Load Dll "Advapi32.dll",dll

maxlen=256
mem_a=freeMemblock()
make memblock mem_a,maxlen
lpBuffer as dword
lpBuffer = get memblock ptr(mem_a)

mem_b=freeMemblock()
make memblock mem_b,4
lpnSize as dword
lpnSize = get memblock ptr(mem_b)
*lpnSize = get memblock size(mem_a)

result = Call Dll(dll,"GetUserNameA",lpBuffer,lpnSize)
if result <> 0
   size as dword
   size=memblock dword(mem_b,0)
   for b=1 to size
      m=memblock byte(mem_a,b-1)
      if m=0 then exit
      p$=p$+chr$(m)
   next b
endif

delete memblock mem_b
delete memblock mem_a
Delete Dll dll

endfunction p$

function freeMemblock()
   i=0
   repeat
      inc i
   until memblock exist(i)=0
endfunction i

function freeDll()
   i=0
   repeat
      inc i
   until dll exist(i)=0
endfunction i

` Function: Retrieves current user
` Author:   Spooky
`
` From MSDN we know that we need to use Advapi32.dll
`
` It tells us the format is:
`
` BOOL GetUserName(
`  LPTSTR lpBuffer,
`  LPDWORD lpnSize
` );
`
` where lpBuffer is a pointer to the buffer which will
` receive the resulting string plus a terminating NULL
` character = ascii 0
`
` lpnSize is a pointer to a DWORD area of memory (4 bytes)
` that on input should hold length of lpBuffer (in bytes),
` and on output will hold length of username plus the
` terminating character. So if username is JOHN then result
` will be 5
`
` In DBPro a memblock is simply an area of memory you can
` reserve. You use these as Dll buffers and use the ptr
` function to get a pointer to that address

print GetProfileName()
wait key
end

function getProfileName()
p$=""
dll=freeDll()

Load Dll "Advapi32.dll",dll


` here we will reserve an area of memory of 256 bytes
` which should be ample to hold a username

` how big do we want buffer
maxlen=256
` get next memblock number
mem_a=freeMemblock()
` actually make a memblock
make memblock mem_a,maxlen
` memblock pointers need to be defined as DWORDs (4 bytes)
lpBuffer as dword
` this will store a pointer to memblock which we can pass to Dll
lpBuffer = get memblock ptr(mem_a)

` now we need another memblock of 4 bytes (length of a DWORD)
` on input we will stick in length of buffer (256 bytes)
` and on output will contain length of username+1

` get next memblock number
mem_b=freeMemblock()
` make the memblock
make memblock mem_b,4
` define variable (DLL requires a DWORD)
lpnSize as dword
` get pointer to memblock
lpnSize = get memblock ptr(mem_b)
` the wierd * is a shortcut way in DBPro to
` fill the memblock with a value, which we
` are going to fill it with size of first memblock
` which is 256. You could also use WRITE MEMBLOCK DWORD
*lpnSize = get memblock size(mem_a)

` Call the Dll with the two pointers to the 2 memblocks.
result = Call Dll(dll,"GetUserNameA",lpBuffer,lpnSize)

` MSDN tells us that result will be non-zero for a success
if result <> 0
   size as dword
   ` retrieve how many characters the DLL has inserted into first buffer
   ` it will be the length of username+1
   ` we get this info from contents of second small buffer
   size=memblock dword(mem_b,0)
   ` simply loop through each byte of first 256 byte buffer
   ` and get ascii value of character (0 to 255) and append
   ` it to our username string. As a safety measure we exit
   ` loop when we hit the termination character 0
   for b=1 to size
      m=memblock byte(mem_a,b-1)
      if m=0 then exit
      p$=p$+chr$(m)
   next b
endif

` should always tidy up and delete the memblocks and dlls, otherwise
` the memory allocated will not be returned until you exit or possibly
` even reboot.
delete memblock mem_b
delete memblock mem_a
Delete Dll dll

endfunction p$

` find next available memblock number
function freeMemblock()
   i=0
   repeat
      inc i
   until memblock exist(i)=0
endfunction i

` find next available dll number
function freeDll()
   i=0
   repeat
      inc i
   until dll exist(i)=0
endfunction i