How to use UDF-DLL.DLL file with cmVodbx32


Copy this file into cmVodbx32 program folder

Then re-start the program, this file will be called automatically

regards

Jean Raymond
https://rayonline.com

USABLE FUNCTIONS WITH CMVODBX32 ( must all be in clipper convention)
FUNCTION _Bytes2Date( cBytes ) 
FUNCTION ATAD( dDate )
FUNCTION InsertUnderscore(cString)
FUNCTION ReadDBVFromPointer2Memo( cFieldFrom ,nArea) 
FUNCTION UnPack3Bytes2Date(   cFieldName , nArea) 
FUNCTION UnPackDate  ( lcDate ) 

PS: absolutely no guaranty whatsoever by using those function, it is on your own risk 

//-------------------------------------------------------------------------------------



FUNC dummy() //AS  LONGINT PASCAL
	//Do not delete this function, it is called by cmVodbx32 and Vodbx32 and
	//serves as initialization of the UDF-DLL.DLL file.
	//When initialized the program can see all UDF (User define function)
	// revision 2000/11/25, removed the [ as longint pascal ], see readme module
	RETURN  1L


TEXTBLOCK _Readme First

/*
This DLL show how to construct an external DLL with clipper functions.
Those functions can be used into differents expression like searching
replacing and indexing.

The trick here is to load the library on the start method and call a
dummy function. This will initialyze the DLL and all functions
can therefore be seen by the main program.
Example:

GLOBAL hUDFHandle as PTR

METHOD Start
    // other stuff
	IF File( ProgramPath+"UDF-DLL.DLL"  )
		hUDFHandle:=LoadLibrary(String2Psz("UDF-DLL.DLL"))
		IF hUDFHandle != NULL_PTR
			pEntry := GetProcAddress( hUDFHandle , String2Psz("dummy") )
			IF pEntry != NULL_PTR
					//initialyze the DLL if nResult = 1
					nResult := LONG( _CAST , PCALL( pEntry ) )
			ENDIF
		ENDIF
	ENDIF
// other stuff

METHOD OnClose(oEvent AS cEvent) AS LONGINT PASCAL CLASS cShellWindow  //For cmGUI library
METHOD Close(oCloseEvent) CLASS StandardShellWindow // for CAVO	

	//other stuff
	IF hUDFHandle != NULL_PTR
		FreeLibrary(hUDFHandle)
	ENDIF	
	//other stuff
//-----------------------------------------------------------------------------------------
Remember that the name of DLL has to be "UDF-DLL.DLL" since that is
hard coded into the main program. This DLL has also to be in the
program directory.

Also the Dummy() function cannot be changed since it is called by
the main program to initialyse the DLL.

You can create as many UDF functions as you want. As long they
are clipper style. See Example: function InsertUnderscore(cString)

Enjoy

Jean Raymond
Rayonline.com
https://www.rayonline.com
support@rayonline.com
2019/01/08

Revision on 2019/01/08

Changed function dummy()
From version 2.5b CAVO as changed some kind of behavior for DLL.
This cause the call for the function [ CollectForced() ] to crash into
the cavort20.dll file. Even if the PCALL states that is for PASCAL
calling convention, it works even if the function is clipper style.


*/


FUNC InsertUnderscore(cString)
	// Sample UDF
	// This function replace spaces by an underscore in a string
	
	LOCAL i AS DWORD //INT
	LOCAL sOut:="" AS STRING
	LOCAL sString AS STRING
	FOR i:=1 UPTO SLen(AllTrim(cString))
		  	sString:=SubStr(AllTrim(cString),i,1)
		  	IF sString = Space(1)
		  	 	sOut+= "_"
		  	ELSE
				sOut+=sString
			ENDIF
	NEXT i
	RETURN sOut	
 TEXTBLOCK __Readme.1st
