Using Win32 functions in Visual FoxPro Image Gallery
Code examples:
How to disable the Windows Clipboard (VFP9)
Testing if a connection to an Url can be established
Using FtpCommand
Using the FindMediaType function
How to register custom Event Log source
Monitoring changes occurring within a directory
Using the ChooseColor function
Enumerating the subkeys of a user-specific key
Extensible Storage Engine class library
How to display Windows On-Screen Keyboard
Obtaining information about all user accounts on a server (WinNT only)
Using Extended MessageBox() Class
Displaying hypertext links with the SysLink control (VFP9, Comctl32.dll)
Retrieving information about all users currently logged on to the workstation (WinNT only)
Adding and deleting User Accounts
Retrieving the name and type of all available RAS-capable devices
String representation for disk or memory capacity
Accessing Windows Control Panel from VFP Application
Adding a background image to VFP report (VFP9, ReportListener)
Form Magnifier
How to create non-blocking Winsock server
Obtaining Shell32.dll version
Retrieving size of a remote file
Using the RestartDialog function -- restarting Windows
Compressing and decompressing files with Windows API Runtime Library routines

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
Versions:
click to open
Before you begin:
LZNT1Compression class in the code sample below implements compression and decompression of strings and files. It provides a moderate level of compression.

The class is built on several functions from Windows API Runtime library. Tested and found operational under VFP9 SP2 on Windows XP and on Windows 7.
 
LOCAL oCompression As LZNT1Compression
oCompression = CREATEOBJECT("LZNT1Compression")
 
LOCAL cSourceFile, cCompressedFile, cRestoredFile
 
* Set cSourceFile to a valid path.
* Test on a smaller file first.
cSourceFile = "c:\temp\somefile.txt"
 
cCompressedFile = JUSTPATH(cSourceFile) + "\" +;
    STRTRAN(JUSTFNAME(cSourceFile), ".", "_") +;
    ".cmp"
 
cRestoredFile = JUSTPATH(cSourceFile) + "\" +;
    JUSTSTEM(cSourceFile) + "_restored." +;
    JUSTEXT(m.cSourceFile)
 
? "Source file:", cSourceFile
? "Compressed file:", cCompressedFile
? "Restored file:", cRestoredFile
 
IF oCompression.CompressFile(cSourceFile,;
    cCompressedFile)
 
    ? oCompression.DecompressFile(cCompressedFile,;
        cRestoredFile)
ENDIF
* end of main
 
DEFINE CLASS LZNT1Compression As Custom
 
#DEFINE COMPRESSION_FORMAT_LZNT1 2
#DEFINE COMPRESSION_ENGINE_STANDARD 0
#DEFINE COMPRESSION_ENGINE_MAXIMUM 0x0100
#DEFINE UNCOMPRESSED_CHUNK_SIZE 4096  && system default
 
#DEFINE STATUS_SUCCESS 0
#DEFINE STATUS_BUFFER_ALL_ZEROS        0x00000117
#DEFINE STATUS_INVALID_PARAMETER       0xc000000d
#DEFINE STATUS_UNSUPPORTED_COMPRESSION 0xc000025f
#DEFINE STATUS_NOT_SUPPORTED           0xc00000bb
#DEFINE STATUS_BUFFER_TOO_SMALL        0xc0000023
#DEFINE STATUS_BAD_COMPRESSION_BUFFER  0xc0000242
* error code = 35 -- 0x23
 
PROTECTED WorkSpaceCompress, WorkSpaceDecompress,;
    CompressionFormat, CompressionEngine
 
    WorkSpaceCompress = 0x8000
    WorkSpaceDecompress = 0x1000
    CompressionFormat = COMPRESSION_FORMAT_LZNT1
 
    * choose either STANDARD or MAXIMUM
    * lesser time vs. better compression
    CompressionEngine = COMPRESSION_ENGINE_STANDARD && _MAXIMUM
 
