Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
I NEED Hard drive serial Number to secure my aplication
Message
From
01/09/2006 10:03:49
Alhad Marathe
Asm Consulting
Mumbai, India
 
 
To
31/08/2006 06:44:28
General information
Forum:
Visual FoxPro
Category:
Other
Miscellaneous
Thread ID:
01150087
Message ID:
01150364
Views:
33
>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
* 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

RETURN cReturnHex

* Function Bin2Hex
*
* Function to convert BIN to HEX
*
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

* End of Function * Bin2Hex() *


* Function Dec2Bin
*
* Function to convert Decimal to BIN
*
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

* End of Function * Dec2Bin() *
Only direct experience is Knowledge;
Everything else is just Information.
Previous
Reply
Map
View

Click here to load this message in the networking platform