/*
   This module is to convert 3 bytes 24 bits integer dates into a string date "yyyymmdd"  
   It is written in CAVO SP3 ( CA Visual Object )
   
   Thank from a guy named "Tony@osh" from Clipper news group.
   He found the following solution:
   
      //--------------------------------------
   	So, if you imagine the packed date as 24 bits long binary number (simply convert 3 chars to number) then you may decode it using following formula (tested on a restricted set of dates):

		Bits 0 to 4 ... Day number
		Bits 5 to 9 ... Month number (bit 7 must be removed)
		Bits 10 to 22 ... Year number (bit 16 indicates "No day and/or? month in date" and must be removed, bit 15 must be cleared when bit 16 = 0)
		Bit 23 ... Ignored
		
		Example:
		The string "***" hexadecimal value: BBC880, decimal value 12306560, 
		binary value:
		101110111100100010000000
		means: Year 1906, Month 0, Day 0
      //--------------------------------------
      
      He was correct in his solution for converting those 3 bytes dates
      
      However I cannot use his function UnPackDate( lcDate ), since I am using
      Windows 7 64 bits, and XP pro 32 bits.
      
      The automatic conversion from fieldget() function does not give the correct
      bytes, even with functions Ansi2Oem() or Oem2Ansi()
       
      This is why it was so difficult to resolve this problem
      
      The original clipper 16 bits database	 MUST NOT BE COPIED, since the above
      problem renders the 3 bytes invalid. Therefore if you use "Windows" , use the
      original DBF as READ ONLY. 
        
       Use OpenDeceased() function to export dates to delimited text file and change
       parameters of files and offsets with an hexa editor.
       
       Use   FUNCTION UnPack3Bytes2Date(   cFieldName , nArea)  with my program
       "cmVodbx32" at:
       https://rayonline.com/cmVodbx32.html       
       Those functions are in the User Define Functions (UDF) for cmVodbx32 at:
       http://www.rayonline.com/samples
       ( UDF-DLL.zip )
       
       Procedure to use  UnPack3Bytes2Date() with "cmVodbx32"  program
       
       1) 	Open the program
       2)		In the option section , set "SetSelectiverelation" OFF  
       2.5)	ALL INDEX OFF or _natural order
       3)   Open DBF1 ( ReadOnly )  in Area 1  ( A=1)
       4)   Copy DBF1 To DB2 
       5)		Open DBF2, from Menu-Utilities-Modify Structure
       6)		Change 3 bytes dates fields from  3 to 8 and save
       7)		Close ALL
       8)   Open DBF2 ( r-w, exclusive ) ( A=1 )  ,ALL INDEX OFF
       9) 	Open DBF1 ( ReadOnly )  ( A=2)   ,ALL INDEX OFF
       10)	Select DBF2 windows, press F9, choose a field, and set relation to DBF1
       			( when changing records in DBF2, the record in DBF1 also change )
       	11) Select DBF2 windows, press F6, Replace button, select first date field to change,
       			in "BY" dialog, insert the following function:
       			UnPack3Bytes2Date(   "cFieldName" , nArea)		 // cFieldName with quotes, nArea with 2 ( Area 2)
       	12) OK button, your done
       	13) Do the same steps 11-12 with all date fields to convert
       	
       	Regards
       	
Jean Raymond
https://www.rayonline.com
support@rayonline.com

*/
//--------------------------------------------------------------
STATIC DEFINE HexChar:= "0123456789ABCDEF" 

//--------------------------------------------------
FUNCTION OpenDeceased() 
//    THIS FUNCTION open the dbf with 3 bytes dates and 
//			export its content to  text delimited file.
// 		Then can be imported to and sql or any other type 
//			of database

//			Since Windows cannot render exact bytes, even if 
//			functions Ansi2Oem() or Oem2Ansi(). I must , then,
//      use raw reading into the DBF 