PROCEDURE Init
    WITH THIS
        .declare
        .ReadInternalSettings
    ENDWITH
 
FUNCTION CompressFile(cOriginalFile As String,;
    cCompressedFile As String) As Boolean
 
    LOCAL cSourceBuffer, cTargetBuffer,;
        ex As Exception, lResult
 
    TRY
        lResult = .F.
        cSourceBuffer = FILETOSTR(m.cOriginalFile)
 
        IF LEN(m.cSourceBuffer) > 0
            cTargetBuffer = ""
 
            IF THIS.CompressString(@cSourceBuffer,;
                @cTargetBuffer) > 0
 
                STRTOFILE(cTargetBuffer, m.cCompressedFile)
                lResult = .T.
            ENDIF
        ENDIF
 
    CATCH TO ex
        = MESSAGEBOX(TRANSFORM(ex.ErrorNo) + ". " +;
            ex.Message, 48, "Compression Error!")
    ENDTRY
RETURN m.lResult
 
FUNCTION DecompressFile(cCompressedFile As String,;
    cDecompressedFile As String) As Boolean
 
    LOCAL cSourceBuffer, cTargetBuffer,;
        ex As Exception, lResult
 
    TRY
        lResult = .F.
        cSourceBuffer = FILETOSTR(m.cCompressedFile)
 
        IF LEN(m.cSourceBuffer) > 0
            cTargetBuffer = ""
 
            IF THIS.DecompressString(@cSourceBuffer,;
                @cTargetBuffer) > 0
 
                STRTOFILE(cTargetBuffer, m.cDecompressedFile)
                lResult = .T.
            ENDIF
        ENDIF
 
    CATCH TO ex
        = MESSAGEBOX(TRANSFORM(ex.ErrorNo) + ". " +;
            ex.Message, 48, "Decompression Error!")
    ENDTRY
RETURN m.lResult
 
FUNCTION CompressString(cOriginalString As String,;
    cCompressedString As String) As Number
 
    LOCAL oInputBuffer As PChar, oOutputBuffer As PChar,;
        oWorkSpace As PChar, nCompressedSize,;
        nFinalCompressedSize, nStatus
 
    oInputBuffer = CREATEOBJECT("PChar", m.cOriginalString)
 
    oWorkSpace = CREATEOBJECT("PChar",;
        REPLICATE(CHR(0), THIS.WorkSpaceCompress))
 
    * as a precaution, set the size of the output buffer
    * some larger than the original string
 
    nCompressedSize = MAX(4096, LEN(m.cOriginalString) * 1.3)
 
    DO WHILE .T.
 
        nFinalCompressedSize = 0
 
        oOutputBuffer = CREATEOBJECT("PChar",;
            REPLICATE(CHR(0), m.nCompressedSize))
 
        nStatus = RtlCompressBuffer(;
            BITOR(THIS.CompressionFormat, THIS.CompressionEngine),;
            oInputBuffer.GetAddr(),;
            oInputBuffer.GetAllocSize(),;
            oOutputBuffer.GetAddr(),;
            oOutputBuffer.GetAllocSize(),;
            UNCOMPRESSED_CHUNK_SIZE,;
            @nFinalCompressedSize,;
            oWorkSpace.GetAddr();
            ) 
 
        DO CASE
        CASE m.nStatus = STATUS_SUCCESS
            EXIT
 
        CASE BITAND(m.nStatus, 0xffff) =;
            BITAND(STATUS_BUFFER_TOO_SMALL, 0xffff)
 
        * This may happen with a file to be compressed
        * being already in compressed format (JPEG, PDF, ZIP).
        * Increase buffer size and loop.
            oOutputBuffer = NULL
            nCompressedSize = nCompressedSize +;
                LEN(m.cOriginalString)
 
        OTHERWISE
            = MESSAGEBOX("API error code: " +;
                TRANSFORM(m.nStatus), 48,;
                "Compression Error!")
 
            cCompressedString = ""
            RETURN 0
 
        ENDCASE
    ENDDO
 
    cCompressedString = SUBSTR(oOutputBuffer.GetValue(),;
        1, nFinalCompressedSize)
 
