Ejemplo [blowfish.prg] – Encriptar mensaje

2015-09-03_131543

 

PROCEDURE Main()

   LOCAL cText := "This is my secret message."
   LOCAL cKey := hb_blowfishKey( "Top Secret ;-)" )

   LOCAL cEncrypted

   ? "Original:", hb_StrToExp( cText )

   /* encrypt data */
   ? "Encrypted:", hb_StrToHex( cEncrypted := hb_blowfishEncrypt( cKey, cText ) )

   /* decrypt data */
   ? "Decrypted:", hb_StrToExp( hb_blowfishDecrypt( cKey, cEncrypted ) )

   RETURN

Ejemplo [array16.prg] – Array multidimensional

2015-09-02_120742

 

// Harbour multidimensional arrays support

PROCEDURE Main()

   LOCAL a := { 100, 200, "Third" }
   LOCAL b := Array( 8832 )

   ? ValType( a )
   ? ValType( { "A" } )

   AAdd( a, "new element" )
   ? Len( a )

   ? a[ 1 ]
   ? a[ 2 ]
   ? a[ 3 ]
   ? a[ 4 ]

   ? ATail( a )

   a[ 3 ] := { "this", { "seems", "to", { "work", "so", "well" } } }
   ? a[ 3 ][ 2 ][ 3 ][ 1 ] // "work"

   a[ 3, 2 ][ 3, 1 ] := "Harbour power!"  // different ways to specify the indexes
   ? a[ 3, 2, 3, 1 ]

   ? ValType( b )
   ? Len( b )

   b[ 8832 ] := "Harbour"

   ? b[ 8832 ]

   ? ATail( b )

   ASize( b, 200 )
   ? Len( b )

   b[ 100 ] := 10
   Test( b[ 100 ]++ )
   ? b[ 100 ]

   b[ 100 ] := 10
   Test( ++b[ 100 ] )
   ? b[ 100 ]

   b := { 1, { 2, { 4, 5 } } }
   Test( b[ 2 ][ 2 ][ 1 ]++ )
   ? b[ 2 ][ 2 ][ 1 ]

   b[ 2 ][ 2 ][ 1 ] := 2
   Test( ++b[ 2 ][ 2 ][ 1 ] )
   ? b[ 2 ][ 2 ][ 1 ]

   ReleaseTest()

   RETURN

STATIC PROCEDURE Test( n )

   ? n

   RETURN

STATIC PROCEDURE ReleaseTest()

   LOCAL a := { 1, 2, 3 }

   HB_SYMBOL_UNUSED( a )

   RETURN

Ejemplo [ains.prg] – Funciones para Arrays

2015-09-02_115458

 

//
// Array test AIns() / ADel() / ASize() / AFill()
//

#ifndef __HARBOUR__
#include "clipper.ch"
#endif

PROCEDURE Main()

   LOCAL aFirst
   LOCAL aSecond
   LOCAL aMore

   aFirst := AClone( { 1, 2, 4 } )
   AIns( aFirst, 3 )
   aFirst[ 3 ] := "3"
   ?? "Testing AIns() ... "
   ADump( aFirst )

   aSecond := { 1, 2, 4 }
   ASize( aSecond, 4 )
   ?? "Testing ASize() ... "
   ADump( aSecond )

   aSecond := { 1, 2, 4 }
   ASize( aSecond, 4 )
   AIns( aSecond, 3 )
   aSecond[ 3 ] := "3"
   ?? "Testing ASize() + AIns() ... "
   ADump( aSecond )

   aSecond := { 1, 2, 3, 3, 4, 5 }
   ADel( aSecond, 3 )
   ?? "Testing ADel() ... "
   ADump( aSecond )

   aSecond := { 1, 2, 3, 3, 4, 5 }
   ADel( aSecond, 3 )
   ASize( aSecond, Len( aSecond ) - 1 )
   ?? "Testing ASize() + ADel() ... "
   ADump( aSecond )

   AFill( aSecond, "!" )
   ?? "Testing AFill() ... "
   ADump( aSecond )

   aMore := { 1, 2, 3, 4, 5, 6 }
   AFill( aMore, "X", 3 )
   ?? "Testing AFill() with start ... "
   ADump( aMore )

   aMore := { 1, 2, 3, 4, 5, 6 }
   AFill( aMore, "X", 3, 2 )
   ?? "Testing AFill() with start and count ... "
   ADump( aMore )

   aMore := { { 1, 2 }, { 3, 4 } }
   ADel( aMore, 1 )
   ADump( aMore )

   RETURN