//			The 3 bytes dates are consecutive into the DBF 


	LOCAL pHandle AS PTR  , lPos , lnDate AS LONG
	LOCAL pBuffer ,pFile AS PTR   , lcDate , cBytes,cFinalDate  AS STRING 
   LOCAL dwCount AS DWORD
   
	pBuffer := MemAlloc(3)
 

	pHandle:= FOpen("C:\Deceased\Deceased.dbf",FO_DENYNONE        )  
	lPos:=	FSeek(pHandle,546,	FS_SET) // offset of first record datebirth at the position of 3 bytes date   
	pFile:=FCreate( "C:\Deceased\convertDeceased.txt", FC_NORMAL)
	
	FOR dwCount:=1 UPTO   37335  // number or records in the DBF
		  
					cFinalDate:=""   //reset the string to NULL_STRING
					FRead3(pHandle,pBuffer,3)  
					lcDate:=Mem2String( pBuffer,3)
					lnDate :=    LONG(Asc(SubStr(lcDate, 3, 1))) + 256 * LONG(Asc(SubStr(lcDate, 2, 1))) + 65536 * LONG(Asc(SubStr(lcDate, 1, 1))) 
					cBytes:=UDF_GetHexaAndBits( lnDate,FALSE) // get the date integer value in bits format   00000000101111101001110111111101   
					cFinalDate:='"'+_Bytes2Date(cBytes) +'",'     //datebirth in string format "yyyymmdd"
					
					FRead3(pHandle,pBuffer,3)  
					lcDate:=Mem2String( pBuffer,3)
					lnDate :=    LONG(Asc(SubStr(lcDate, 3, 1))) + 256 * LONG(Asc(SubStr(lcDate, 2, 1))) + 65536 * LONG(Asc(SubStr(lcDate, 1, 1))) 
					cBytes:=UDF_GetHexaAndBits( lnDate,FALSE)     
					cFinalDate+='"'+_Bytes2Date(cBytes) +'",'      //datedeath 
					 
					FRead3(pHandle,pBuffer,3)  
					lcDate:=Mem2String( pBuffer,3)
					lnDate :=    LONG(Asc(SubStr(lcDate, 3, 1))) + 256 * LONG(Asc(SubStr(lcDate, 2, 1))) + 65536 * LONG(Asc(SubStr(lcDate, 1, 1))) 
					cBytes:=UDF_GetHexaAndBits( lnDate,FALSE)     
					cFinalDate+='"'+_Bytes2Date(cBytes) +'"'+CRLF     //dateburial 
					
					FSeek( pHandle, 99,FS_RELATIVE) // the space need (99) to go to next record
					FWrite(pFile,cFinalDate)  
				
	NEXT dwCount
	
	FClose(pFile)
				
	MemFree(pBuffer)				                                                    
	FClose(pHandle)
	
	RETURN NIL
					
// 			cBytes2:=UDF_GetHexaAndBits( 0xBE9DFD,FALSE)      //1991-07-29 
// 				//00000000     1  0111110100111    01(1)11         11101 
// 				//                  1  011111000111   //bit 16 = 0 and must be removed, bit 15 must be cleared when bit 16 = 0         
// 		     //    discard          y= 1991                 m=7            d=29 


 
//----------------------------------------------------- 
  FUNCTION _Bytes2Date( cBytes )   
  
// Below the logic, which is correct.  
  
//-------------------------------------------------------------------
//How about THIS LOGIC..... attempt from a db guru from czec.   His name =  "Tony@osh" ????
//  
// So, IF you imagine the packed DATE AS 24 bits LONG binary number (simply convert 3 chars TO number) then you may decode it USING following formula (tested on a restricted set OF dates):

// Bits 0 TO 4 ... Day number
// Bits 5 TO 9 ... Month number (bit 7 must be removed)
// Bits 10 TO 22 ... Year number (bit 16 indicates "No day and/or? month in date" and must be removed, bit 15 must be cleared when bit 16 = 0)
// Bit 23 ... Ignored