RETURN nFinalCompressedSize
 
FUNCTION DecompressString(cCompressedString As String,;
    cDecompressedString As String) As Number
 
    LOCAL oUncompressedBuffer As PChar, oCompressedBuffer As PChar,;
        nUncompressedSize, nFinalUncompressedSize, nStatus
 
    oCompressedBuffer = CREATEOBJECT("PChar", m.cCompressedString)
 
    nUncompressedSize = LEN(m.cCompressedString) * 2
 
    DO WHILE .T.
        oUncompressedBuffer = CREATEOBJECT("PChar",;
            REPLICATE(CHR(0), nUncompressedSize))
 
        nFinalUncompressedSize = 0
 
        nStatus = RtlDecompressBuffer(;
            THIS.CompressionFormat,;
            oUncompressedBuffer.GetAddr(),;
            oUncompressedBuffer.GetAllocSize(),;
            oCompressedBuffer.GetAddr(),;
            oCompressedBuffer.GetAllocSize(),;
            @nFinalUncompressedSize;
            )
 
        DO CASE
        CASE nStatus = STATUS_SUCCESS
            EXIT
 
        CASE BITAND(nStatus, 0xffff) =;
            BITAND(STATUS_BAD_COMPRESSION_BUFFER, 0xffff)
 
        * if a larger buffer required
        * increase buffer size and loop
            oUncompressedBuffer = NULL
            nUncompressedSize = nUncompressedSize +;
                LEN(m.cCompressedString)
 
        OTHERWISE
            * some other error
 
            = MESSAGEBOX("API error code: " +;
                TRANSFORM(m.nStatus), 48,;
                "Decompression Error!")
 
            RETURN 0
 
        ENDCASE
    ENDDO
 
    cDecompressedString = SUBSTR(oUncompressedBuffer.GetValue(),;
        1, nFinalUncompressedSize)
 
RETURN m.nFinalUncompressedSize
 
PROTECTED FUNCTION ReadInternalSettings()
 
    LOCAL nFlag, nWorkSpaceCompress, nWorkSpaceDecompress
 
    WITH THIS
        nFlag = BITOR(.CompressionFormat, .CompressionEngine)
        STORE 0 TO nWorkSpaceCompress, nWorkSpaceDecompress
 
        IF RtlGetCompressionWorkSpaceSize( m.nFlag,;
            @nWorkSpaceCompress,;
            @nWorkSpaceDecompress ) <> STATUS_SUCCESS
 
            RETURN .F.
        ENDIF
 
        .WorkSpaceCompress = m.nWorkSpaceCompress
        .WorkSpaceDecompress = m.nWorkSpaceDecompress
    ENDWITH
 
PROTECTED PROCEDURE declare
    DECLARE INTEGER GetLastError IN kernel32
 
    DECLARE INTEGER RtlGetCompressionWorkSpaceSize IN ntdll;
        SHORT CompressionFormatAndEngine,;
        LONG @CompressBufferWorkSpaceSize,;
        LONG @CompressFragmentWorkSpaceSize
 
    DECLARE INTEGER RtlCompressBuffer IN ntdll;
        SHORT CompressionFormatAndEngine,;
        INTEGER UncompressedBuffer, LONG UncompressedBufferSize,;
        INTEGER CompressedBuffer, LONG CompressedBufferSize,;
        LONG UncompressedChunkSize,;
        LONG @FinalCompressedSize, INTEGER WorkSpace
 
    DECLARE INTEGER RtlDecompressBuffer IN ntdll;
        SHORT CompressionFormat,;
        INTEGER UncompressedBuffer, LONG UncompressedBufferSize,;
        INTEGER CompressedBuffer, LONG CompressedBufferSize,;
        LONG @FinalUncompressedSize
 
