>Hi, I need to add more secure to may aplication. How VFP send me, Hard Drive Serial Number.
>Thanks.
I think this does the trick. I had downloaded this from the web long back (most probably UT). Just copy this to any PRG file (say serialno.prg) and run the prg file. Returns the Serial No. Usage: lcSerial = serialno(). The serial no. is stored in variable lcSerial
HTH,
Alhad
LOCAL i
LOCAL lnDrvType
LOCAL lcDrive
LOCAL lnDrive
LOCAL lpRootPathName, ;
lpVolumeNameBuffer, ;
lpVolumeSerialNumber, ;
lpMaximumComponentLength, ;
lpFileSystemFlags, ;
lpFileSystemNameBuffer, ;
nVolumeNameSize, ;
nFileSystemNameSize
DECLARE INTEGER GetDriveType IN WIN32API ;
STRING lpRootPathName
DECLARE INTEGER GetLogicalDrives in win32api
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
#DEFINE DRIVE_NONE 0
#DEFINE DRIVE_BAD 1
#DEFINE DRIVE_REMOVABLE 2
#DEFINE DRIVE_FIXED 3
#DEFINE DRIVE_REMOTE 4
#DEFINE DRIVE_CDROM 5
#DEFINE DRIVE_RAMDISK 6
lnDrive = GetLogicalDrives()
lcDrive = CHR(ASC("A")+2)+":\"
lpVolumeNameBuffer = ""
lnDriveType = DRIVE_REMOVABLE
STORE SPACE(255) TO lpRootPathName, ;
lpVolumeNameBuffer, ;
lpVolumeSerialNumber, ;
lpMaximumComponentLength, ;
lpFileSystemFlags, ;
lpFileSystemNameBuffer
STORE 255 TO nVolumeNameSize, nFileSystemNameSize
= GetVolumeInformation(lcDrive, ;
@lpVolumeNameBuffer, ;
@nVolumeNameSize, ;
@lpVolumeSerialNumber, ;
@lpMaximumComponentLength, ;
@lpFileSystemFlags, ;
@lpFileSystemNameBuffer, ;
@nFileSystemNameSize )
lpVolumeNameBuffer = LEFT(lpVolumeNameBuffer, ;
AT(CHR(0),lpVolumeNameBuffer)-1)
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
RETURN cReturnHex
FUNCTION Bin2Hex
PARAMETERS cBin
PRIVATE 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
FUNCTION Dec2Bin
PARAMETERS nValue
PRIVATE 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
Only direct experience is Knowledge;
Everything else is just Information.