// Example:
// The STRING "***" hexadecimal value: BBC880, decimal value 12306560, 
// binary value:
// 101110111100100010000000
// means: Year 1906, Month 0, Day 0
//-----------------------------------------------------------------------
  
  	LOCAL cValue,cDay,cMonth,cYear AS STRING 
   	
  				cValue:=cBytes 
  				// strip the first   9 of 32 
  				// 00000000     1  0111110100111    01(1)11         11101
  				cValue:=SubStr(cValue,10)
  	         // 0111110100111    01(1)11         11101 
  	         // IF bit 16=0, bit 15 must be cleared (0)
  	         IF SubStr(cValue,7,1) = "0"
  	         	cValue:=Stuff( cValue,8,1,"0")
  	         ENDIF
  	         //now we remove bits
  	         
  	         cValue:=Stuff(cValue, 16,1,"") //bit 16 must be removed 
  	         cValue:=Stuff(cValue, 7,1, "")  //bit 7 must be removed 
  	         //                      011101101011          1001        01010  
  	         //                             yyyy                  mm           dd
				//                            1387                    9            10
  	         cDay:=PadL(SubStr( cValue ,17),8,"0"  )
  	         cDay:=  PadL(Val("0b"+ cDay ),2,"0") // val of 0b01010
  	         cMonth:=PadL(SubStr( cValue ,13,4),8,"0"  ) 
  	         cMonth:= PadL(Val("0b"+ CMonth ),2,"0")  // val of 0b1001
  	         cYear:=PadL(SubStr( cValue ,1,12),16,"0"  ) 
  	         cYear:=  PadL(Val("0b"+ cYear ),4,"0")  //val of  0b011101101011
  	         
  	RETURN cYear+cMonth+cDay    
  	
  	
//---------------------------------------------------  	       
FUNCTION UnPack3Bytes2Date(   cFieldName , nArea)  
	//This function to be used with replace function into the "cmVodbx32" program
	// https://www.rayonline.com
	// IMPORTANT NOTE: -> cFieldName must be called with quotes -> Ex: "DateField"
	//														nArea is the area to read the 3 bytes dates as integer -> Ex: 2

	LOCAL lnDate AS LONG ,  dwPos , dwHeaderSize, dwRecSize,nOldArea,nFieldPosInRec, nPos AS DWORD
	LOCAL cBytes,cFinalDate,cBinDate  AS STRING   , ptrBuffer AS PTR    , nPosRec , nPosNow AS LONG
	LOCAL  pDBFHandle AS PTR   , aStruct AS ARRAY

 	   ptrBuffer:=MemAlloc(3)    
 	   nOldArea:=DbSelect(nArea) //select area to read 
 	   IF DbSelectArea  (nArea)  //be sure we work in selected area to read the 3 bytes dates
 	   		aStruct:= DbStruct()
		 	   pDBFHandle  :=    DbInfo( DBI_FILEHANDLE )
		 	   dwHeaderSize:=   DbInfo(DBI_GETHEADERSIZE) 
		 	  	dwRecSize:=   DbRecordInfo(DBRI_RECSIZE)
		 	  	   
		 	  	nPosRec:=(FSeek(pDBFHandle, dwHeaderSize, FS_SET ))// position record 1 
		 	  	IF RECNO() > 1
		 	  		nPosNow:=FSeek(pDBFHandle,nPosRec+(dwRecSize*(RECNO()-1)), FS_SET ) // first record =0  stay there, others add dwRecSize * recno 
		 	  	ENDIF	
	 	  	
		 	   dwPos:=FieldPos(AllTrim(cFieldName)) // position of field iinto 1 record
		 	   IF dwPos > 1  
			 	   FOR nPos:=1 UPTO dwPos -1 
			 	   	nFieldPosInRec+=aStruct[nPos][3] //field offset into  1 record
			 	   NEXT nPos
		 	   ELSE    //error, must exit
		 	   	MemFree(ptrBuffer)
		 			DbSelect(nOldArea) 
		 			RETURN "" //null_string
		 	   ENDIF
		 	   nPosNow:=FSeek(pDBFHandle, nFieldPosInRec +1, FS_RELATIVE )    // (+1)= delete byte  
		 	   FRead3(pDBFHandle,ptrBuffer,3)   //read 3 bytes date at raw level (no conversion here )
		 	   
		 		cBinDate:=  Mem2String(ptrBuffer,3)

				lnDate :=    LONG(Asc(SubStr(cBinDate, 3, 1))) + 256 * LONG(Asc(SubStr(cBinDate, 2, 1))) + 65536 * LONG(Asc(SubStr(cBinDate, 1, 1))) 
				cBytes:=UDF_GetHexaAndBits( lnDate,FALSE)     
				cFinalDate:=_Bytes2Date(cBytes)
				
				
 	   ENDIF  
 	   MemFree(ptrBuffer)
	 DbSelect(nOldArea)
	RETURN cFinalDate
		 
	