STATIC PROCEDURE ADump( aShow )

   LOCAL n

   ?? "Len=", hb_ntos( Len( aShow ) )
   ?? ": "
   FOR n := 1 TO Len( aShow )

      ?? "["
      ?? hb_ntos( n )
      ?? "]= "
      ?? ValType( aShow[ n ] )
      ?? ":"
      IF HB_ISARRAY( aShow[ n ] ) /* Iterate array */
         ?
         ?? "["
         ADump( aShow[ n ] )
         ?? "]"
      ELSE
         ?? iif( HB_ISNUMERIC( aShow[ n ] ), hb_ntos( aShow[ n ] ), aShow[ n ] )
      ENDIF

      IF n != Len( aShow )
         ?? ", "
      ENDIF

   NEXT
   ?

   RETURN

Ejemplo [achoice3.prg] – Selección

2015-09-01_112826

 

#ifndef __HARBOUR__
#include "clipper.ch"
#endif

#include "achoice.ch"
#include "inkey.ch"

/* TOFIX: Code below demonstrates an AChoice() difference between Harbour
          and Clipper it is called with the number of items in the array is
          less than number of rows determined by ( nBottom - nTop + 1 ),
          and a user function is specified for cUserFunction. In the attached
          example, a box is drawn around the area used by AChoice() to make
          it easier to see the difference in action. When cUserFunction is
          not specified, the bottom line of the box is not overwritten.
          In Clipper, the bottom line of the box is not overwritten, but
          in Harbour it is. */

MEMVAR m_aItems

PROCEDURE Main()

   LOCAL nResult

   PRIVATE m_aItems := { ;
      "Apple", ;
      "Blueberry", ;
      "Cashew", ;
      "Grape", ;
      "Hazelnut", ;
      "Jackfruit", ;
      "Kumquat", ;
      "Mulberry" }

   CLS
   @ 7, 25 TO 8 + Len( m_aItems ), 57
   IF ( nResult := AChoice( 8, 26, 8 + Len( m_aItems ), 55, m_aItems,, "HotChoice" ) ) > 0
      Alert( m_aItems[ nResult ] + " selected" )
   ENDIF

   RETURN

FUNCTION HotChoice( nStatus )  /* must be a public function */

   LOCAL nKey, cKey

   DO CASE
   CASE nStatus == AC_EXCEPT
      nKey := LastKey()
      cKey := Upper( hb_keyChar( nKey ) )
      DO CASE
      CASE AScan( m_aItems, {| c | Left( c, 1 ) == cKey } ) > 0
         hb_keyPut( K_ENTER )
         RETURN AC_GOTO
      CASE nKey == K_ENTER
         RETURN AC_SELECT
      CASE nKey == K_ESC
         RETURN AC_ABORT
      OTHERWISE
         ?? Chr( 7 )
      ENDCASE
   CASE nStatus == AC_NOITEM
      RETURN AC_ABORT
   ENDCASE

   RETURN AC_CONT

 

Ejemplo [achoice.prg] – Selección

 

2015-09-01_110829

 

// Released to Public Domain.

#include "achoice.ch"
#include "inkey.ch"

#ifndef __HARBOUR__
#include "clipper.ch"
#endif

