Using Win32 functions in Visual FoxPro Image Gallery
Code examples:
Pocket PC: custom RAPI class for operating with the Object Store Databases
Quering a waveform-audio input device
Reading security permissions for NTFS files and folders
Storing the environment strings in cursor
Using Font and Text functions
Downloading files from the FTP server using InternetReadFile
How to enable the SE_SHUTDOWN_NAME privilege for the application
Mapping and disconnecting network drives
Placing a button on the VFP form as a new child window
Reading and setting explicit Application User Model ID for the current process (Win7)
Retrieving list of available disk drives
Start an executable from VFP application by using the CreateProcess
Converting Unicode data from the Clipboard to a character string using a given code page
How to disable the Windows Clipboard (VFP9)
How to enumerate logon sessions on local computer
How to remove a directory that is not empty
Pocket PC: base class
Generating random cryptographic keys
How to browse and connect to printers on a network (WinNT)
Reading list of folders and files on FTP server
Simple Window Viewer
Using Change Notification Objects to monitor changes to the printer or print server
How to start the screen saver and how to find whether the screen saver is active
Form Magnifier
Pocket PC: custom RAPI class for operating with the Object Store Databases

User rating: 0/10 (0 votes)
Rate this code sample:
  • ~
More code examples    Listed functions    Add comment     W32 Constants      Translate this page Printer friendly version of this code sample
Before you begin:
The object store is the permanently mounted RAM-based storage area that contains the built-in file system, the system registry, and property databases.

This class is subclassed from the base RAPI class. Some members of it are implemented through collections. That unfortunately makes it unusable under Visual FoxPro versions 6 and older.