//----------------------------------------------------	
FUNCTION UnPackDate  ( lcDate )   

//attempt from a db guru from czec.

// Bits 0 TO 4 ... Day number
// Bits 5 TO 9 ... Month number (bit 7 must be removed)
// Bits 10 TO 22 ... Year number (bit 16 indicates "No day and/or? month in date" and must be removed, bit 15 must be cleared when bit 16 = 0)
// bit 23 ... Ignored

 
LOCAL lnDate ,  lnDay, lnMonth, lnYear   AS LONG

 
*-- Empty date 
IF lcDate = CHR(128) + CHR(128) + CHR(128) 
  RETURN "0000/00/00" 
ENDIF 
 
*-- Convert 3 chars to 24 bit number 
lnDate :=    LONG(Asc(SubStr(lcDate, 3, 1))) + 256 * LONG(Asc(SubStr(lcDate, 2, 1))) + 65536 * LONG(Asc(SubStr(lcDate, 1, 1))) 
 
 
IF SubStr(lcDate, 3, 1) = CHR(128) 
  *-- Day not defined 
  lnDay := 0 
ELSE 
  *-- Unpack day number 
  lnDay := lnDate % 32 
ENDIF 
 
//lnDate = BITRSHIFT(lnDate, 5)
lnDate:= lnDate >> 5

 
*-- Unpack month 
lnMonth := lnDate % 4 
//lnDate = BITRSHIFT(lnDate, 3)
lnDate:= lnDate >> 3

lnMonth := (lnMonth + 4) * (lnDate % 4) 
 
//lnDate = BITRSHIFT(lnDate, 2)
lnDate:= lnDate >> 2

 
*-- Adjust date when month is not defined 
//IF .NOT. BITTEST(lnDate, 6)
IF  (_AND(lnDate,( 2 ^ 6))) = 0
  //lnDate = BITCLEAR(lnDate, 5)
  lnDate:= _AND(lnDate,_NOT( 5^2)) 
				//   FUNCTION BitClear(ByVal value AS LONG, ByVal bit AS LONG) AS LONG
				//     ' simply AND with the negation of the bit mask
				//     ' Range checking is performed in Power2()
				//     BitClear = (value And Not Power2(bit))
				// END FUNCTION

ENDIF 
 
*-- Unpack year 
lnYear := lnDate % 64 
//lnDate := BITRSHIFT(lnDate, 7)     
lnDate:=lnDate >> 7  

lnYear := lnYear + 64 * (lnDate % 32) 
 
*-- Return string YYYY/MM/DD //Transform(lnYear, "@L 9999") + '/' + Transform(lnMonth, "@L 99") + '/' + Transform(lnDay, "@L 99")
RETURN    PadL( lnYear,4,"0")+PadL(lnMonth,2,"0")+PadL( lnDay, 2,"0")    