PROCEDURE Main()

   LOCAL aPrompts := { ;
      "AGRI-PLANTS"                   , ;
      "ALAN R. SMITH GREENHOUSES"     , ;
      "ALLAN MURRAY NURSERY, INC."    , ;
      "APOPKA FOREST"                 , ;
      "LIGHT HOUSE NURSERIES"         , ;
      "BAUCOM'S"                      , ;
      "BAY HILL NURSERY, INC."        , ;
      "BAYWOOD NURSERIES"             , ;
      "BIG OAK NURSERY"               , ;
      "C & N NURSERY"                 , ;
      "CHARLES QUALITY PLANTS"        , ;
      "CONNELL FARMS"                 , ;
      "DEWAR NURSERIES, INC."         , ;
      "DIAMOND T NURSERY"             , ;
      "DISTINCTIVE PALMS NURSERIES"   , ;
      "DONKAY NURSERY"                , ;
      "DOUG INGRAM & SONS NURSERY"    , ;
      "DRIFTWOOD GARDENS, INC."       , ;
      "ELVA PLANT NURSERY, INC."      , ;
      "ERINON"                        , ;
      "EVANS NURSERY"                 , ;
      "FANCY PLANTS"                  , ;
      "FL.PLANT GROWERSCOOP"          , ;
      "FLORIDA CACTUS INC."           , ;
      "FLOWERING TREE GROWERS, INC."  , ;
      "FLOWERWOOD NURSERY"            , ;
      "FOLIAGE FACTORY TOO"           , ;
      "GATOR GROWERS NURSERY, INC."   , ;
      "GAZEBO LANDSCAPE DESIGN, INC." , ;
      "GEM ORNAMENTALS"               , ;
      "GRANNY'S GARDEN"               , ;
      "GRAY'S ORNAMENTALS"            , ;
      "GREEN MASTERS INC."            , ;
      "GREEN MEADOW NURSERY"          , ;
      "PIXLEY'S PLANT PLACE"          , ;
      "HARRISON'S NURSERY, INC."      , ;
      "G & G FOLIAGE"                 , ;
      "IVEY'S NURSERY, INC."          , ;
      "JB NURSERIES, INC."            , ;
      "JON'S NURSERY"                 , ;
      "JONES & JONES NURSERY, INC."   , ;
      "KAGER'S NURSERY"               , ;
      "KIRKLAND'S NURSERY"            , ;
      "LAND OF BROMELIADS"            , ;
      "LANDSCAPE NURSERY, INC."       , ;
      "LIEWALD'S NURSERY INC."        , ;
      "LLOYD & RINGS NURSERY"         , ;
      "LONG VAN DOUNG"                , ;
      "MAPEL'S LANDSCAPE NURSERY"     , ;
      "MILESTONE AGRICULTURE, INC."   , ;
      "MOJICA NURSERY & FRUITS"       , ;
      "NELSON'S ROSES"                , ;
      "PARK GARDENS"                  , ;
      "PAUL LUKAS INC."               , ;
      "PECKETT'S INC."                , ;
      "PENANG NURSERY, INC."          , ;
      "PINES III NURERIES"            , ;
      "PINEVIEW NURSERY"              , ;
      "POUL JENSEN NURSERY"           , ;
      "R.P. WELKER"                   , ;
      "RICHARD ROGERS NURSERY, INC."  , ;
      "SPRING HILL NURSERY"           , ;
      "T.O. MAHAFFEY, JR."            , ;
      "TUCKER NURSERY"                , ;
      "TURTLE POND NURSERY"           , ;
      "TUTTLE'S NURSERY INC."         , ;
      "VALLEY CACTUS"                 , ;
      "WHISPER WINDS, INC."           , ;
      "WHITE ROSE NURSERIES INC."     , ;
      "WOODWAY"                       , ;
      "FLORI-DESIGN"                  , ;
      "GREEN ACRES FOLIAGE, INC"      , ;
      "FLORAL EXPO"                   , ;
      "TORRES NURSERY"                , ;
      "DARRYL KOON"                   , ;
      "TRISTAR NURSERY"               , ;
      "KAY WEST NURSERY"              , ;
      "JAYMAR NURSERY"                , ;
      "J D F LANDSCAPE NURSERY"       , ;
      "DEROOSE PLANTS, INC."          , ;
      "THE TREEHOUSE"                 , ;
      "COSTELLO'S ARECAS, INC."       , ;
      "FLORICO FOLIAGE"               , ;
      "THE NATIVES"                   , ;
      "GREENS NURSERY"                , ;
      "STEWART NURSERIES"             , ;
      "G & T FOLIAGE, INC."           , ;
      "GOOD TIMES NURSERY"            , ;
      "CONCEPTS IN GREENERY, INC."    , ;
      "DUNN BROTHERS CITRUS, INC."    , ;
      "JOHN PLANK GREENHOUSES"        , ;
      "GREENER PASTURES NURSERY"      , ;
      "MULVEHILL NURSERY"             , ;
      "A NU LEAF"                     , ;
      "IVY DESIGNS, INC."             , ;
      "B & C TROPICALS"               , ;
      "SPANISH RIVER NURSERY, INC."   , ;
      "JACK CHRISTMAS & ASSOCIATES"   , ;
      "SPECIALIST GROWERS"            , ;
      "HOMRICH NURSERY, INC."         , ;
      "COUNTRYSIDE FOLIAGE, INC."     , ;
      "RFJ COMPANY"                   , ;
      "LAKE BRANTLEY PLANT CORP."     , ;
      "MARISTYME"                     , ;
      "MERISTEM NURSERY, INC."        , ;
      "TROPIC DECOR - EARL WILSON"    , ;
      "URQUHART'S NURSERY"            , ;
      "ACE PLANT NURSERY"             , ;
      "HATTAWAYS GREENHOUSE, INC."    , ;
      "Florida Plant Growers"         , ;
      "Junior Nursery"                , ;
      "Fox's Nurseries, Inc."         , ;
      "Vaughan Nursery"               , ;
      "MERRYGRO FARMS"                , ;
      "ALL SEASONS NURSERY"           , ;
      "BENCHMARK FOLIAGE"             , ;
      "SAMMY'S NURSERY"               , ;
      "SUNSHINE GROWERS"              , ;
      "Blooming-Fields Nursery"       }

   LOCAL aPermits := {}
   LOCAL x
   LOCAL nChoice
   LOCAL ncntr

   CLS

   SetColor( "GB+/B,GR+/R,,,W/N" )

   ASize( aPermits, Len( aPrompts ) )

   FOR x := 1 TO Len( aPrompts )
      aPermits[ x ] := !( "V" $ aPrompts[ x ] )
   NEXT

