WAIT WINDOW serial()
FUNCTION serial
* GetVolumeInformation
*** Declare Local Variables ***
LOCAL i && counter
LOCAL lndrvtype && DRIVETYPE
LOCAL lcdrive && string
LOCAL lndrive && bitmap of legal drives
* standard declares for WinAPI calls
LOCAL lprootpathname, ;
lpvolumenamebuffer, ;
lpvolumeserialnumber, ;
lpmaximumcomponentlength, ;
lpfilesystemflags, ;
lpfilesystemnamebuffer, ;
nvolumenamesize, ;
nfilesystemnamesize
*** Declare API calls ***
* GetDriveType() returns numeric type of drive
DECLARE INTEGER GetDriveType IN WIN32API ;
STRING lpRootPathName && address of root path
* GetLogicalDrives() returns a bitmap of
* "legal" logical drives
DECLARE INTEGER GetLogicalDrives IN win32api
* GetVolumeInformation() returns volume names, ;
* serial numbers, file systems, and other stuff.
DECLARE short GetVolumeInformation IN Win32API ;
STRING lpRootPathName, ;
STRING lpVolumeNameBuffer, ;
INTEGER nVolumeNameSize, ;
STRING lpVolumeSerialNumber, ;
STRING lpMaximumComponentLength, ;
STRING lpFileSystemFlags, ;
STRING lpFileSystemNameBuffer, ;
INTEGER nFileSystemNameSize
* GetDriveType RETURN VALUES:
#DEFINE drive_none 0 && Cannot be determined.
#DEFINE drive_bad 1 && Root directory does not exist.
#DEFINE drive_removable 2 && Disk can be removed.
#DEFINE drive_fixed 3 && Disk cannot be removed.
#DEFINE drive_remote 4 && Drive is remote/network drive.
#DEFINE drive_cdrom 5 && The drive is a CD-ROM drive.
#DEFINE drive_ramdisk 6 && The drive is a RAM disk.
*** Get bitmap of legal drives ***
lndrive = getlogicaldrives()
lcdrive = CHR(ASC("A")+2)+":" && translate to letter (C:)
* Set the defaults for floppies
lpvolumenamebuffer = ""
lndrivetype = drive_removable
* Skip trying to obtain the name or drive type of
* floppies: this can bring up an untrappable error
* Obtain the Volume Name
STORE SPACE(255) TO lprootpathname, ;
lpvolumenamebuffer, ;
lpvolumeserialnumber, ;
lpmaximumcomponentlength, ;
lpfilesystemflags, ;
lpfilesystemnamebuffer
STORE 255 TO nvolumenamesize, nfilesystemnamesize
= getvolumeinformation(lcdrive, ;
@lpvolumenamebuffer, ;
@nvolumenamesize, ;
@lpvolumeserialnumber, ;
@lpmaximumcomponentlength, ;
@lpfilesystemflags, ;
@lpfilesystemnamebuffer, ;
@nfilesystemnamesize )
* Truncate the buffer to the CHR(0) end of string
* or to zero for blank volumes
lpvolumenamebuffer = LEFT(lpvolumenamebuffer, ;
AT(CHR(0),lpvolumenamebuffer)-1)
* Get the volume's drive type
lndrivetype = getdrivetype(lcdrive)
creturnhex = ""
FOR Y = 1 TO LEN(ALLTRIM(lpvolumeserialnumber))
cstreng = SUBSTR(lpvolumeserialnumber,Y,1)
cbin = _dec2bin(ASC(cstreng))
chex = _bin2hex(cbin)
IF LEN(chex) = 1
chex = "0" + chex
ENDIF
creturnhex = chex + creturnhex
ENDFOR Y
*WAIT WINDOW "Serialno. "+cReturnHex
CLEAR DLLS
RETURN creturnhex
ENDFUNC
FUNCTION _dec2bin
* Function Dec2Bin
*
* Function to convert Decimal to BIN
*
LPARAMETERS nvalue
LOCAL nvalue, cbinstr, nrest
cbinstr = ""
DO WHILE .T.
nrest = MOD(nvalue,2)
nvalue = INT(nvalue/2)
cbinstr = STR(nrest,1) + cbinstr
IF nvalue = 0
EXIT
ENDIF
ENDDO
RETURN cbinstr
ENDFUNC
FUNCTION _bin2hex
* End of Function * Dec2Bin() *
* Function Bin2Hex
*
* Function to convert BIN to HEX
*
LPARAMETERS cbin
LOCAL nbinlen, nzerolen, chexvalue, nloopx, cbit, chex
nbinlen = LEN(cbin)
nzerolag = ROUND((nbinlen/4)+.49,0)*4 - nbinlen
cbin = REPLICATE("0",nzerolag)+cbin
chexvalue = ""
FOR nloopx = 1 TO LEN(cbin) STEP 4
cbit = SUBSTR(cbin,nloopx,4)
DO CASE
CASE cbit = "0000"
chex = "0"
CASE cbit = "0001"
chex = "1"
CASE cbit = "0010"
chex = "2"
CASE cbit = "0011"
chex = "3"
CASE cbit = "0100"
chex = "4"
CASE cbit = "0101"
chex = "5"
CASE cbit = "0110"
chex = "6"
CASE cbit = "0111"
chex = "7"
CASE cbit = "1000"
chex = "8"
CASE cbit = "1001"
chex = "9"
CASE cbit = "1010"
chex = "A"
CASE cbit = "1011"
chex = "B"
CASE cbit = "1100"
chex = "C"
CASE cbit = "1101"
chex = "D"
CASE cbit = "1110"
chex = "E"
CASE cbit = "1111"
chex = "F"
ENDCASE
chexvalue = chexvalue + chex
NEXT
RETURN chexvalue
ENDFUNC
suerte