Solutions based on this class:
  • enumerating mounted database volumes and databases in the Object Store
  • reading the Contacts Database
  • creating new database and adding records to it
  •  
    ****************************************************
    * Pocket PC: custom RAPI class for operating
    * with the Object Store Databases
    ****************************************************
    DEFINE CLASS TrapiDb As Trapi
    #DEFINE INVALID_HANDLE_VALUE -1
    #DEFINE CEDB_ALLOWREALLOC     1
    #DEFINE CEPROPVAL_SIZE        16
    #DEFINE CEDB_PROPDELETE   0x0200
    #DEFINE CEDB_SEEK_CEOID     1
    #DEFINE CEDB_SEEK_BEGINNING 2
    #DEFINE CEDB_SEEK_END       4
    #DEFINE CEDB_SEEK_CURRENT   8
    #DEFINE CeVT_I2       2
    #DEFINE CeVT_I4       3
    #DEFINE CeVT_UI2      18
    #DEFINE CeVT_UI4      19
    #DEFINE CeVT_LPWSTR   31
    #DEFINE CeVT_FILETIME 64
    #DEFINE CeVT_BLOB     65
     
        databases=0
        dbvolumes=0
     
    PROCEDURE Init
        DODEFAULT()
        THIS.dbvolumes = CREATEOBJECT("RapiDBVolumes")
        THIS.databases = CREATEOBJECT("RapiDatabases")
     
    PROCEDURE decl
        DODEFAULT()
        DECLARE INTEGER CeDeleteDatabase IN rapi INTEGER oidDbase
     
        DECLARE INTEGER CeFindFirstDatabaseEx IN rapi;
            STRING @pceguid, INTEGER dwDbaseType
     
        DECLARE INTEGER CeFindNextDatabaseEx IN rapi;
            INTEGER hEnum, STRING @pceguid
     
        DECLARE INTEGER CeEnumDBVolumes IN rapi;
            STRING @pceguid, STRING @lpBuf, INTEGER dwNumChars
     
        DECLARE INTEGER CeOpenDatabase IN rapi;
            INTEGER @poid, STRING lpszName, INTEGER propid,;
            INTEGER dwFlags, INTEGER hwndNotify
     
        DECLARE INTEGER CeSeekDatabase IN rapi;
            INTEGER hDatabase, INTEGER dwSeekType,;
            INTEGER dwValue, INTEGER @lpdwIndex
     
        DECLARE INTEGER CeReadRecordProps IN rapi;
            INTEGER hDbase, INTEGER dwFlags, INTEGER @lpcPropID,;
            INTEGER rgPropID, INTEGER @lplpBuffer, INTEGER @lpcbBuffer
     
        DECLARE INTEGER CeOidGetInfoEx IN rapi;
            STRING @pceguid, INTEGER oid, STRING @poidInfo
     
        DECLARE INTEGER CeWriteRecordProps IN rapi;
            INTEGER hDbase, INTEGER oidRecord,;
            SHORT cPropID, INTEGER rgPropVal 
     
        DECLARE INTEGER CeDeleteRecord IN rapi;
            INTEGER hDatabase, INTEGER oidRecord
     
        DECLARE INTEGER CeCreateDatabase IN rapi;
            STRING lpszName, INTEGER dwDbaseType,;
            SHORT wNumSortOrder, INTEGER rgSortSpecs
    ENDDEFINE
     
    DEFINE CLASS RapiDatabases As Collection
        errorcode=0
     
    PROCEDURE Init
        THIS.EnumDatabases
     
    FUNCTION DatabaseExists(cDbname) As Boolean
        LOCAL oDb As RapiDatabase
        oDb = THIS.GetDatabase(cDbname)
        THIS.errorcode=0
    RETURN (oDb.oid <> 0)
     
    FUNCTION GetDatabase(vDatabase) As RapiDatabase
        LOCAL oDb As RapiDatabase
        TRY
            oDb = THIS.Item(m.vDatabase)
            THIS.errorcode=0
        CATCH
            oDb = CREATEOBJECT("RapiDatabase")
            THIS.errorcode=-1
        ENDTRY
    RETURN oDb
     
    FUNCTION CreateDatabase(cDbname) As Boolean
        LOCAL nOid
        nOid = CeCreateDatabase(ToUnicode(m.cDbname), 0,0,0)
        IF nOid = 0
            THIS.errorcode = CeGetLastError()
            RETURN .F.
        ELSE
            RETURN THIS.AddToCollection(m.nOid)
        ENDIF
     
    FUNCTION DeleteDatabase(vDatabase) As Boolean
        LOCAL oDb As RapiDatabase
        oDb = THIS.GetDatabase(vDatabase)
        IF THIS.errorcode <> 0
            RETURN .F.
        ENDIF
        IF CeDeleteDatabase(oDb.oid) = 0
            THIS.errorcode = CeGetLastError()
            RETURN .F.
        ELSE
            THIS.Remove(oDb.dbname)  && remove from collection
        ENDIF
    RETURN .T.
     
    PROTECTED PROCEDURE EnumDatabases
        LOCAL pceguid, hEnum, nOid, cBuffer
        pceguid=REPLICATE(CHR(0), 16)
        hEnum = CeFindFirstDatabaseEx(@pceguid, 0)
     
        DO WHILE .T.
            nOid = CeFindNextDatabaseEx(hEnum, @pceguid)
            IF nOid = 0
                EXIT
            ENDIF
            THIS.AddToCollection(nOid, pceguid)
        ENDDO
        = CeCloseHandle(hEnum)
     
    PROTECTED PROCEDURE AddToCollection(nOid, pceguid)
        LOCAL cBuffer, oDb
        cBuffer = REPLICATE(CHR(0), 2048)
        IF VARTYPE(pceguid) <> "C"
            pceguid = REPLICATE(CHR(0), 16)
        ENDIF
     
        IF CeOidGetInfoEx(@pceguid, nOid, @cBuffer)<>0
            oDb = CREATEOBJECT("RapiDatabase", m.nOid)
            THIS.Add(oDb, oDb.dbname)
            RELEASE oDb
        ELSE
            THIS.errorcode = CeGetLastError()
            RETURN .F.
        ENDIF
    ENDDEFINE
     
    DEFINE CLASS RapiDatabase As Custom
        errorcode=0
        props=0
        dbflags=0
        dbname=""
        dbtype=0
        dbreccount=0
        dbsortcount=0
        dbbytesize=0
        hdatabase=INVALID_HANDLE_VALUE
        activeorder=0
        oid=0
        recordoid=0
     
    PROCEDURE Init(nOid)
        IF VARTYPE(m.nOid)="N"
            THIS.oid=m.nOid
        ENDIF
        THIS.ReadHeader
        THIS.props = CREATEOBJECT("RecProperties")
     
    PROCEDURE ReadHeader  && refreshes header data
        LOCAL cBuffer, pceguid, cDbname
        cBuffer = REPLICATE(CHR(0), 2048)
        pceguid = REPLICATE(CHR(0), 16)
     
        WITH THIS
            IF CeOidGetInfoEx(@pceguid, THIS.oid, @cBuffer)<>0
                cDbname = SUBSTR(cBuffer, 9,64)
                .dbname = STRCONV(SUBSTR(cDbname, 1,;
                    AT(CHR(0)+CHR(0),m.cDbname)), 6)
                .dbflags = buf2dword(SUBSTR(cBuffer, 5,64))
                .dbtype = buf2dword(SUBSTR(cBuffer, 73, 4))
                .dbreccount = buf2word(SUBSTR(cBuffer, 77, 2))
                .dbsortcount = buf2word(SUBSTR(cBuffer, 79, 2))
                .dbbytesize = buf2dword(SUBSTR(cBuffer, 81, 4))
            ELSE
                STORE 0 TO .dbflags, .dbtype, .dbreccount,;
                .dbsortcount, .dbbytesize
                .errorcode = CeGetLastError()
                RETURN .F.
            ENDIF
        ENDWITH
     
    PROCEDURE Destroy
        THIS.CloseDatabase
        THIS.props.ClearObject
     
    PROCEDURE OpenDatabase(nOrder)
        THIS.CloseDatabase
        THIS.errorcode = 0
     
        LOCAL nOid
        nOid = THIS.oid
        THIS.hdatabase = CeOpenDatabase(@nOid, "", 0,0,0)
     
        IF THIS.hdatabase = INVALID_HANDLE_VALUE
            THIS.errorcode = CeGetLastError()
        ELSE
            THIS.ReadHeader
            IF VARTYPE(m.nOrder)="N"
                THIS.activeorder=m.nOrder
            ENDIF
            THIS.gotop
        ENDIF
    RETURN (THIS.hdatabase <> INVALID_HANDLE_VALUE)
     
    PROCEDURE skip(nOffset)
    RETURN THIS.SeekDatabase(m.nOffset, CEDB_SEEK_CURRENT)
     
    PROCEDURE gotop
    RETURN THIS.SeekDatabase(0, CEDB_SEEK_BEGINNING)
     
    PROCEDURE gobottom
    RETURN THIS.SeekDatabase(0, CEDB_SEEK_END)
     
    PROCEDURE goto(nPosition)
    RETURN THIS.SeekDatabase(m.nPosition, CEDB_SEEK_BEGINNING)
     
    PROCEDURE SeekOid(nOid)
        LOCAL nResult
        nResult = THIS.SeekDatabase(m.nOid, CEDB_SEEK_CEOID)
    RETURN (m.nResult = m.nOid)
     
    PROCEDURE SeekDatabase(nSeekValue, nSeekType, nOrder)
        THIS.errorcode = 0
     
        IF THIS.hdatabase=INVALID_HANDLE_VALUE
            RETURN .F.
        ENDIF
        IF VARTYPE(nOrder) = "N"
            nOrder=THIS.activeorder
        ENDIF
     
        THIS.recordoid = CeSeekDatabase(THIS.hDatabase,;
            nSeekType, nSeekValue, @nOrder)
     
        IF THIS.recordoid = 0
            THIS.errorcode = CeGetLastError()
        ELSE
            THIS.activeorder=m.nOrder
            THIS.props.FillProperties(THIS.hdatabase)
        ENDIF
    RETURN THIS.recordoid
     
    FUNCTION WriteProp(nOid, oProp) As Long
        nOid = CeWriteRecordProps(THIS.hdatabase, m.nOid,;
            1, oProp.LockProperty())
        IF nOid = 0
            THIS.errorcode = CeGetLastError()
        ELSE
            THIS.errorcode = 0
        ENDIF
    RETURN m.nOid
     
    FUNCTION DeleteRecord(nOid)
        IF VARTYPE(m.nOid) <> "N"
            nOid = THIS.recordoid  && current record
        ELSE
            IF NOT THIS.SeekOid(m.nOid)
                RETURN .F.
            ENDIF
        ENDIF
        IF nOid=0 OR THIS.hdatabase=0
            RETURN .F.
        ENDIF
     
        IF CeDeleteRecord(THIS.hdatabase, m.nOid) = 0
            THIS.errorcode = CeGetLastError()
            RETURN .F.
        ELSE
            THIS.ReadHeader
        ENDIF
     
    PROCEDURE CloseDatabase
        IF THIS.hdatabase <> 0
            = CeCloseHandle(THIS.hdatabase)
            THIS.hdatabase=INVALID_HANDLE_VALUE
        ENDIF
    ENDDEFINE
     
    DEFINE CLASS RecProperty As Custom
        proptype=0
        propid=0
        proplen=0
        propflags=0
        propvalue=""
        hLock=0
     
    PROCEDURE Destroy
        THIS.UnlockProperty
     
    FUNCTION UnlockProperty
        IF THIS.hLock <> 0
            = LocalFree(THIS.hLock)
            THIS.hLock=0
        ENDIF
     
    FUNCTION LockProperty As Integer
        THIS.UnlockProperty
     
        LOCAL cBuffer, nBufsize
        WITH THIS
            nBufsize = 20 + .proplen
            .hLock = LocalAlloc(0, nBufsize)
     
            cBuffer = num2word(.proptype) + num2word(.propid) +;
                num2word(.proplen) + num2word(.propflags)  && 8 bytes
     
            DO CASE
            CASE .proptype=CeVT_BLOB
                cBuffer = cBuffer + num2dword(.proplen) +;
                    num2dword(.hLock+16) + .propvalue
            CASE .proptype=CeVT_LPWSTR
                cBuffer = cBuffer + num2dword(.hLock+12) +;
                    .propvalue + CHR(0) + CHR(0)
            OTHERWISE
                cBuffer = cBuffer + .propvalue
            ENDCASE
            = StrToMem(.hLock, @cBuffer, LEN(m.cBuffer))
        ENDWITH
    RETURN THIS.hLock
    ENDDEFINE
     
    DEFINE CLASS RecProperties As Collection
    PROCEDURE ClearObject
        DO WHILE THIS.Count > 0
            THIS.Remove(1)
        ENDDO
     
    FUNCTION GetValue(propid, vDefault)
        LOCAL vResult
        TRY
            vResult = THIS.Item(propid).propvalue
        CATCH
            vResult = vDefault
        ENDTRY
    RETURN vResult
     
    PROCEDURE FillProperties(hDatabase)
        LOCAL nPropCount, hBuffer, nBufsize, cBuffer,;
            nIndex, cPropbuf, vValue, ch, hPtr, nBlobsize
        STORE 0 TO nPropCount, hBuffer, nBufsize
     
        THIS.ClearObject
        IF CeReadRecordProps(m.hDatabase, CEDB_ALLOWREALLOC,;
            @nPropCount, 0, @hBuffer, @nBufsize)=0
            RETURN .F.
        ENDIF
     
        cBuffer = REPLICATE(CHR(0), nBufsize)
        = MemToStr(@cBuffer, hBuffer, nBufsize)
     
        FOR nIndex=1 TO nPropCount
            cPropbuf = SUBSTR(cBuffer,;
                (nIndex-1)*CEPROPVAL_SIZE+1, CEPROPVAL_SIZE)
     
            LOCAL oProperty
            oProperty = CREATEOBJECT("RecProperty")
            WITH oProperty
                .proptype = buf2word(SUBSTR(cPropbuf, 1,2))
                .propid = buf2word(SUBSTR(cPropbuf, 3,2))
                .propflags = buf2word(SUBSTR(cPropbuf, 7,2))
     
                DO CASE
                CASE INLIST(.proptype, CeVT_I2, CeVT_UI2)
                    .propvalue = SUBSTR(cPropbuf, 9,2)
                CASE INLIST(.proptype, CeVT_I4, CeVT_UI4)
                    .propvalue = SUBSTR(cPropbuf, 9,4)
                CASE .proptype=CeVT_FILETIME
                    .propvalue = SUBSTR(cPropbuf, 9,8)
                CASE .proptype=CeVT_BLOB
                    nBlobsize = buf2dword(SUBSTR(cPropbuf, 9,4))
                    hPtr = buf2dword(SUBSTR(cPropbuf, 13,4))-hBuffer+1
                    .propvalue = SUBSTR(cBuffer, hPtr, m.nBlobsize)
                CASE .proptype=CeVT_LPWSTR
                    hPtr = buf2dword(SUBSTR(cPropbuf, 9,4))-hBuffer+1
                    vValue = ""
                    DO WHILE .T.
                        ch = SUBSTR(cBuffer, hPtr, 2)
                        IF ch = CHR(0)+CHR(0) OR hPtr >= LEN(cBuffer)
                            EXIT
                        ENDIF
                        vValue = vValue + SUBSTR(cBuffer, hPtr, 2)
                        hPtr = hPtr + 2
                    ENDDO
                    .propvalue = m.vValue
                ENDCASE
                .proplen = LEN(.propvalue)
            ENDWITH
            THIS.Add(oProperty, LTRIM(STR(oProperty.propid)))  && key?
            RELEASE oProperty
        ENDFOR
        = LocalFree(hBuffer)
    ENDDEFINE
     
    DEFINE CLASS RapiDBVolumes As Collection
    PROCEDURE Init
        THIS.EnumVolumes
     
    PROTECTED PROCEDURE EnumVolumes
        LOCAL pceguid, nBufsize, cBuffer
        pceguid=REPLICATE(CHR(255), 16)
        nBufsize=64
     
        DO WHILE .T.
            cBuffer = REPLICATE(CHR(0), nBufsize*2)
            IF CeEnumDBVolumes(@pceguid, @cBuffer, nBufsize)=0
                EXIT
            ENDIF
     
            LOCAL oVolume
            oVolume = CREATEOBJECT("RapiDBVolume", pceguid)
            oVolume.volumename = STRCONV(SUBSTR(cBuffer, 1,;
                AT(CHR(0)+CHR(0),cBuffer)+1), 6)
            THIS.Add(oVolume, oVolume.volumename)
            RELEASE oVolume
        ENDDO
    ENDDEFINE
     
    DEFINE CLASS RapiDBVolume As Custom
        volumename=""
        guid=""
    PROCEDURE Init(cGuid)
        THIS.guid = m.cGuid
    ENDDEFINE
     
     
     

    User rating: 0/10 (0 votes)
    Rate this code sample:
    • ~
    10624 bytes  
    Created: 2004-06-29 10:28:19  
    Modified: 2011-12-10 09:20:22  
    Visits in 7 days: 125  
    Listed functions:
    CeCreateDatabase
    CeDeleteDatabase
    CeDeleteRecord
    CeEnumDBVolumes
    CeFindFirstDatabaseEx
    CeFindNextDatabaseEx
    CeOidGetInfoEx
    CeOpenDatabase
    CeReadRecordProps
    CeSeekDatabase
    CeWriteRecordProps
    Printer friendly API declarations
    My comment:
    MSDN:"Databases provide storage, access, and sorting of property-set records.

    The Windows CE database model is that of a small, flat structure, optimized for small, efficient storage. As such, the Windows CE database APIs do not correspond to the Win32 database APIs.

    Data operations are transactioned within the object store or a database volume, which protects against data loss. If a Windows CE–based device loses power (reset or suspend/resume, where the RAM is refreshed) during a data transaction, Windows CE reverts all partial database operations to the last known good state. "


    Read complete topic Microsoft Windows CE Databases at the MSDN web site.

    #kwd: sln_pocketpc.
    Word Index links for this example:
    Translate this page:
      Spanish    Portuguese    German    French    Italian  
    FreeTranslation.com offers instant, free translations of text or web pages.
    User Contributed Notes:
    146.145.45.227 | 2005-09-11 16:30:42
    Does not work with vfp7.
    Uses Try/Catch code
    GDIPlus.Prg uses vfp8 Createobject("collection") which is unsupported in vfp7.

    Copyright © 2001-2017 News2News, Inc. Before reproducing or distributing any data from this site please ask for an approval from its owner. Unless otherwise specified, this page is for your personal and non-commercial use. The information on this page is presented AS IS, meaning that you may use it at your own risk. Microsoft Visual FoxPro and Windows are trade marks of Microsoft Corp. All other trademarks are the property of their respective owners. 

    Privacy policy
    Credits: PHP (4.4.9), an HTML-embedded scripting language, MySQL (5.6.38), the Open Source standard SQL database, AceHTML Freeware Version 4, freeware HTML Editor of choice.   Hosted by Korax Online Inc.
    Last Topics Visited (54.198.2.110)
    32 sec.Function: 'getnameinfo'
    Function group: 'Windows Sockets 2 (Winsock)'
    46 sec.Function: 'WSAWaitForMultipleEvents'
    Function group: 'Windows Sockets 2 (Winsock)'
    58 sec.Function: 'SQLFetch'
    Function group: 'ODBC API'
    1.25 min.Function: 'waveInGetNumDevs'
    Function group: 'Windows Multimedia'
    1.65 min.Function: 'FreeLibrary'
    1.83 min.
    Function group: 'Filled Shape'
    2 min.Function: 'GetTextMetrics'
    Function group: 'Font and Text'
    2.2 min.Function: 'SQLConnect'
    Function group: 'ODBC API'
    2.42 min.
    Function group: 'Color'
    2.6 min.
    Function group: 'Icon'
    Google
    Advertise here!