//--------------------------------------------------------                        
FUNCTION ReadDBVFromPointer2Memo( cFieldFrom ,nArea) 

	
	LOCAL liOffset,liLenght ,liCurrentPos  AS LONG    , ptrhandle AS PTR   
	LOCAL cpointer,cLenght,cData, cDBFFile,cDBVFile  AS STRING ,ptrBuffer AS PTR
	LOCAL cDrive, cDir, cFile, cExt AS STRING , dwPosFrom,nOldArea AS DWORD  
	LOCAL  IsDBFAnsi AS LOGIC
 	//SetAnsi(FALSE)   //OEM database
  	   nOldArea:=DbSelect(nArea) //select area to read 
   IF DbSelectArea  (nArea)  //be sure we work in selected area to read the 3 bytes dates
 		 cDBFFile:= DbInfo(DBI_FULLPATH)	 
 		 IsDBFAnsi:=DbInfo( DBI_ISANSI) 
       IF IsDBFAnsi
       	SetAnsi(FALSE)
       ENDIF
       MySplitPath(cDBFFile, @cDrive, @cDir, @cFile, @cExt) 
 		 cDBVFile:=  cDrive+cDir+cFile+".DBV"
 		 AltD()  
 	    ptrhandle:=FOpen2(cDBVFile,FO_READ)
 	    IF !(ptrhandle = NULL_PTR) .OR. (ptrhandle = F_ERROR)
		 	    cData:=NULL_STRING //reset the data   
		 	    dwPosFrom:=FieldPos(AllTrim(cFieldFrom)) // position of field into 1 record 
		 	    cpointer := FIELDGET(dwPosFrom)
		       liOffset:=DBVConvertPointer(cpointer)
		          
		       IF !Empty(cpointer) .AND. ( liOffset >= 0  .AND. liOffset <   FSeek(ptrhandle, 0,FS_END)  ) //valid pointer between 0 and EOF
						FSeek(ptrhandle, 0,FS_SET)  // reset the pointer to the beginning of the file
						FSeek(ptrhandle,  liOffset)  //go offset of dbv file 
						MemFree(ptrBuffer) //reset memory to prevent memory low error
						ptrBuffer:=MemAlloc(6) 
						FRead3(ptrhandle,ptrBuffer ,6)  // reading 6 bytes to get lenght of reading
						cLenght:= Mem2String(ptrBuffer,6) //get the raw string 
						liLenght:=  Bin2L(cLenght)  // get the longInterger value of the raw string (all the data to read) 
						liCurrentPos:=FTell(ptrhandle)
						IF (liLenght < FSeek(ptrhandle, 0,FS_END)) //.AND.  (FSeek(ptrhandle, 0,FS_END) - liCurrentPos) < liLenght 
						// be sure the reading does not exceed the EOF 
							 
							FSeek(ptrhandle,liCurrentPos) //return to previous position
							MemFree(ptrBuffer) //reset memory to prevent memory low error
							ptrBuffer:=MemAlloc(DWORD(liLenght)) //set the new buffer memory size
							FRead3(ptrhandle,ptrBuffer ,DWORD(liLenght))  // pointer has moved previously 6 bytes, from there read the DBV data
							cData:=  Mem2String(ptrBuffer,DWORD(liLenght))   //the DBV data into the cData var 
						ENDIF		
			ENDIF
 	    ELSE  
 	    		cData:=DosErrString(FError())	
				//FIELDPUT(dwPosTo,cData) // if no processing, the set an empty memo field ( or invalid ptrhandle from openning the DBV file )
 	    ENDIF  
   ENDIF    
 	    FClose(ptrhandle)
	    MemFree(ptrBuffer) 
	    SetAnsi( IsDBFAnsi) 
	    DbSelect(nOldArea)

	
	RETURN        cData
                      

//----------------------------
FUNCTION ATAD( dDate ) 
RETURN( Str( 100000000-Val( DToS( dDate ) ), 9, 0) )