#define TEST1
#ifdef TEST1
   FOR ncntr := 1 TO 17
      aPermits[ nCntr ]                       := .F.
      aPermits[ Len( aPrompts ) - nCntr + 1 ] := .F.
   NEXT
   aPermits[ 32 ] := .F.
   aPermits[ 33 ] := .F.
   aPermits[ 34 ] := .F.
#endif

   nChoice := AChoice( 5, 10, 20, 70, aPrompts, aPermits, "cUserFunction" )

   SetPos( 0, 0 )
// CLS
   ? nChoice

   IF nChoice > 0
      ? aPrompts[ nChoice ]
   ENDIF
   SetPos( MaxRow() - 2, 0 )

   RETURN

//

FUNCTION cUserFunction( nMode, nCurElement, nRowPos )  /* must be a public function */

   LOCAL nRetVal := AC_CONT                // Default, Continue
   LOCAL nKey    := LastKey()

   LOCAL nRow := Row()
   LOCAL nCol := Col()

   HB_SYMBOL_UNUSED( nRowPos )

   @ 0, 20 SAY Str( nRow, 3 ) + " " + Str( nCol, 3 )

   DO CASE
      // After all pending keys are processed, display message
   CASE nMode == AC_IDLE
      @  0,  0 SAY PadR( hb_ntos( nCurElement ), 10 )
      nRetVal := AC_CONT                   // Continue AChoice()
   CASE nMode == AC_HITTOP                 // Attempt to go past Top
      @  0,  0 SAY "Hit Top   "
      // Tone( 100, 3 )
   CASE nMode == AC_HITBOTTOM              // Attempt to go past Bottom
      @  0,  0 SAY "Hit Bottom"
      // Tone( 100, 3 )
   CASE nMode == AC_EXCEPT                 // Key Exception
      @  0,  0 SAY "Exception "
      DO CASE
      CASE nKey == K_ENTER                 // If RETURN key, select
         nRetVal := AC_SELECT
      CASE nKey == K_ESC                   // If ESCAPE key, abort
         nRetVal := AC_ABORT
      OTHERWISE
         nRetVal := AC_GOTO                // Otherwise, go to item
      ENDCASE
   ENDCASE

   RETURN nRetVal

Gestionar bases de datos PostgreSQL

Un resumen de los métodos de la clase TPQ para PostgreSQL que viene en Harbour.

