Of course, you must have NETBIOS services running! 
Tweet
FUNCTION NCBEnum$ LOCAL public
SHARED NCB, NCBStatus
LOCAL x%, RetCode%, LanaCount%, Enum$
Enum$ = ""
FOR x% = -1 TO 6 ' Order 7, 0, 1, 2, 3, 4, 5, 6
LSET NCBStatus = STRING$(LEN(NCBStatus), 0)
LSET NCB = STRING$(LEN(NCB),0)
NCB.Cmd = &HB3
IF x% = -1 THEN
NCB.LanaNum = 7
ELSE
NCB.LanaNum = x%
END IF
NCB.CallName = "*"
NCB.BufAdr = varptr32(NCBStatus)
NCB.BufLen = LEN(NCBStatus)
NCB.RTO = 255
NCB.STO = 255
RetCode% = NetBiosCommand%(NCB)
IF ISFALSE RetCode% THEN
Enum$ = Enum$ + CHR$(48 + NCB.LanaNum)
END IF
NEXT x%
FUNCTION = Enum$
END FUNCTION
' This is a hodge-podge adaptation of some combination
' of Randy Birch's VB MAC Address routine (http://www.mvps.org/vbnet/),
' Lance's MAC Address routine, and my own code.
#COMPILE EXE
#INCLUDE "WIN32API.INC"
' Declares for registry string retrieval
'
GLOBAL MainKeyHandle AS LONG
GLOBAL hKey AS LONG
GLOBAL lBufferSize AS LONG
GLOBAL rtn AS LONG
DECLARE FUNCTION GetMainKeyHandle(MainKeyName AS STRING) AS LONG
DECLARE FUNCTION GetStringValue(SubKey AS STRING, Entry AS STRING) AS STRING
DECLARE SUB ParseKey(Keyname AS STRING, Keyhandle AS LONG)
DECLARE FUNCTION GetMainKeyHandle(MainKeyName AS STRING) AS LONG
DECLARE FUNCTION GetMACAddress() AS STRING
' Declares for Netbios stuff
%NCBNAMSZ = 16 ' Needed here as the following types are dependent on it
%MAX_LANA = 254
TYPE LANA_ENUM
length AS BYTE
lana(%MAX_LANA) AS BYTE
END TYPE
TYPE NET_CONTROL_BLOCK 'NCB
ncb_command AS BYTE
ncb_retcode AS BYTE
ncb_lsn AS BYTE
ncb_num AS BYTE
ncb_buffer AS LONG
ncb_length AS INTEGER
ncb_callname AS ASCIIZ * %NCBNAMSZ
ncb_name AS ASCIIZ * %NCBNAMSZ
ncb_rto AS BYTE
ncb_sto AS BYTE
ncb_post AS LONG
ncb_lana_num AS BYTE
ncb_cmd_cplt AS BYTE
ncb_reserve(9) AS BYTE ' Reserved, must be 0
ncb_event AS LONG
END TYPE
TYPE ADAPTER_STATUS
adapter_address(5) AS BYTE
rev_major AS BYTE
reserved0 AS BYTE
adapter_type AS BYTE
rev_minor AS BYTE
duration AS INTEGER
frmr_recv AS INTEGER
frmr_xmit AS INTEGER
iframe_recv_err AS INTEGER
xmit_aborts AS INTEGER
xmit_success AS LONG
recv_success AS LONG
iframe_xmit_err AS INTEGER
recv_buff_unavail AS INTEGER
t1_timeouts AS INTEGER
ti_timeouts AS INTEGER
Reserved1 AS LONG
free_ncbs AS INTEGER
max_cfg_ncbs AS INTEGER
max_ncbs AS INTEGER
xmit_buf_unavail AS INTEGER
max_dgram_size AS INTEGER
pending_sess AS INTEGER
max_cfg_sess AS INTEGER
max_sess AS INTEGER
max_sess_pkt_size AS INTEGER
name_count AS INTEGER
END TYPE
TYPE NAME_BUFFER
name_name AS ASCIIZ * %NCBNAMSZ
name_num AS INTEGER
name_flags AS INTEGER
END TYPE
TYPE ASTAT
adapt AS ADAPTER_STATUS
NameBuff(30) AS NAME_BUFFER
END TYPE
'*******************************************************************
FUNCTION GetMACAddress() AS STRING
'retrieve the MAC Address for the network controller
'installed, returning a formatted string
'
' This is a hodge-podge adaptation of some combination
' of Randy Birch's VB MAC Address routine (http://www.mvps.org/vbnet/),
' Lance's MAC Address routine, and my own code.
'
LOCAL tmp AS STRING
LOCAL pASTAT AS LONG
LOCAL nNCB AS NCB
LOCAL aAST AS ASTAT
LOCAL nErr AS LONG
LOCAL Temp AS STRING
LOCAL I AS INTEGER
LOCAL A$
LOCAL B$
Temp =""
'For machines with multiple network adapters we need to
'enumerate the LANA numbers and perform the NCBASTAT
'command on each.
FOR I = -1 TO 6 ' Order 7, 0, 1, 2, 3, 4, 5, 6
'Issue a NCBRESET.
nNCB.ncb_command = %NCBRESET '
nErr = Netbios(nNCB)
nNCB.ncb_callname = "* "
nNCB.ncb_command = %NCBASTAT
IF I = -1 THEN
nNCB.ncb_lana_num = 7
ELSE
nNCB.ncb_lana_num = I
END IF
nNCB.ncb_length = LEN(aAST)
pASTAT = HeapAlloc(GetProcessHeap(), %HEAP_GENERATE_EXCEPTIONS _
OR %HEAP_ZERO_MEMORY, nNCB.ncb_length)
IF pASTAT = 0 THEN
MSGBOX "Memory allocation failed!" ,, "ZeaSoft, Inc."
EXIT FUNCTION
END IF
nNCB.ncb_buffer = pASTAT
CALL Netbios(nNCB)
MoveMemory VARPTR(aAST), nNCB.ncb_buffer, SIZEOF(aAST)
tmp = RIGHT$("00" & HEX$(aAST.adapt.adapter_address(0)), 2) & " " & _
RIGHT$("00" & HEX$(aAST.adapt.adapter_address(1)), 2) & " " & _
RIGHT$("00" & HEX$(aAST.adapt.adapter_address(2)), 2) & " " & _
RIGHT$("00" & HEX$(aAST.adapt.adapter_address(3)), 2) & " " & _
RIGHT$("00" & HEX$(aAST.adapt.adapter_address(4)), 2) & " " & _
RIGHT$("00" & HEX$(aAST.adapt.adapter_address(5)), 2)
tmp=TRIM$(tmp)
HeapFree GetProcessHeap(), 0, pASTAT
' Here we only keep results that indicate a device for a given LANA
IF tmp <> "00 00 00 00 00 00" THEN
tmp = TRIM$(tmp)
' Put it in the traditional XX-XX-XX-XX-XX-XX-XX format
REPLACE " " WITH "-" IN tmp
' Some machines give the same adapter more than one LANA
' Here we only add a MAC address to your existing list
' only if it is truely new. Then we try to match the device
' name to the MAC address using the System Registry
IF INSTR(Temp, tmp)=0 THEN
' LANA 7 (on every machine I've checked
' seems to be associated with adapter 0000
IF I=-1 THEN
A$=GetStringValue("HKEY_LOCAL_MACHINE\System\CurrentControlSet\Services\Class\Net\0000", "DriverDesc")
Temp=Temp + tmp + " "+A$+ CHR$(13,10)
ELSE
' LANA x (on every machine I've checked
' seems to be associated with adapter 000x+1
B$=FORMAT$(I+1,"0000")
A$=GetStringValue("HKEY_LOCAL_MACHINE\System\CurrentControlSet\Services\Class\Net\"+B$, "DriverDesc")
Temp=Temp + tmp + " "+A$+CHR$(13,10)
END IF
END IF
END IF
NEXT I
FUNCTION = Temp
END FUNCTION
'********************************************
FUNCTION GetStringValue(SubKey AS STRING, Entry AS STRING) AS STRING
DIM rtn AS LONG
DIM SubKeyz AS ASCIIZ * 256
DIM sBufferz AS ASCIIZ * 256
DIM Entryz AS ASCIIZ * 256
CALL ParseKey(SubKey, MainKeyHandle)
SubKeyz=SubKey + CHR$(0)
Entryz=Entry + CHR$(0)
IF MainKeyHandle THEN
rtn = RegOpenKeyEx(MainKeyHandle, SubKeyz, 0, %KEY_READ, hKey) 'open the key
IF rtn = %ERROR_SUCCESS THEN 'if the key could be opened then
lBufferSize = 256
rtn = RegQueryValueEx(hKey, Entryz, 0, 1, sBufferz, 255) 'get the value from the registry
IF rtn = %ERROR_SUCCESS THEN 'if the value could be retreived then
rtn = RegCloseKey(hKey) 'close the key
sBufferz = TRIM$(sBufferz)
GetStringValue = sBufferz 'return the value to the user
ELSE 'otherwise, if the value couldnt be retreived
GetStringValue = "" ' return null string to user
END IF
ELSE 'otherwise, if the key couldnt be opened
GetStringValue = "" ' return null string to user
END IF
END IF
END FUNCTION
'****************************************
SUB ParseKey(Keyname AS STRING, Keyhandle AS LONG)
rtn = INSTR(Keyname, "\") 'return if "\" is contained in the Keyname
IF LEFT$(Keyname, 5) <> "HKEY_" OR RIGHT$(Keyname, 1) = "\" THEN 'if the is a "\" at the end of the Keyname then
MSGBOX "Incorrect Format:" + CHR$(10) + CHR$(10) + Keyname,, "ZS ParseKey" 'display error to the user
EXIT SUB 'exit the procedure
ELSEIF rtn = 0 THEN 'if the Keyname contains no "\"
Keyhandle = GetMainKeyHandle(Keyname)
Keyname = "" 'leave Keyname blank
ELSE 'otherwise, Keyname contains "\"
Keyhandle = GetMainKeyHandle(LEFT$(Keyname, rtn - 1)) 'seperate the Keyname
Keyname = RIGHT$(Keyname, LEN(Keyname) - rtn)
END IF
END SUB
'************************************************
FUNCTION GetMainKeyHandle(MainKeyName AS STRING) AS LONG
DIM HKEY_CLASSES_ROOT AS LONG
DIM HKEY_CURRENT_USER AS LONG
DIM HKEY_LOCAL_MACHINE AS LONG
DIM HKEY_USERS AS LONG
DIM HKEY_PERFORMANCE_DATA AS LONG
DIM HKEY_CURRENT_CONFIG AS LONG
DIM HKEY_DYN_DATA AS LONG
HKEY_CLASSES_ROOT = &H80000000
HKEY_CURRENT_USER = &H80000001
HKEY_LOCAL_MACHINE = &H80000002
HKEY_USERS = &H80000003
HKEY_PERFORMANCE_DATA = &H80000004
HKEY_CURRENT_CONFIG = &H80000005
HKEY_DYN_DATA = &H80000006
SELECT CASE MainKeyName
CASE "HKEY_CLASSES_ROOT"
GetMainKeyHandle = HKEY_CLASSES_ROOT
CASE "HKEY_CURRENT_USER"
GetMainKeyHandle = HKEY_CURRENT_USER
CASE "HKEY_LOCAL_MACHINE"
GetMainKeyHandle = HKEY_LOCAL_MACHINE
CASE "HKEY_USERS"
GetMainKeyHandle = HKEY_USERS
CASE "HKEY_PERFORMANCE_DATA"
GetMainKeyHandle = HKEY_PERFORMANCE_DATA
CASE "HKEY_CURRENT_CONFIG"
GetMainKeyHandle = HKEY_CURRENT_CONFIG
CASE "HKEY_DYN_DATA"
GetMainKeyHandle = HKEY_DYN_DATA
END SELECT
END FUNCTION
'**********************************************
FUNCTION PBMAIN AS LONG
MSGBOX GetMACAddress,, "Another hack job"
END FUNCTION
'**********************************************
' =========================================================================
' Program Title: NWCALLS.BAS
' Copyright: Donated to PUBLIC DOMAIN By Scott Slater
' Author: Scott Slater
' Last Modified: 09/14/1997
' =========================================================================
' Description: Some Novell NetWare functions for PowerBASIC
' =========================================================================
%EXEFILE = 0 ' change to 0 to compile as a unit
$cpu 8086 ' program works on any CPU
$optimize size ' make smallest possible executable
$if %EXEFILE ' if we're making an EXE
$compile exe ' compile to an EXE
$else ' otherwise
$compile unit ' compile to a unit
$endif
$debug map off ' turn off map file generation
$debug pbdebug off ' don't include pbdebug support in our executable
$lib all off ' turn off PowerBASIC's internal libraries.
$error all off ' turn off all error checking
$com 0 ' set communications buffer to nothing
$string 16 ' set largest string size at 16k
$stack 2048 ' use a 2k stack
$sound 1 ' smallest music buffer possible
$dim all ' force all variables to be pre-dimensioned before
' they can be used
$dynamic ' all arrays will be dynamic by default
$option cntlbreak off ' don't allow Ctrl-Break to exit program
type FullNetAddress ' full net address buffer type
NetWork as string * 4
Node as string * 6
Socket as string * 2
end type
type ReqPack1 ' request packet type 1 for function
length as word ' E3h calls
funct as byte
end type
type RplPack1 ' reply packet type 1 for function
length as word ' E3h calls
SrvName as string * 48
Major as byte
Minor as byte
totconn as word
usedconn as word
maxvols as word
enumm as word
reserved as string * 88
end type
type ReqPack2 ' request packet type 2 for function
length as word ' E3h calls
funct as byte
connect as byte
end type
type RplPack2 ' reply packet type 2 for function
length as word ' E3h calls
beID as dword
UserType as word
UserName as string * 48
LoginTime as string * 8
end type
declare function NWGetConn() as word
declare function strim(wordvar as word) as string
declare function strimb(bytevar as byte) as string
declare function Str2Hex(StrVar as string) as string
$if %EXEFILE
' TEST CODE HERE!
declare function IPXInstalled() as byte
declare function NWGetVer() as single
declare function NWGetServerName() as string
declare function NWGetFullAddress() as string
declare function NWGetUserName() as string
declare function NWGetLoginTime(style as byte) as string
declare function NWGetNodeAddress() as string
declare function NWGetNetworkNumber() as string
dim us as string
if IPXInstalled then
if NWGetVer then
Print
Print NWGetServerName;" is running NetWare";NWGetVer
Print "This station's connection number is";NWGetConn
Print "and its full IPX address is ";NWGetFullAddress
Print
us = NWGetUserName
if us = "Not Logged In" then
Print "Currently ";us
else
Print "User ";us;" logged in on ";NWGetLoginTime(3)
Print "from node ";NWGetNodeAddress;" on Network ";NWGetNetworkNumber
end if
else
Print "IPX is installed, but no server information is available."
end if
else
Print "No IPX Installed on this station."
end if
Print
end
$endif
'--------------------------------------------------------------------------
' NetWare CONNECTION SERVICES - GET CONNECTION NUMBER Function DCh
'--------------------------------------------------------------------------
function NWGetConn() public as word
! push ds ; save ds for PowerBASIC
! mov ah, &HDC ; function DCh
! int &H21 ; call interrupt 21h
! pop ds ; restore the ds
! mov function, al ; al holds the connection number
end function
'--------------------------------------------------------------------------
' NetWare SERVER INFO SERVICES - GET CURRENT VERSION Function E3h
'--------------------------------------------------------------------------
function NWGetVer() public as single
dim request as reqpack1
dim reply as rplpack1
dim seg1 as word
dim seg2 as word
dim off1 as word
dim off2 as word
request.length = len(request) ' length of request buffer
request.funct = &H11 ' sub function 11h
reply.length = len(reply) ' length of the reply buffer
seg1 = varseg(request) ' segment address of request buffer
off1 = varptr(request) ' offset of request buffer
seg2 = varseg(reply) ' segment address of reply buffer
off2 = varptr(reply) ' offset of reply buffer
! push ds ; save the ds for PowerBASIC
! mov ax, &HE300 ; function E3h
! mov ds, seg1 ; address of request buffer goes
! mov si, off1 ; into ds:si
! mov es, seg2 ; address of reply buffer goes
! mov di, off2 ; into es:di
! int &H21 ; interrupt 21h
! pop ds ; restore the ds
! cmp al, 0 ; is al = 0 ?
! jne ver_err ; if not we have an error
! jmp ver_ok ; if so we are successful
ver_err:
function = 0
exit function
ver_ok:
function = reply.major + (reply.minor/100) ' return version info
end function
'--------------------------------------------------------------------------
' NetWare SERVER INFO SERVICES - GET SERVER NAME Function E3h SubFunc 11h
'--------------------------------------------------------------------------
function NWGetServerName() public as string
dim request as reqpack1
dim reply as rplpack1
dim seg1 as word
dim seg2 as word
dim off1 as word
dim off2 as word
dim temp as string
request.length = len(request) ' length of request buffer
request.funct = &H11 ' sub function 11h
reply.length = len(reply) ' length of reply buffer
seg1 = varseg(request) ' segment address of request buffer
off1 = varptr(request) ' offset of request buffer
seg2 = varseg(reply) ' segment address of reply buffer
off2 = varptr(reply) ' offset of reply buffer
! push ds ; save the ds for PowerBASIC
! mov ax, &HE300 ; function E3h
! mov ds, seg1 ; address of request buffer goes
! mov si, off1 ; into ds:si
! mov es, seg2 ; address of reply buffer goes
! mov di, off2 ; into es:di
! int &H21 ; interrupt 21h
! pop ds ; restore the ds
! cmp al, 0 ; is al = 0?
! jne srv_err ; if not we have an error
! jmp srv_ok ; if so, we are done
srv_err:
function = "Not Attached" ' we weren't successful so we must
exit function ' not be attached to a server
srv_ok:
temp = reply.SrvName
function = left$(temp, instr(temp, chr$(0)) - 1) 'return the server name
end function
'--------------------------------------------------------------------------
' NETWARE SHELL SERVICES - GET NODE ADDRESS Function EEh
'--------------------------------------------------------------------------
function NWGetNodeAddress() public as string
dim part1 as word
dim part2 as word
dim part3 as word
dim temp as string
! push ds ; save the ds for PowerBASIC
! xor ax, ax ; 0 the ax register
! mov ah, &HEE ; function EEh
! int &H21 ; interrupt 21h
! mov part3, ax ; copy contents of ax to part3
! mov part2, bx ; copy contents of bx to part2
! mov part1, cx ; copy contents of cx to part1
! pop ds ; restore the ds
temp = right$("0000" + hex$(part1),4) ' build the node address
temp = temp +right$("0000" + hex$(part2),4) ' from all 3 parts
temp = temp +right$("0000" + hex$(part3),4)
function = temp ' return the node address
end function
'--------------------------------------------------------------------------
' IPX SERVICES - GET NETWORK NUMBER Function 9h, of Int 7Ah
'--------------------------------------------------------------------------
function NWGetNetworkNumber() public as string
dim NetAdd as FullNetAddress
dim seg1 as word
dim off1 as word
dim temp as string
seg1 = varseg(NetAdd)
off1 = varptr(NetAdd)
! push ds ; save the ds for PowerBASIC
! xor bx, bx ; 0 the bx register
! mov bx, &H9 ; put 9h into bx
! mov es, seg1 ; address of NetAdd (Buffer) goes
! mov si, off1 ; into es:si
! int &H7A ; interrupt 7Ah
! pop ds ; restore the ds
temp = NetAdd.Network
function = Str2Hex(temp) ' return network address
end function
'--------------------------------------------------------------------------
' IPX SERVICES - GET FULL ADDRESS Function 9h, of Int 7Ah
'--------------------------------------------------------------------------
function NWGetFullAddress() public as string
dim NetAdd as FullNetAddress
dim seg1 as word
dim off1 as word
dim temp1 as string
dim temp2 as string
seg1 = varseg(NetAdd)
off1 = varptr(NetAdd)
! push ds ; save the ds for PowerBASIC
! xor bx, bx ; 0 the bx
! mov bx, &H9 ; copy 9h to bx
! mov es, seg1 ; address of NetAdd (Buffer) goes
! mov si, off1 ; into es:si
! int &H7A ; interrupt 7Ah
! pop ds ; restore the ds
temp1 = NetAdd.NetWork ' build the entire network address
temp2 = Str2Hex(temp1) ' as follows;
temp1 = NetAdd.Node ' XXXXXXXX:NNNNNNNNNNNN:SSSS
temp2 = temp2 + ":" + Str2Hex(temp1) ' where X is the Network Number
temp1 = NetAdd.Socket ' N is the node address
temp2 = temp2 + ":" + Str2Hex(temp1) ' S is the Socket Number
function = temp2 ' return the full address
end function
'--------------------------------------------------------------------------
' IPX SERVICES - IPX DETECTION Function 7Ah
'--------------------------------------------------------------------------
'
' Returns FFh (255) if IPX is installed, 0 if not.
'
function IPXInstalled() public as byte
! push ds ; save the ds for PowerBASIC
! xor ax, ax ; 0 the ax register
! mov ah, &H7A ; function 7Ah
! int &H2F ; interrupt 2Fh
! pop ds ; restore ds
! mov function, al ; result is in al FFh=TRUE 0h=FALSE
end function
'--------------------------------------------------------------------------
' NetWare CONNECTION SERVICES - GET USER NAME Function E3h SubFunc 16h
'--------------------------------------------------------------------------
function NWGetUserName() public as string
dim request as reqpack2
dim reply as rplpack2
dim seg1 as word
dim seg2 as word
dim off1 as word
dim off2 as word
dim temp as string
request.length = len(request) ' length of request buffer
request.funct = &H16 ' subfunction 16h
request.connect = (NWGetConn AND &HFF) ' connection number
reply.length = len(reply) ' length of reply buffer
seg1 = varseg(request) ' segment address of request buffer
off1 = varptr(request) ' offset of request buffer
seg2 = varseg(reply) ' segment address of reply buffer
off2 = varptr(reply) ' offset of reply buffer
! push ds ; save ds for PowerBASIC
! xor ax, ax ; 0 the ax register
! mov ah, &HE3 ; function E3h
! mov ds, seg1 ; address of Request buffer goes
! mov si, off1 ; into ds:si
! mov es, seg2 ; address of reply buffer goes
! mov di, off2 ; into es:di
! int &H21 ; interrupt 21h
! pop ds ; restore the ds
! cmp al, 0 ; is the al set to 0?
! jne usr_err ; if not we have an error
! jmp usr_ok ; if so, we were successful
usr_err:
function = "Not Logged In"
exit function
usr_ok:
temp = reply.UserName
function = left$(temp, instr(temp, chr$(0)) - 1) 'return user name
end function
'--------------------------------------------------------------------------
' NetWare CONNECTION SERVICES - GET LOGIN TIME Function E3h SubFunc 16h
'--------------------------------------------------------------------------
'
' Syntax: PRINT NWGetLoginTime(x)
'
' where x = 0, 1, 2, or 3 to produce different output styles
function NWGetLoginTime(style as byte) public as string
dim request as reqpack2
dim reply as rplpack2
dim seg1 as word
dim seg2 as word
dim off1 as word
dim off2 as word
dim temp1 as string
dim temp2 as string
dim year as word
dim month as byte
dim day as byte
dim day_of_week as byte
dim hour as byte
dim minute as byte
dim sec as byte
request.length = len(request) ' length of request buffer
request.funct = &H16 ' sub function 16h
request.connect = (NWGetConn AND &HFF) ' connection number
reply.length = len(reply) ' length of reply buffer
seg1 = varseg(request) ' segment address of request buffer
off1 = varptr(request) ' offset of request buffer
seg2 = varseg(reply) ' segment address of reply buffer
off2 = varptr(reply) ' offset of reply buffer
! push ds ; save the ds for PowerBASIC
! xor ax, ax ; 0 the ax register
! mov ah, &HE3 ; function E3h
! mov ds, seg1 ; address of request buffer goes
! mov si, off1 ; into ds:si
! mov es, seg2 ; address of reply buffer goes
! mov di, off2 ; into es:di
! int &H21 ; interrupt 21h
! pop ds ; restore the ds
! cmp al, 0 ; is al = 0 ?
! jne lit_err ; if not we have an error
! jmp lit_ok ; if so, we were successful
lit_err:
function = ""
exit function
lit_ok: ' construct the return string
year = 1900 + cvbyt(mid$(reply.LogInTime,1,1))
month = cvbyt(mid$(reply.LogInTime,2,1))
day = cvbyt(mid$(reply.LogInTime,3,1))
hour = cvbyt(mid$(reply.LogInTime,4,1))
minute = cvbyt(mid$(reply.LogInTime,5,1))
sec = cvbyt(mid$(reply.LogInTime,6,1))
day_of_week = cvbyt(mid$(reply.LogInTime,7,1))
if (style and 2) then ' 12 hour time
if hour > 12 then
hour = hour - 12
temp1 = strimb(hour) + ":" + strimb(minute)
temp1 = temp1 + ":" + strimb(sec) + " PM"
else
temp1 = strimb(hour) + ":" + strimb(minute)
temp1 = temp1 + ":" + strimb(sec) + " AM"
end if
else ' 24 hour time
temp1 = strimb(hour) + ":" + strimb(minute)
temp1 = temp1 + ":" + strimb(sec)
end if
if (style and 1) then ' long date format
select case month
case 1
temp2 = "January "
case 2
temp2 = "February "
case 3
temp2 = "March "
case 4
temp2 = "April "
case 5
temp2 = "May "
case 6
temp2 = "June "
case 7
temp2 = "July "
case 8
temp2 = "August "
case 9
temp2 = "September "
case 10
temp2 = "October "
case 11
temp2 = "November "
case 12
temp2 = "December "
end select
temp2 = temp2 + strimb(day) + ", " + strim(year)
select case day_of_week
case 0
temp2 = "Sunday " + temp2
case 1
temp2 = "Monday " + temp2
case 2
temp2 = "Tuesday " + temp2
case 3
temp2 = "Wednesday " + temp2
case 4
temp2 = "Thursday " + temp2
case 5
temp2 = "Friday " + temp2
case 6
temp2 = "Saturday " + temp2
end select
else ' Short Date Format
temp2 = strimb(month) + "/" + strimb(day) + "/" + strim(year)
end if
function = temp2 + " at " + temp1
end function
' used internaly to convert word to a string and remove spaces
function strim(w as word) as string
function = ltrim$(rtrim$(str$(w)))
end function
' used internaly to convert byte to a string, remove spaces, and make
' propper length
function strimB(b as byte) as string
function = right$("00" + ltrim$(rtrim$(str$(b))),2)
end function
' used internaly to convert IPX Call String values to hex
function Str2Hex (strval as string) as string
dim temp as string
dim count as integer
dim sng as single
temp = ""
for count = 1 to len(strval)
sng = asc(mid$(strval, count, 1))
if sng < 15 then
temp = temp + "0" + hex$(sng)
else
temp = temp + hex$(sng)
end if
next count
function = temp
end function
Comment