ENDDEFINE
 
DEFINE CLASS PChar As Session
PROTECTED hMem
 
PROCEDURE Init(cString As String)
    THIS.hMem = 0
    THIS.setValue(cString)
 
PROCEDURE Destroy
    THIS.ReleaseString
 
FUNCTION GetAddr
RETURN THIS.hMem
 
FUNCTION GetValue
    LOCAL nBufsize, cBuffer
    nBufsize = THIS.GetAllocSize()
    cBuffer = REPLICATE(CHR(0), m.nBufsize)
 
    IF THIS.hMem <> 0
        DECLARE RtlMoveMemory IN kernel32 As MemToStr;
            STRING @, INTEGER, INTEGER
        = MemToStr(@cBuffer, THIS.hMem, nBufsize)
    ENDIF
RETURN m.cBuffer
 
FUNCTION GetAllocSize
    DECLARE INTEGER GlobalSize IN kernel32 INTEGER hMem
RETURN Iif(THIS.hMem=0, 0, GlobalSize(THIS.hMem))
 
PROCEDURE SetValue(cString)
#DEFINE GMEM_FIXED 0
#DEFINE GMEM_MOVEABLE 2
#DEFINE GMEM_ZEROINIT 0x0040
 
    THIS.ReleaseString
 
    DECLARE INTEGER GlobalAlloc IN kernel32;
        INTEGER, INTEGER
 
    DECLARE RtlMoveMemory IN kernel32 As StrToMem;
        INTEGER, STRING @, INTEGER
 
    LOCAL nBufsize
    nBufsize = LEN(cString)
    THIS.hMem = GlobalAlloc(0x0040, nBufsize)
    IF THIS.hMem <> 0
        = StrToMem(THIS.hMem, @cString, nBufsize)
    ENDIF
 
PROCEDURE ReleaseString
    IF THIS.hMem <> 0
        DECLARE INTEGER GlobalFree IN kernel32 INTEGER
        = GlobalFree (THIS.hMem)
        THIS.hMem = 0
    ENDIF
 
ENDDEFINE
 

User rating: 0/10 (0 votes)
Rate this code sample:
  • ~
8445 bytes  
Created: 2010-08-12 18:40:45  
Modified: 2010-08-18 13:59:01  
Visits in 7 days: 116  
Listed functions:
GetLastError
GlobalAlloc
GlobalFree
GlobalSize
RtlCompressBuffer
RtlDecompressBuffer
RtlGetCompressionWorkSpaceSize
Printer friendly API declarations
My comment:
Pity, the output of this algorithm does not seem to be compatible with the one of the .NET DeflateStream Class. In other words, a file compressed with this VFP class cannot get decompressed by the .NET class, and vice versa.
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:
There are no notes on this subject.


Copyright © 2001-2013 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.1.55-log), the Open Source standard SQL database, AceHTML Freeware Version 4, freeware HTML Editor of choice.   Hosted by Korax Online Inc.
Last Topics Visited (23.22.212.158)
2.38 hrs.Example: 'HOWTO: Use the Win32 API to Access File Dates and Times'
 Function: 'SHEnumKeyEx'
 Example: 'List of addresses in the AutoDial mapping database'
9.26 hrs.Function: 'EnumProcessModules'
 Example: 'Testing if a connection to an Url can be established'
9.27 hrs.Example: 'Retrieving long values associated with the class of the VFP window'
11.07 hrs.Example: 'Using Multimedia Command Strings to play MIDI files'
 Example: 'Reading the structure of VFP main menu'
11.08 hrs.Example: 'Copying picture of the active form to the Clipboard using Enhanced Metafile API functions'
13.27 hrs.Solution: 'LanguageBar ActiveX Control'
Google
Advertise here!