CREATE CLASS TPQServer

   VAR pDb
   VAR lTrans
   VAR lAllCols  INIT .T.
   VAR Schema    INIT "public"
   VAR lError    INIT .F.
   VAR cError    INIT ""
   VAR lTrace    INIT .F.
   VAR pTrace

   METHOD New( cHost, cDatabase, cUser, cPass, nPort, cSchema, hCustom )
   METHOD Destroy()
   METHOD Close()              INLINE ::Destroy()

   METHOD StartTransaction()
   METHOD TransactionStatus()  INLINE PQtransactionStatus( ::pDb )
   METHOD Commit()
   METHOD Rollback()

   METHOD Query( cQuery )
   METHOD Execute( cQuery )    INLINE ::Query( cQuery )
   METHOD SetSchema( cSchema )

   METHOD NetErr()             INLINE ::lError
   METHOD ErrorMsg()           INLINE ::cError

   METHOD TableExists( cTable )
   METHOD ListTables()
   METHOD TableStruct( cTable )
   METHOD CreateTable( cTable, aStruct )
   METHOD DeleteTable( cTable  )
   METHOD TraceOn( cFile )
   METHOD TraceOff()
   METHOD SetVerbosity( num )  INLINE PQsetErrorVerbosity( ::pDb, iif( num >= 0 .AND. num <= 2, num, 1 )  )

ENDCLASS
CREATE CLASS TPQQuery

   VAR pQuery
   VAR pDB

   VAR nResultStatus

   VAR lBof
   VAR lEof
   VAR lRead
   VAR lAllCols INIT .T.

   VAR lError   INIT .F.
   VAR cError   INIT ""

   VAR cQuery
   VAR nRecno
   VAR nFields
   VAR nLastrec

   VAR aStruct
   VAR aKeys
   VAR TableName
   VAR Schema
   VAR rows     INIT 0

   METHOD New( pDB, cQuery, lAllCols, cSchema, res )
   METHOD Destroy()
   METHOD Close()            INLINE ::Destroy()

   METHOD Refresh( lQuery, lMeta )
   METHOD Fetch()            INLINE ::Skip()
   METHOD Read()
   METHOD Skip( nRecno )

   METHOD Bof()              INLINE ::lBof
   METHOD Eof()              INLINE ::lEof
   METHOD RecNo()            INLINE ::nRecno
   METHOD LastRec()          INLINE ::nLastrec
   METHOD Goto( nRecno )

   METHOD NetErr()           INLINE ::lError
   METHOD ErrorMsg()         INLINE ::cError

   METHOD FCount()           INLINE ::nFields
   METHOD FieldName( nField )
   METHOD FieldPos( cField )
   METHOD FieldLen( nField )
   METHOD FieldDec( nField )
   METHOD FieldType( nField )
   METHOD Update( oRow )
   METHOD Delete( oRow )
   METHOD Append( oRow )
   METHOD SetKey()

   METHOD Changed( nField )  INLINE !( ::aRow[ nField ] == ::aOld[ nField ] )
   METHOD Blank()            INLINE ::GetBlankRow()

   METHOD Struct()

   METHOD FieldGet( nField, nRow )
   METHOD GetRow( nRow )
   METHOD GetBlankRow()

ENDCLASS
CREATE CLASS TPQRow

   VAR aRow
   VAR aOld
   VAR aStruct

   METHOD New( row, old, struct )

   METHOD FCount()              INLINE Len( ::aRow )
   METHOD FieldGet( nField )
   METHOD FieldPut( nField, Value )
   METHOD FieldName( nField )
   METHOD FieldPos( cField )
   METHOD FieldLen( nField )
   METHOD FieldDec( nField )
   METHOD FieldType( nField )
   METHOD Changed( nField )     INLINE !( ::aRow[ nField ] == ::aOld[ nField ] )
   METHOD FieldGetOld( nField ) INLINE ::aOld[ nField ]

ENDCLASS

 

Incluir propiedades en archivos .EXE

Es necesario Incluir el los archivos .EXE la información sobre las propiedades de la aplicación que desarrollamos.

 

2015-08-04_184224

Esto se hace indicando en el archivo de recursos .RC el siguiente código:

//
// $Id: Mpm.rc,v 1.1 2013/11/18 20:40:23 migsoft Exp $
//

ampm        ICON     res\Migproj.ico
favicon     ICON     res\Migproj.ico
Process     ICON     res\Process.ico
Build       ICON     res\Build.ico
logop       JPG      res\ologop.jpg
mnew        BITMAP   res\new.bmp
mopen       BITMAP   res\open.bmp
msave       BITMAP   res\save.bmp
mrun        BITMAP   res\run.bmp
mexit       BITMAP   res\exit.bmp
massoc      BITMAP   res\mpm.bmp
mbuild      BITMAP   res\build2.bmp
mfolder     BITMAP   res\folder.bmp
mprg        BITMAP   res\prg.bmp
mc          BITMAP   res\c.bmp
mrc         BITMAP   res\rc.bmp
madd        BITMAP   res\add.bmp
mremove     BITMAP   res\remove.bmp
mdown       BITMAP   res\down.bmp
mup         BITMAP   res\up.bmp
medit       BITMAP   res\edit.bmp
editfmg     BITMAP   res\editfmg.bmp
mharbour    BITMAP   res\harbour.bmp
mxharbour   BITMAP   res\xharbour.bmp
mmigsoft    BITMAP   res\migsoft.bmp
tproject    BITMAP   res\t_project.bmp
tfiles      BITMAP   res\t_files.bmp
tharbour    BITMAP   res\t_harbour.bmp
tcompiler   BITMAP   res\t_compiler.bmp
tgui        BITMAP   res\t_gui.bmp
tlibraries  BITMAP   res\t_libraries.bmp
tresult     BITMAP   res\t_result.bmp

1 VERSIONINFO
 FILEVERSION 1,0,0,0
 PRODUCTVERSION 1,0,0,0
 FILEFLAGSMASK 0x17L
 FILEOS 0x4L
 FILETYPE 0x2L
 FILESUBTYPE 0x0L
BEGIN
    BLOCK "StringFileInfo"
    BEGIN
        BLOCK "280a04b0"
        BEGIN
            VALUE "CompanyName", "Miguel Angel Juárez Apaza"
            VALUE "FileDescription", "MigSoft Project Manager"
            VALUE "FileVersion", "1, 0, 0, 0"
            VALUE "InternalName", " MPM "
            VALUE "LegalCopyright", "(c)2005-2015 MigSoft"
            VALUE "OriginalFilename", " Mpm.exe"
            VALUE "ProductName", " MPM Multi-GUI / Multi-Compiler"
            VALUE "ProductVersion", "1, 0, 0, 0"
        END
    END
    BLOCK "VarFileInfo"
    BEGIN
        VALUE "Translation", 0x280a, 1200
    END
END

2015-08-04_184306

 

Editor de código SynWrite

Fully customizable syntax highlighting for many languages (see list)

Code folding
Supports almost all encoding systems (ASCII, Unicode, etc.)
Multiple-caret editing (see animation)
Multiple selections (see animation)

Panels:
  • Tree view for source code
  • File manager
  • Project management
  • FTP/SFTP client
  • Document mini-map
  • Clipboard history
  • External tools output
  • Search results
  • Text clips
  • Tabs list

Coding helpers:

  • Auto-completion (for few lexers, see help topic)
  • Auto-closing of tags/brackets
  • Code templates
  • SmartTagTabbing feature (see animation)
  • SyncEditing feature to edit identical identifiers (see animation)
  • Emmet (Zen Coding) support (HTML + CSS + XSL high speed coding engine)
  • Color preview
  • Color picker
  • Image preview
  • Insert image tags
  • Insert date/time stamps
  • Portable bookmarks
  • Column markers
  • Micro-map

Search and replace with regular expressions
Search and replace in multiple files
Use external tools (capture console output, navigation to error lines)
Use Python-based plugins
Use binary plugins (e.g. Explorer panel and FTP client are plugins)
Regex-based strings extraction
Customizable hotkeys
Bookmarks
Key macros
Spell checker
File sessions
Plugin for “Total Commander” file manager
Multilingual interface: German, French, Russian, Spanish, Italian, Japanese, Chinese, etc.
Integrated HTML Tidy library
Export to RTF/HTML with syntax highlighting
Portable mode