[System] You are an expert Harbour (xBase/Clipper) programmer. Write clean, efficient code following Harbour conventions. Use proper Hungarian notation for variable names (c=character, n=numeric, l=logical, a=array, o=object, b=codeblock).

[User] Generate Harbour code for: Harbour contribution module 'hbmxml' (XML generation library): contrib/hbmxml/tests/custom.prg. Provides functions: load_c, save_c, whitespace_cb, type_cb. Contains procedures: Main, create_cust, my_mxmlError. This file handles data format parsing and generation

[Assistant]
#require "hbmxml"

#xtranslate _ENCODE( <xData> ) => ( hb_base64Encode( hb_Serialize( mxmlGetCustom( <xData> ) ) ) )

PROCEDURE Main()

   LOCAL tree, node
   LOCAL xData

   mxmlSetErrorCallback( @my_mxmlError() )
   mxmlSetCustomHandlers( @load_c(), @save_c() )

   IF ! hb_FileExists( "cust.xml" )
      create_cust()
   ENDIF

   tree := mxmlLoadFile( tree, "cust.xml", @type_cb() )

   node := mxmlFindElement( tree, tree, "hash", NIL, NIL, MXML_DESCEND )
   IF Empty( node )
      OutErr( "Unable to find <hash> element in XML tree!" )
      mxmlDelete( tree )

      ErrorLevel( -1 )
      RETURN
   ENDIF

   IF !( hb_MD5( _ENCODE( node ) ) == mxmlElementGetAttr( node, "checksum" ) )
      OutErr( "Custom data of element <hash> is corrupted!" )
      mxmlDelete( tree )

      ErrorLevel( -1 )
      RETURN
   ENDIF

   xData := mxmlGetCustom( node )
   IF HB_ISHASH( xData ) .AND. hb_HHasKey( xData, "Today" )
      OutStd( xData[ "Today" ], hb_eol() )
   ENDIF

   mxmlSetErrorCallback( NIL )
   mxmlSetCustomHandlers( NIL, NIL )

   ErrorLevel( 0 )

   RETURN

STATIC PROCEDURE create_cust()

   LOCAL tree, group, element, node
   LOCAL hData := { => }

   hData[ "Today" ] := hb_TSToStr( hb_DateTime() )

   tree    := mxmlNewXML()
   group   := mxmlNewElement( tree, "group" )
   element := mxmlNewElement( group, "hash" )
   node    := mxmlNewCustom( element, hData )

   mxmlElementSetAttr( element, "type", "custom" )
   mxmlElementSetAttr( element, "checksum", hb_MD5( _ENCODE( node ) ) )

   mxmlSaveFile( tree, "cust.xml", @whitespace_cb() )

   RETURN

PROCEDURE my_mxmlError( cErrorMsg )

   OutErr( cErrorMsg, hb_eol() )

   RETURN

FUNCTION load_c( node, cString )

   mxmlSetCustom( node, hb_Deserialize( hb_base64Decode( cString ) ) )

   RETURN 0

FUNCTION save_c( node )

   RETURN _ENCODE( node )

FUNCTION whitespace_cb( node, where )

   LOCAL parent
   LOCAL nLevel := -1
   LOCAL name

   name := mxmlGetElement( node )

   IF Left( name, 4 ) == "?xml"
      IF where == MXML_WS_AFTER_OPEN
         RETURN hb_eol()
      ELSE
         RETURN NIL
      ENDIF

   ELSEIF where == MXML_WS_BEFORE_OPEN .OR. ;
         ( ( name == "choice" .OR. name == "option" ) .AND. ;
         where == MXML_WS_BEFORE_CLOSE )

      parent := mxmlGetParent( node )
      DO WHILE ! Empty( parent )
         nLevel++
         parent := mxmlGetParent( parent )
      ENDDO

      IF nLevel > 8
         nLevel := 8
      ELSEIF nLevel < 0
         nLevel := 0
      ENDIF

      RETURN Replicate( Chr( 9 ), nLevel )

   ELSEIF where == MXML_WS_AFTER_CLOSE .OR. ;
         ( ( name == "group" .OR. name == "option" .OR. name == "choice" ) .AND. ;
         where == MXML_WS_AFTER_OPEN )
      RETURN hb_eol()

   ELSEIF where == MXML_WS_AFTER_OPEN .AND. Empty( mxmlGetFirstChild( node ) )
      RETURN hb_eol()
   ENDIF

   RETURN NIL

FUNCTION type_cb( node )

   LOCAL nResult
   LOCAL cType

   IF Empty( cType := mxmlElementGetAttr( node, "type" ) )
      cType := mxmlGetElement( node )
   ENDIF

   SWITCH Lower( cType )
   CASE "custom"
   CASE "hash"
      nResult := MXML_CUSTOM
      EXIT

   OTHERWISE
      nResult := MXML_TEXT
      EXIT
   ENDSWITCH

   RETURN nResult


[System] You are an expert Harbour (xBase/Clipper) programmer. Write clean, efficient code following Harbour conventions. Use proper Hungarian notation for variable names (c=character, n=numeric, l=logical, a=array, o=object, b=codeblock).

[User] Write Harbour functions: test_main. Harbour test program: tests/rddtest/adscl53.prg. Provides functions: test_main. This test file tests specific function APIs

[Assistant]
#define _TEST_ADS_
REQUEST dbfcdx
#define _TESTRDD "dbfcdx"
#include "rddtst.prg"

FUNCTION test_main()

RDDTESTC {0,.t.,.t.,.f.}, LOCAL n
RDDTESTF "DBFCDX", {0,.t.,.t.,.f.}, RDDSETDEFAULT()
RDDTESTC {1,.t.,.t.,.f.}, USE "_tst" SHARED
RDDTESTF NIL, {1,.t.,.t.,.f.}, DBGOTOP()
RDDTESTF NIL, {1,.t.,.t.,.f.}, DBGOBOTTOM()
RDDTESTF NIL, {1,.t.,.t.,.f.}, DBSKIP(0)
RDDTESTF NIL, {1,.t.,.t.,.f.}, DBGOTO(0)
RDDTESTF NIL, {1,.f.,.t.,.f.}, DBSKIP(1)
RDDTESTF NIL, {1,.t.,.f.,.f.}, DBSKIP(-1)
RDDTESTF NIL, {1,.t.,.f.,.f.}, DBSKIP(0)
RDDTESTC {1,.t.,.f.,.f.}, SET DELETE ON
RDDTESTF NIL, {1,.t.,.t.,.f.}, DBGOTOP()
RDDTESTF NIL, {1,.t.,.t.,.f.}, DBGOBOTTOM()
RDDTESTF NIL, {1,.t.,.t.,.f.}, DBSKIP(0)
RDDTESTF NIL, {1,.t.,.t.,.f.}, DBGOTO(0)
RDDTESTF NIL, {1,.f.,.t.,.f.}, DBSKIP(1)
RDDTESTF NIL, {1,.t.,.f.,.f.}, DBSKIP(-1)
RDDTESTF NIL, {1,.t.,.f.,.f.}, DBSKIP(0)
RDDTESTC {1,.t.,.f.,.f.}, SET DELETE OFF
RDDTESTC {1,.t.,.t.,.f.}, INDEX on FNUM tag TG_N to "_tst"
RDDTESTC {1,.t.,.t.,.f.}, INDEX on FSTR tag TG_C to "_tst"
RDDTESTF "TG_C", {1,.t.,.t.,.f.}, ORDSETFOCUS()
RDDTESTF NIL, {1,.t.,.t.,.f.}, DBGOTOP()
RDDTESTF NIL, {1,.t.,.t.,.f.}, DBGOBOTTOM()
RDDTESTF NIL, {1,.t.,.t.,.f.}, DBSKIP(0)
RDDTESTF NIL, {1,.t.,.t.,.f.}, DBGOTO(0)
RDDTESTF NIL, {1,.f.,.t.,.f.}, DBSKIP(1)
RDDTESTF NIL, {1,.t.,.f.,.f.}, DBSKIP(-1)
RDDTESTF NIL, {1,.t.,.f.,.f.}, DBSKIP(0)
RDDTESTC {1,.t.,.f.,.f.}, SET DELETE ON
RDDTESTF NIL, {1,.t.,.t.,.f.}, DBGOTOP()
RDDTESTF NIL, {1,.t.,.t.,.f.}, DBGOBOTTOM()
RDDTESTF NIL, {1,.t.,.t.,.f.}, DBSKIP(0)
RDDTESTF NIL, {1,.t.,.t.,.f.}, DBGOTO(0)
RDDTESTF NIL, {1,.f.,.t.,.f.}, DBSKIP(1)
RDDTESTF NIL, {1,.t.,.f.,.f.}, DBSKIP(-1)
RDDTESTF NIL, {1,.t.,.f.,.f.}, DBSKIP(0)
RDDTESTF NIL, {1,.t.,.t.,.f.}, DBGOTO(0)
RDDTESTF .f., {1,.f.,.t.,.f.}, DBSEEK("", .T.,.F.)
RDDTESTF .f., {1,.f.,.t.,.f.}, DBSEEK("", .T.,.T.)
RDDTESTF .f., {1,.f.,.t.,.f.}, DBSEEK("", .F.,.F.)
RDDTESTF .f., {1,.f.,.t.,.f.}, DBSEEK("", .F.,.T.)
RDDTESTC {1,.f.,.t.,.f.}, SET DELETE OFF
RDDTESTC {15,.f.,.f.,.f.}, for n:=1 to 15                    ; dbappend()                          ; replace FNUM with int((n+2)/3)      ; replace FSTR with chr(FNUM+48)      ; next
RDDTESTF NIL, {15,.f.,.f.,.f.}, dbcommit()
RDDTESTF NIL, {15,.f.,.f.,.f.}, dbunlock()
RDDTESTF "TG_C", {15,.f.,.f.,.f.}, ORDSETFOCUS(1)
RDDTESTF "TG_N", {15,.f.,.f.,.f.}, ORDSETFOCUS()
RDDTESTF .f., {1,.f.,.f.,.f.}, DBSEEK(0,.T.,.F.)
RDDTESTF .f., {16,.f.,.t.,.f.}, DBSEEK(0,.T.,.T.)
RDDTESTF .f., {1,.f.,.f.,.f.}, DBSEEK(0.5,.T.,.F.)
RDDTESTF .f., {16,.f.,.t.,.f.}, DBSEEK(0.5,.T.,.T.)
RDDTESTF .t., {1,.f.,.f.,.t.}, DBSEEK(1.0,.T.,.F.)
RDDTESTF .t., {3,.f.,.f.,.t.}, DBSEEK(1.0,.T.,.T.)
RDDTESTF .t., {4,.f.,.f.,.t.}, DBSEEK(2.0,.T.,.F.)
RDDTESTF .t., {6,.f.,.f.,.t.}, DBSEEK(2.0,.T.,.T.)
RDDTESTF .f., {7,.f.,.f.,.f.}, DBSEEK(2.5,.T.,.F.)
RDDTESTF .f., {6,.f.,.f.,.f.}, DBSEEK(2.5,.T.,.T.)
RDDTESTF .t., {13,.f.,.f.,.t.}, DBSEEK(5.0,.T.,.F.)
RDDTESTF .t., {15,.f.,.f.,.t.}, DBSEEK(5.0,.T.,.T.)
RDDTESTF "TG_N", {15,.f.,.f.,.t.}, ORDSETFOCUS(2)
RDDTESTF "TG_C", {15,.f.,.f.,.t.}, ORDSETFOCUS()
RDDTESTF .t., {1,.f.,.f.,.t.}, DBSEEK("", .T.,.F.)
RDDTESTF .t., {15,.f.,.f.,.t.}, DBSEEK("", .T.,.T.)
RDDTESTF .f., {1,.f.,.f.,.f.}, DBSEEK(" ",.T.,.F.)
RDDTESTF .f., {16,.f.,.t.,.f.}, DBSEEK(" ",.T.,.T.)
RDDTESTF .f., {1,.f.,.f.,.f.}, DBSEEK("0",.T.,.F.)
RDDTESTF .f., {16,.f.,.t.,.f.}, DBSEEK("0",.T.,.T.)
RDDTESTF .t., {1,.f.,.f.,.t.}, DBSEEK("1",.T.,.F.)
RDDTESTF .t., {3,.f.,.f.,.t.}, DBSEEK("1",.T.,.T.)
RDDTESTF .t., {4,.f.,.f.,.t.}, DBSEEK("2",.T.,.F.)
RDDTESTF .t., {6,.f.,.f.,.t.}, DBSEEK("2",.T.,.T.)
RDDTESTF .t., {7,.f.,.f.,.t.}, DBSEEK("3",.T.,.F.)
RDDTESTF .t., {9,.f.,.f.,.t.}, DBSEEK("3",.T.,.T.)
RDDTESTF .t., {10,.f.,.f.,.t.}, DBSEEK("4",.T.,.F.)
RDDTESTF .t., {12,.f.,.f.,.t.}, DBSEEK("4",.T.,.T.)
RDDTESTF .t., {13,.f.,.f.,.t.}, DBSEEK("5",.T.,.F.)
RDDTESTF .t., {15,.f.,.f.,.t.}, DBSEEK("5",.T.,.T.)
RDDTESTF .f., {16,.f.,.t.,.f.}, DBSEEK("6",.T.,.F.)
RDDTESTF .f., {15,.f.,.f.,.f.}, DBSEEK("6",.T.,.T.)
RDDTESTF NIL, {15,.f.,.f.,.f.}, ORDSCOPE(0,"3")
RDDTESTF NIL, {15,.f.,.f.,.f.}, ORDSCOPE(1,"4")
RDDTESTF "3", {15,.f.,.f.,.f.}, DBORDERINFO(39)
RDDTESTF "4", {15,.f.,.f.,.f.}, DBORDERINFO(40)
RDDTESTF .t., {7,.f.,.f.,.t.}, DBSEEK("", .T.,.F.)
RDDTESTF .f., {16,.f.,.t.,.f.}, DBSEEK("", .T.,.T.)
RDDTESTF .f., {7,.f.,.f.,.f.}, DBSEEK(" ",.T.,.F.)
RDDTESTF .f., {16,.f.,.t.,.f.}, DBSEEK(" ",.T.,.T.)
RDDTESTF .f., {7,.f.,.f.,.f.}, DBSEEK("0",.T.,.F.)
RDDTESTF .f., {16,.f.,.t.,.f.}, DBSEEK("0",.T.,.T.)
RDDTESTF .f., {7,.f.,.f.,.f.}, DBSEEK("1",.T.,.F.)
RDDTESTF .f., {7,.f.,.f.,.f.}, DBSEEK("1",.T.,.T.)
RDDTESTF .f., {7,.f.,.f.,.f.}, DBSEEK("2",.T.,.F.)
RDDTESTF .f., {7,.f.,.f.,.f.}, DBSEEK("2",.T.,.T.)
RDDTESTF .t., {7,.f.,.f.,.t.}, DBSEEK("3",.T.,.F.)
RDDTESTF .t., {9,.f.,.f.,.t.}, DBSEEK("3",.T.,.T.)
RDDTESTF .t., {10,.f.,.f.,.t.}, DBSEEK("4",.T.,.F.)
RDDTESTF .t., {12,.f.,.f.,.t.}, DBSEEK("4",.T.,.T.)
RDDTESTF .f., {16,.f.,.t.,.f.}, DBSEEK("5",.T.,.F.)
RDDTESTF .f., {16,.f.,.t.,.f.}, DBSEEK("5",.T.,.T.)
RDDTESTF .f., {16,.f.,.t.,.f.}, DBSEEK("6",.T.,.F.)
RDDTESTF .f., {16,.f.,.t.,.f.}, DBSEEK("6",.T.,.T.)
RDDTESTF "3", {16,.f.,.t.,.f.}, ORDSCOPE(0,"3")
RDDTESTF "4", {16,.f.,.t.,.f.}, ORDSCOPE(1,"2")
RDDTESTF "3", {16,.f.,.t.,.f.}, DBORDERINFO(39)
RDDTESTF "2", {16,.f.,.t.,.f.}, DBORDERINFO(40)
RDDTESTF .f., {16,.f.,.t.,.f.}, DBSEEK("",.T.,.F.)
RDDTESTF .f., {16,.f.,.t.,.f.}, DBSEEK("",.T.,.T.)
RDDTESTF .f., {16,.f.,.t.,.f.}, DBSEEK("1",.T.,.F.)
RDDTESTF .f., {16,.f.,.t.,.f.}, DBSEEK("1",.T.,.T.)
RDDTESTF .f., {16,.f.,.t.,.f.}, DBSEEK("2",.T.,.F.)
RDDTESTF .f., {16,.f.,.t.,.f.}, DBSEEK("2",.T.,.T.)
RDDTESTF .f., {16,.f.,.t.,.f.}, DBSEEK("3",.T.,.F.)
RDDTESTF .f., {16,.f.,.t.,.f.}, DBSEEK("3",.T.,.T.)
RDDTESTF .f., {16,.f.,.t.,.f.}, DBSEEK("4",.T.,.F.)
RDDTESTF .f., {16,.f.,.t.,.f.}, DBSEEK("4",.T.,.T.)
RDDTESTF "3", {16,.f.,.t.,.f.}, DBORDERINFO(39)
RDDTESTF "2", {16,.f.,.t.,.f.}, DBORDERINFO(40)
RDDTESTF .t., {16,.f.,.t.,.f.}, ORDSCOPE(0,NIL)
RDDTESTF .t., {16,.f.,.t.,.f.}, ORDSCOPE(1,NIL)
RDDTESTF NIL, {16,.f.,.t.,.f.}, DBORDERINFO(39)
RDDTESTF NIL, {16,.f.,.t.,.f.}, DBORDERINFO(40)
RDDTESTF .t., {1,.f.,.f.,.t.}, DBSEEK("", .T.,.F.)
RDDTESTF .t., {15,.f.,.f.,.t.}, DBSEEK("", .T.,.T.)
RDDTESTF .f., {1,.f.,.f.,.f.}, DBSEEK(" ",.T.,.F.)
RDDTESTF .f., {16,.f.,.t.,.f.}, DBSEEK(" ",.T.,.T.)
RDDTESTF .f., {1,.f.,.f.,.f.}, DBSEEK("0",.T.,.F.)
RDDTESTF .f., {16,.f.,.t.,.f.}, DBSEEK("0",.T.,.T.)
RDDTESTF .t., {1,.f.,.f.,.t.}, DBSEEK("1",.T.,.F.)
RDDTESTF .t., {3,.f.,.f.,.t.}, DBSEEK("1",.T.,.T.)
RDDTESTF .t., {4,.f.,.f.,.t.}, DBSEEK("2",.T.,.F.)
RDDTESTF .t., {6,.f.,.f.,.t.}, DBSEEK("2",.T.,.T.)
RDDTESTF .t., {7,.f.,.f.,.t.}, DBSEEK("3",.T.,.F.)
RDDTESTF .t., {9,.f.,.f.,.t.}, DBSEEK("3",.T.,.T.)
RDDTESTF .t., {10,.f.,.f.,.t.}, DBSEEK("4",.T.,.F.)
RDDTESTF .t., {12,.f.,.f.,.t.}, DBSEEK("4",.T.,.T.)
RDDTESTF .t., {13,.f.,.f.,.t.}, DBSEEK("5",.T.,.F.)
RDDTESTF .t., {15,.f.,.f.,.t.}, DBSEEK("5",.T.,.T.)
RDDTESTF .f., {16,.f.,.t.,.f.}, DBSEEK("6",.T.,.F.)
RDDTESTF .f., {15,.f.,.f.,.f.}, DBSEEK("6",.T.,.T.)
RDDTESTF NIL, {15,.f.,.f.,.f.}, ORDSCOPE(0,"4")
RDDTESTF NIL, {15,.f.,.f.,.f.}, ORDSCOPE(1,"3")
RDDTESTF "4", {15,.f.,.f.,.f.}, DBORDERINFO(39)
RDDTESTF "3", {15,.f.,.f.,.f.}, DBORDERINFO(40)
RDDTESTF .f., {16,.f.,.t.,.f.}, DBSEEK("", .T.,.F.)
RDDTESTF .f., {16,.f.,.t.,.f.}, DBSEEK("", .T.,.T.)
RDDTESTF .f., {16,.f.,.t.,.f.}, DBSEEK(" ",.T.,.F.)
RDDTESTF .f., {16,.f.,.t.,.f.}, DBSEEK(" ",.T.,.T.)
RDDTESTF .f., {16,.f.,.t.,.f.}, DBSEEK("0",.T.,.F.)
RDDTESTF .f., {16,.f.,.t.,.f.}, DBSEEK("0",.T.,.T.)
RDDTESTF .f., {16,.f.,.t.,.f.}, DBSEEK("1",.T.,.F.)
RDDTESTF .f., {16,.f.,.t.,.f.}, DBSEEK("1",.T.,.T.)
RDDTESTF .f., {16,.f.,.t.,.f.}, DBSEEK("2",.T.,.F.)
RDDTESTF .f., {16,.f.,.t.,.f.}, DBSEEK("2",.T.,.T.)
RDDTESTF .f., {16,.f.,.t.,.f.}, DBSEEK("3",.T.,.F.)
RDDTESTF .f., {16,.f.,.t.,.f.}, DBSEEK("3",.T.,.T.)
RDDTESTF .f., {16,.f.,.t.,.f.}, DBSEEK("4",.T.,.F.)
RDDTESTF .f., {16,.f.,.t.,.f.}, DBSEEK("4",.T.,.T.)
RDDTESTF .f., {16,.f.,.t.,.f.}, DBSEEK("5",.T.,.F.)


[System] You are an expert Harbour (xBase/Clipper) programmer. Write clean, efficient code following Harbour conventions. Use proper Hungarian notation for variable names (c=character, n=numeric, l=logical, a=array, o=object, b=codeblock).

[User] Create Harbour OOP classes for the functionality described: Harbour contribution module 'hbtip' (Internet protocol utilities (FTP, HTTP, SMTP, POP3)): contrib/hbtip/cgi.prg. Defines classes: TIPCgi. Provides functions: HtmlTag. This file provides network protocol implementations

[Assistant]
#include "hbclass.ch"

#include "fileio.ch"

#define _CRLF Chr( 13 ) + Chr( 10 )

CREATE CLASS TIPCgi

   VAR HTTP_RAW_POST_DATA

   VAR cCgiHeader
   VAR cHtmlPage
   VAR hGets        INIT { => }
   VAR hPosts       INIT { => }
   VAR hCookies     INIT { => }
   VAR hSession     INIT { => }
   VAR bSavedErrHandler
   VAR cSessionSavePath
   VAR cSID
   VAR cDumpSavePath
   VAR lDumpHtml    INIT .F.
   VAR Cargo

   METHOD New()
   METHOD Header( cValue )
   METHOD Redirect( cUrl )
   METHOD Write( cString )
   METHOD Flush()
   METHOD ErrHandler( xError )

   METHOD StartHtml( hOptions )
   METHOD EndHtml()
   METHOD SaveHtmlPage( cFile )

   METHOD StartSession( cSID )
   METHOD DestroySession( cID )
   METHOD CreateSID( cCRCKey ) INLINE ::cSID := tip_GenerateSID( cCrcKey )
   METHOD CheckCrcSID( cSID, cCRCKey ) INLINE tip_CheckSID( cSID, cCRCKey )
   METHOD SessionEncode()
   METHOD SessionDecode( cData )

ENDCLASS

METHOD New() CLASS TIPCgi

   LOCAL aVar
   LOCAL nLen
   LOCAL nRead
   LOCAL cTemp
   LOCAL item

   ::bSavedErrHandler := ErrorBlock( {| e | ::ErrHandler( e ) } )

   ::cCgiHeader := ""
   ::cHtmlPage := ""

   IF "POST" $ Upper( GetEnv( "REQUEST_METHOD" ) )
      nLen := Val( GetEnv( "CONTENT_LENGTH" ) )
      cTemp := Space( nLen )
      IF ( nRead := FRead( hb_GetStdIn(), @cTemp, nLen ) ) != nLen
         ::ErrHandler( "post error read " + hb_ntos( nRead ) + " instead of " + hb_ntos( nLen ) )
      ELSE
         ::HTTP_RAW_POST_DATA := cTemp
         FOR EACH item IN hb_ATokens( cTemp, "&" )
            IF Len( aVar := hb_ATokens( item, "=" ) ) == 2
               ::hPosts[ AllTrim( tip_URLDecode( aVar[ 1 ] ) ) ] := tip_URLDecode( aVar[ 2 ] )
            ENDIF
         NEXT
      ENDIF
   ELSEIF ! Empty( cTemp := GetEnv( "QUERY_STRING" ) )
      FOR EACH item IN hb_ATokens( cTemp, "&" )
         IF Len( aVar := hb_ATokens( item, "=" ) ) == 2
            ::hGets[ AllTrim( tip_URLDecode( aVar[ 1 ] ) ) ] := tip_URLDecode( aVar[ 2 ] )
         ENDIF
      NEXT
   ENDIF

   IF ! Empty( cTemp := GetEnv( "HTTP_COOKIE" ) )
      FOR EACH item IN hb_ATokens( cTemp, ";" )
         IF Len( aVar := hb_ATokens( item, "=" ) ) == 2
            ::hCookies[ AllTrim( tip_URLDecode( aVar[ 1 ] ) ) ] := tip_URLDecode( aVar[ 2 ] )
         ENDIF
      NEXT
   ENDIF

   RETURN Self

METHOD Header( cValue ) CLASS TIPCgi

   IF HB_ISSTRING( cValue ) .AND. ! Empty( cValue )
      ::cCgiHeader += cValue + _CRLF
   ELSE
      ::cCgiHeader += "Content-Type: text/html" + _CRLF
   ENDIF

   RETURN Self

METHOD Redirect( cUrl ) CLASS TIPCgi

   IF HB_ISSTRING( cUrl ) .AND. ! Empty( cUrl )
      ::cCgiHeader += "Location: " + cUrl + _CRLF
   ENDIF

   RETURN Self

METHOD Flush() CLASS TIPCgi

   LOCAL cStream
   LOCAL lRet

   LOCAL hFile
   LOCAL cFile

   LOCAL cSession

   hb_HEval( ::hCookies, {| k, v | ::cCgiHeader += "Set-Cookie: " + k + "=" + v + ";" + _CRLF } )

   cStream := ::cCgiHeader + _CRLF + ::cHtmlPage + _CRLF

   lRet := ( FWrite( hb_GetStdOut(), cStream ) == hb_BLen( cStream ) )

   IF ::lDumpHtml
      IF ::cDumpSavePath == NIL
         ::cDumpSavePath := hb_DirTemp()
      ENDIF
      hb_MemoWrit( hb_DirSepAdd( ::cDumpSavePath ) + "dump.html", ::cHtmlPage )
   ENDIF

   ::cCgiHeader := ""
   ::cHtmlPage := ""

   IF ! Empty( ::cSID )

      cFile := hb_DirSepAdd( ::cSessionSavePath ) + "SESSIONID_" + ::cSID

      IF ( hFile := hb_vfOpen( cFile, FO_CREAT + FO_TRUNC + FO_WRITE + FO_EXCLUSIVE ) ) != NIL
         cSession := ::SessionEncode()
         IF hb_vfWrite( hFile, cSession ) != hb_BLen( cSession )
            ::Write( "ERROR: On writing session file: " + cFile + ", File error: " + hb_CStr( FError() ) )
         ENDIF
         hb_vfClose( hFile )
      ELSE
         ::Write( "ERROR: On writing session file: " + cFile + ", File error: " + hb_CStr( FError() ) )
      ENDIF
   ENDIF

   RETURN lRet

METHOD SaveHtmlPage( cFile ) CLASS TIPCgi
   RETURN hb_MemoWrit( cFile, ::cHtmlPage + _CRLF )

METHOD StartSession( cSID ) CLASS TIPCgi

   LOCAL hFile
   LOCAL cFile
   LOCAL nFileSize
   LOCAL cBuffer

   IF ! HB_ISSTRING( cSID ) .OR. Empty( cSID )
      DO CASE
      CASE hb_HGetRef( ::hGets, "SESSIONID", @cSID )
      CASE hb_HGetRef( ::hPosts, "SESSIONID", @cSID )
      CASE hb_HGetRef( ::hCookies, "SESSIONID", @cSID )
      ENDCASE
   ENDIF

   IF ::cSessionSavePath == NIL
      ::cSessionSavePath := hb_DirTemp()
   ENDIF

   IF ! Empty( cSID )

      ::cSID := cSID

      cFile := hb_DirSepAdd( ::cSessionSavePath ) + "SESSIONID_" + cSID

      IF hb_vfExists( cFile )
         IF ( hFile := hb_vfOpen( cFile, FO_READ ) ) != NIL
            nFileSize := hb_vfSize( hFile )
            hb_vfSeek( hFile, 0, FS_SET )
            cBuffer := Space( nFileSize )
            IF hb_vfRead( hFile, @cBuffer, nFileSize ) != nFileSize
               ::ErrHandler( "ERROR: On reading session file: " + cFile + ", File error: " + hb_CStr( FError() ) )
            ELSE
               ::SessionDecode( cBuffer )
            ENDIF
            hb_vfClose( hFile )
         ENDIF
      ELSE
         ::ErrHandler( "ERROR: On opening session file: " + cFile + ", file not exist." )
      ENDIF
   ELSE
      ::CreateSID()
      ::hSession := { => }
   ENDIF

   ::hCookies[ "SESSIONID" ] := ::cSID

   RETURN Self

METHOD SessionEncode() CLASS TIPCgi
   RETURN hb_Serialize( ::hSession )

METHOD SessionDecode( cData ) CLASS TIPCgi
   RETURN HB_ISHASH( ::hSession := hb_Deserialize( cData ) )

METHOD DestroySession( cID ) CLASS TIPCgi

   LOCAL cFile
   LOCAL cSID
   LOCAL lOk

   IF HB_ISSTRING( cID ) .AND. ! Empty( cID )
      cSID := cID
   ELSE
      cSID := ::cSID
   ENDIF

   IF ! Empty( cSID )

      ::hSession := { => }

      cFile := hb_DirSepAdd( ::cSessionSavePath ) + "SESSIONID_" + cSID

      IF ( lOk := ( hb_vfErase( cFile ) != F_ERROR ) )
         ::hCookies[ "SESSIONID" ] := cSID + "; expires= " + tip_DateToGMT( hb_DateTime() - 1 )
         ::CreateSID()
         ::hCookies[ "SESSIONID" ] := ::cSID
      ELSE
         ::Write( "ERROR: On deleting session file: " + cFile + ", File error: " + hb_CStr( FError() ) )
      ENDIF
   ENDIF

   RETURN lOk

METHOD PROCEDURE ErrHandler( xError ) CLASS TIPCgi

   LOCAL nCalls

   LOCAL cErrMsg := ;
      '
' + ;
      "
SCRIPT NAME:	" + GetEnv( "SCRIPT_NAME" ) + "
"

   DO CASE
   CASE HB_ISOBJECT( xError )
      cErrMsg += ;
         "
CRITICAL ERROR:	" + xError:Description + "
" + ;
         "
OPERATION:	" + xError:Operation + "
" + ;
         "
OS ERROR:	" + hb_ntos( xError:OsCode ) + " IN " + xError:SubSystem + "/" + hb_ntos( xError:SubCode ) + "
" + ;
         "
FILENAME:	" + Right( xError:FileName, 40 ) + "
"
   CASE HB_ISSTRING( xError )
      cErrMsg += "
ERROR MESSAGE:	" + tip_HtmlSpecialChars( xError ) + "
"
   ENDCASE

   nCalls := 0
   DO WHILE ! Empty( ProcName( ++nCalls ) )
      cErrMsg += "
PROC/LINE:	" + ProcName( nCalls ) + "/" + hb_ntos( ProcLine( nCalls ) ) + "
"
   ENDDO

   cErrMsg += "
"

   ::Write( cErrMsg )

   OutErr( cErrMsg )

   ::Flush()

   QUIT

   RETURN

METHOD Write( cString ) CLASS TIPCgi

   ::cHtmlPage += cString + _CRLF

   RETURN Self

METHOD StartHtml( hOptions ) CLASS TIPCgi

   ::cHtmlPage += ;
      "<!DOCTYPE html>" + _CRLF + ;
      "" + ;
      '<meta charset="' + HtmlOption( hOptions, "encoding" ) + '" />' + ;
      HtmlTag( hOptions, "title", "title" ) + ;
      HtmlScript( hOptions ) + ;
      HtmlStyle( hOptions ) + ;
      HtmlLinkRel( hOptions ) + ;
      "" + ;
      ""

   RETURN Self

METHOD EndHtml() CLASS TIPCgi

   ::cHtmlPage += ""

   RETURN Self

STATIC FUNCTION HtmlTag( xVal, cKey, cDefault )

   LOCAL cVal

   IF HB_ISHASH( xVal ) .AND. ! Empty( cKey ) .AND. cKey $ xVal


[System] You are an expert Harbour (xBase/Clipper) programmer. Write clean, efficient code following Harbour conventions. Use proper Hungarian notation for variable names (c=character, n=numeric, l=logical, a=array, o=object, b=codeblock).

[User] Write a Harbour program with procedures: xhb_ErrorSys. Harbour contribution module 'xhb' (Extended Harbour functions): contrib/xhb/xhberr.prg. Provides 7 functions including: xhb_ErrorLog, err_ModuleName, err_ProcName, err_ProcLine, xhb_DefError. Contains procedures: xhb_ErrorSys. This file provides legacy compatibility functions

[Assistant]
#include "error.ch"
#include "fileio.ch"

REQUEST Select, Alias, RecNo, DbFilter, DbRelation, IndexOrd, IndexKey

STATIC s_cErrorLog := "error.log"
STATIC s_lErrorLogAppend := .F.

FUNCTION xhb_ErrorLog( cErrorLog, lErrorLogAppend )

   LOCAL aValueOld := { s_cErrorLog, s_lErrorLogAppend }

   IF HB_ISSTRING( cErrorLog )
      s_cErrorLog := cErrorLog
   ENDIF
   IF HB_ISLOGICAL( lErrorLogAppend )
      s_lErrorLogAppend := lErrorLogAppend
   ENDIF

   RETURN aValueOld

PROCEDURE xhb_ErrorSys()

   ErrorBlock( {| oError | xhb_DefError( oError ) } )

   RETURN

STATIC FUNCTION err_ModuleName( oError, n )

   RETURN iif( __objHasMsg( oError, "MODULENAME" ), oError:ModuleName, ;
      iif( n != NIL, ProcFile( n ), NIL ) )

STATIC FUNCTION err_ProcName( oError, n )

   RETURN iif( __objHasMsg( oError, "PROCNAME" ), oError:ProcName, ;
      iif( n != NIL, ProcName( n ), NIL ) )

STATIC FUNCTION err_ProcLine( oError, n )

   RETURN iif( __objHasMsg( oError, "PROCLINE" ), oError:ProcLine, ;
      iif( n != NIL, ProcLine( n ), NIL ) )

STATIC FUNCTION xhb_DefError( oError )

   LOCAL cMessage
   LOCAL cDOSError

   LOCAL aOptions
   LOCAL nChoice

   LOCAL n

   n := 0
   WHILE ! Empty( ProcName( ++n ) )
      IF ProcName( n ) == ProcName()
         n := 3
         TraceLog( "Error system failure!", err_ProcName( oError, n ), err_ProcLine( oError, n ), err_ModuleName( oError, n ), oError:description )
         Alert( "Error system failure!;Please correct error handler:;" + err_ProcName( oError, n ) + "(" + hb_ntos( err_ProcLine( oError, n ) ) +  ") in module: " + err_ModuleName( oError, n ) )
         ErrorLevel( 1 )
         QUIT
      ENDIF
   ENDDO

   IF oError:genCode == EG_ZERODIV
      RETURN 0
   ENDIF

   IF oError:genCode == EG_LOCK .AND. ;
         oError:canRetry

      RETURN .T.
   ENDIF

   IF oError:genCode == EG_OPEN .AND. ;
         oError:osCode == 32 .AND. ;
         oError:canDefault
      NetErr( .T. )
      RETURN .F.
   ENDIF

   IF oError:genCode == EG_APPENDLOCK .AND. ;
         oError:canDefault
      NetErr( .T. )
      RETURN .F.
   ENDIF

   DO WHILE DispCount() > 0
      DispEnd()
   ENDDO

   cMessage := ErrorMessage( oError )
   IF ! Empty( oError:osCode )
      cDOSError := "(DOS Error " + hb_ntos( oError:osCode ) + ")"
   ENDIF

   IF HB_ISARRAY( oError:Args )
      cMessage += " Arguments: (" + Arguments( oError ) + ")"
   ENDIF

   IF MaxCol() > 0
      aOptions := {}

      AAdd( aOptions, "Quit" )

      IF oError:canRetry
         AAdd( aOptions, "Retry" )
      ENDIF

      IF oError:canDefault
         AAdd( aOptions, "Default" )
      ENDIF

      nChoice := 0
      DO WHILE nChoice == 0

         IF Empty( oError:osCode )
            nChoice := Alert( cMessage, aOptions )
         ELSE
            nChoice := Alert( cMessage + ";" + cDOSError, aOptions )
         ENDIF

      ENDDO

      IF ! Empty( nChoice )
         DO CASE
         CASE aOptions[ nChoice ] == "Break"
            Break( oError )
         CASE aOptions[ nChoice ] == "Retry"
            RETURN .T.
         CASE aOptions[ nChoice ] == "Default"
            RETURN .F.
         ENDCASE
      ENDIF
   ELSE
      IF Empty( oError:osCode )
         Alert( cMessage + ";" + err_ProcName( oError, 3 ) + "(" + hb_ntos( err_ProcLine( oError, 3 ) ) +  ") in module: " + err_ModuleName( oError, 3 ) )
      ELSE
         Alert( cMessage + ";" + cDOSError + ";" + err_ProcName( oError, 3 ) + "(" + hb_ntos( err_ProcLine( oError, 3 ) ) +  ") in module: " + err_ModuleName( oError, 3 ) )
      ENDIF
   ENDIF

   IF ! Empty( oError:osCode )
      cMessage += " " + cDOSError
   ENDIF

   ? cMessage

   ?
   ? "Error at ...:", err_ProcName( oError, 3 ) + "(" + hb_ntos( err_ProcLine( oError, 3 ) ) + ") in Module:", err_ModuleName( oError, 3 )
   n := 2
   WHILE ! Empty( ProcName( ++n ) )
      ? "Called from :", ProcName( n ) + ;
         "(" + hb_ntos( ProcLine( n ) ) + ") in Module:", ProcFile( n )
   ENDDO

   LogError( oError )

   ErrorLevel( 1 )
   ?
   QUIT

   RETURN .F.

STATIC FUNCTION ErrorMessage( oError )

   LOCAL cMessage

   cMessage := iif( oError:severity > ES_WARNING, "Error", "Warning" ) + " "

   IF HB_ISSTRING( oError:subsystem )
      cMessage += oError:subsystem()
   ELSE
      cMessage += "???"
   ENDIF

   IF HB_ISNUMERIC( oError:subCode )
      cMessage += "/" + hb_ntos( oError:subCode )
   ELSE
      cMessage += "/???"
   ENDIF

   IF HB_ISSTRING( oError:description )
      cMessage += "  " + oError:description
   ENDIF

   DO CASE
   CASE ! Empty( oError:filename )
      cMessage += ": " + oError:filename
   CASE ! Empty( oError:operation )
      cMessage += ": " + oError:operation
   ENDCASE

   RETURN cMessage

STATIC FUNCTION LogError( oErr )

   LOCAL cScreen
   LOCAL cLogFile    := s_cErrorLog
   LOCAL lAppendLog  := s_lErrorLogAppend
   LOCAL nCols
   LOCAL nRows

   LOCAL nCount

   LOCAL nForLoop
   LOCAL cOutString

   LOCAL nHandle
   LOCAL nBytes

   LOCAL nHandle2   := F_ERROR
   LOCAL cLogFile2  := "_error.log"
   LOCAL cBuff      := ""
   LOCAL nRead

   nCols := MaxCol()
   IF nCols > 0
      nRows := MaxRow()
      cScreen := SaveScreen()
   ENDIF

   IF ! lAppendLog
      nHandle := FCreate( cLogFile, FC_NORMAL )
   ELSE
      IF ! hb_FileExists( cLogFile )
         nHandle := FCreate( cLogFile, FC_NORMAL )
      ELSE
         nHandle  := FCreate( cLogFile2, FC_NORMAL )
         nHandle2 := FOpen( cLogFile, FO_READ )
      ENDIF
   ENDIF

   IF nHandle < 3 .AND. !( Lower( cLogFile ) == "error.log" )

      cLogFile := "error.log"
      nHandle := FCreate( cLogFile, FC_NORMAL )
   ENDIF

   IF nHandle < 3
   ELSE

      FWriteLine( nHandle, PadC( " xHarbour Error Log ", 79, "-" ) )
      FWriteLine( nHandle, "" )

      FWriteLine( nHandle, "Date...............: " + DToC( Date() )  )
      FWriteLine( nHandle, "Time...............: " + Time()          )

      FWriteLine( nHandle, "" )
      FWriteLine( nHandle, "Application name...: " + hb_CmdArgArgV() )
      FWriteLine( nHandle, "Workstation name...: " + NetName() )
      FWriteLine( nHandle, "Available memory...: " + strvalue( Memory( 0 ) )  )
      FWriteLine( nHandle, "Current disk.......: " + DiskName() )
      FWriteLine( nHandle, "Current directory..: " + CurDir() )
      FWriteLine( nHandle, "Free disk space....: " + strvalue( DiskSpace() ) )
      FWriteLine( nHandle, "" )
      FWriteLine( nHandle, "Operating system...: " + OS() )
      FWriteLine( nHandle, "xHarbour version...: " + Version() )
      FWriteLine( nHandle, "xHarbour built on..: " + hb_BuildDate() )
      FWriteLine( nHandle, "C/C++ compiler.....: " + hb_Compiler() )

      FWriteLine( nHandle, "Multi Threading....: " + iif( hb_mtvm(), "YES", "NO" ) )
      FWriteLine( nHandle, "VM Optimization....: " + strvalue( hb_VMMode() ) )

      IF hb_IsFunction( "Select" )
         FWriteLine( nHandle, "" )
         FWriteLine( nHandle, "Current Area ......:" + strvalue( Eval( hb_macroBlock( "Select()" ) ) ) )
      ENDIF

      FWriteLine( nHandle, "" )
      FWriteLine( nHandle, PadC( " Environmental Information ", 79, "-" ) )
      FWriteLine( nHandle, "" )

      FWriteLine( nHandle, "SET ALTERNATE......: " + strvalue( Set( _SET_ALTERNATE ), .T. ) )
      FWriteLine( nHandle, "SET ALTFILE........: " + strvalue( Set( _SET_ALTFILE ) ) )
      FWriteLine( nHandle, "SET AUTOPEN........: " + strvalue( Set( _SET_AUTOPEN ), .T. ) )
      FWriteLine( nHandle, "SET AUTORDER.......: " + strvalue( Set( _SET_AUTORDER ) ) )
      FWriteLine( nHandle, "SET AUTOSHARE......: " + strvalue( Set( _SET_AUTOSHARE ) ) )

#ifdef __XHARBOUR__
      FWriteLine( nHandle, "SET BACKGROUNDTASKS: " + strvalue( Set( _SET_BACKGROUNDTASKS ), .T. ) )
      FWriteLine( nHandle, "SET BACKGROUNDTICK.: " + strvalue( Set( _SET_BACKGROUNDTICK ), .T. ) )
#endif
      FWriteLine( nHandle, "SET BELL...........: " + strvalue( Set( _SET_BELL ), .T. ) )


[System] You are an expert Harbour (xBase/Clipper) programmer. Write clean, efficient code following Harbour conventions. Use proper Hungarian notation for variable names (c=character, n=numeric, l=logical, a=array, o=object, b=codeblock).

[User] Write Harbour functions: Something. Harbour test program: tests/parexpr.prg. Provides functions: Something. Contains procedures: Main. This test file tests specific function APIs

[Assistant]
#ifdef __HARBOUR__
   #pragma -es0
#endif

PROCEDURE Main()

   LOCAL x
   LOCAL y

   x := ( 1 )
   ? x

   x := ( 1, 2 )
   ? x

   x := ( 1, 2, 3 )
   ? x

   x := ( ( 1, 2, 3 ) )
   ? x

   x := ( ( 1, 2, 3 ), ( 1, 2, 3 ) )
   ? x

   x := ( y := 10, y )
   ? x

   x := ( ( y := ( 1, 2, 3 ) ), y
      ? "Working"
   ELSE
      ? "Borken"
   ENDIF

   IF ( x := 10, y := ( x == 10 ) )
      ? "Working"
   ELSE
      ? "Broken"
   ENDIF

   IF ( Something( 1, 2, 3 ), .T. )
      ? "Working"
   ELSE
      ? "Broken"
   ENDIF

   ?

   ? IF( (.F.,0,.T.), ("some", "text", "IF Working"), ("some", "text", "Broken") )
   ? IF( (.T.,1,.F.), ("some", "text", "Broken"), ("some", "text", "IF Working") )

   ? IF( (.T. .OR. .F.), IF( .T., "Working", "Broken" ), IF( .F., "Broken", "Working" ) )

   RETURN

STATIC FUNCTION Something( x, y, z )

   Return( NIL )


[System] You are an expert Harbour (xBase/Clipper) programmer. Write clean, efficient code following Harbour conventions. Use proper Hungarian notation for variable names (c=character, n=numeric, l=logical, a=array, o=object, b=codeblock).

[User] Implement this Harbour module: Harbour contribution module 'xhb' (Extended Harbour functions): contrib/xhb/hbcomprs.prg. Provides functions: hb_Compress, hb_Uncompress, hb_CompressError, hb_CompressErrorDesc, hb_CompressBufLen. This file provides legacy compatibility functions

[Assistant]
#include "error.ch"

#include "hbzlib.ch"

THREAD STATIC t_nLastError := HB_ZLIB_RES_OK

FUNCTION hb_Compress( xPar1, xPar2, xPar3, xPar4, xPar5 )

   LOCAL nComprFactor
   LOCAL cSource
   LOCAL nSourceLen
   LOCAL nDestLen

   LOCAL lReturnByRef

   LOCAL oError

   IF HB_ISNUMERIC( xPar1 )
      nComprFactor := xPar1
      cSource      := xPar2
      nSourceLen   := xPar3
      nDestLen     := xPar5
      lReturnByRef := PCount() >= 4
   ELSE
      nComprFactor := HB_ZLIB_COMPRESSION_DEFAULT
      cSource      := xPar1
      nSourceLen   := xPar2
      nDestLen     := xPar4
      lReturnByRef := PCount() >= 3
   ENDIF

   IF ! HB_ISSTRING( cSource )
      oError := ErrorNew()

      oError:severity    := ES_ERROR
      oError:genCode     := EG_ARG
      oError:subSystem   := "BASE"
      oError:subCode     := 3012
      oError:args        := { cSource }

      Eval( ErrorBlock(), oError )
      RETURN NIL
   ENDIF

   IF ! HB_ISNUMERIC( nDestLen )
      nDestLen := NIL
   ENDIF

   IF HB_ISNUMERIC( nSourceLen ) .AND. nSourceLen >= 0 .AND. nSourceLen < Len( cSource )
      cSource := Left( cSource, nSourceLen )
   ENDIF

   IF lReturnByRef
      IF HB_ISNUMERIC( xPar1 )
         xPar4 := hb_ZCompress( cSource, nDestLen, @t_nLastError, nComprFactor )
         hb_default( @xPar4, "" )
         xPar5 := Len( xPar4 )
      ELSE
         xPar3 := hb_ZCompress( cSource, nDestLen, @t_nLastError, nComprFactor )
         hb_default( @xPar3, "" )
         xPar4 := Len( xPar3 )
      ENDIF
      RETURN t_nLastError
   ENDIF

   RETURN hb_ZCompress( cSource, nDestLen, @t_nLastError, nComprFactor )

FUNCTION hb_Uncompress( nDestLen, cSource, nSourceLen,  cDest )

   LOCAL oError

   IF ! HB_ISNUMERIC( nDestLen ) .OR. ;
      ! HB_ISSTRING( cSource )

      oError := ErrorNew()

      oError:severity    := ES_ERROR
      oError:genCode     := EG_ARG
      oError:subSystem   := "BASE"
      oError:subCode     := 3012
      oError:args        := { nDestLen }

      Eval( ErrorBlock(), oError )
      RETURN NIL
   ENDIF

   IF HB_ISNUMERIC( nSourceLen ) .AND. nSourceLen >= 0 .AND. nSourceLen < Len( cSource )
      cSource := Left( cSource, nSourceLen )
   ENDIF

   IF PCount() >= 4
      cDest := hb_ZUncompress( cSource, nDestLen, @t_nLastError )
      RETURN t_nLastError
   ENDIF

   RETURN hb_ZUncompress( cSource, nDestLen, @t_nLastError )

FUNCTION hb_CompressError()
   RETURN t_nLastError

FUNCTION hb_CompressErrorDesc( nError )
   RETURN hb_ZError( nError )

FUNCTION hb_CompressBufLen( nSrcLen )

   LOCAL nRet

   hb_default( @nSrcLen, 0 )

   nRet := nSrcLen
   nRet += nRet / 100


[System] You are an expert Harbour (xBase/Clipper) programmer. Write clean, efficient code following Harbour conventions. Use proper Hungarian notation for variable names (c=character, n=numeric, l=logical, a=array, o=object, b=codeblock).

[User] Write a Harbour program with procedures: Main. Harbour contribution module 'hbssl' (OpenSSL wrapper for SSL/TLS encryption): contrib/hbssl/tests/bio.prg. Contains procedures: Main. This file implements security and encryption functions

[Assistant]
#require "hbssl"

PROCEDURE Main()

   LOCAL bio

   SSL_init()

   ? bio := BIO_new_fd( 1, HB_BIO_NOCLOSE )
   ? "BIO_WRITE", BIO_write( bio, "Hello world!" + hb_eol() )
   ? "BIO_FLUSH", BIO_flush( bio )
   ? "BIO_FREE", BIO_free( bio )

   ? bio := BIO_new_file( "bio_test.txt", "a+" )
   ? "BIO_WRITE", BIO_write( bio, "Hello world!" + hb_eol() )
   ? "BIO_FLUSH", BIO_flush( bio )
   ? "BIO_FREE", BIO_free( bio )

   RETURN


[System] You are an expert Harbour (xBase/Clipper) programmer. Write clean, efficient code following Harbour conventions. Use proper Hungarian notation for variable names (c=character, n=numeric, l=logical, a=array, o=object, b=codeblock).

[User] Implement this Harbour module: Harbour contribution module 'hbct' (CA-Tools compatibility library): contrib/hbct/tests/strdiff.prg. Contains procedures: Main. This file provides legacy compatibility functions

[Assistant]
#ifdef __HARBOUR__
#require "hbct"
#endif

PROCEDURE Main()

   ctinit()

   ? "Begin test of StrDiff()"
   ?

   ? "Simple tests:"

   ? '  StrDiff( "ABC", "ADC" ) == 3 ?  -> ', StrDiff( "ABC", "ADC" )
   ? '  StrDiff( "ABC", "AEC" ) == 3 ?  -> ', StrDiff( "ABC", "AEC" )
   ? '  StrDiff( "CBA", "ABC" ) == 6 ?  -> ', StrDiff( "CBA", "ABC" )
   ? '  StrDiff( "ABC", "AXBC" ) == 1 ? -> ', StrDiff( "ABC", "AXBC" )
   ? '  StrDiff( "AXBC", "ABC" ) == 6 ? -> ', StrDiff( "AXBC", "ABC" )
   ? '  StrDiff( "AXBC", "ADC" ) == 9 ? -> ', StrDiff( "AXBC", "ADC" )

   ? "End test of StrDiff()"
   ?

   ctexit()

   RETURN


[System] You are an expert Harbour (xBase/Clipper) programmer. Write clean, efficient code following Harbour conventions. Use proper Hungarian notation for variable names (c=character, n=numeric, l=logical, a=array, o=object, b=codeblock).

[User]
Write the following Harbour (xBase/Clipper) code:

Harbour contribution module 'hbnf' (NanForum Toolkit - legacy Clipper compatibility functions): contrib/hbnf/acctyear.prg. Provides functions: ft_AcctYear. This file provides legacy compatibility functions

[Assistant]
FUNCTION ft_AcctYear( dGivenDate )

   LOCAL nYTemp, aRetVal

   IF ! HB_ISDATE( dGivenDate )
      dGivenDate := Date()
   ENDIF

   aRetVal      := ft_Year( dGivenDate )
   nYTemp       := Val( aRetVal[ 1 ] )
   aRetVal[ 2 ] := ft_AcctAdj( aRetVal[ 2 ] )
   aRetVal[ 3 ] := ft_AcctAdj( aRetVal[ 3 ], .T. )

   IF dGivenDate < aRetVal[ 2 ]

      aRetVal    := ft_Year( ft_MAdd( dGivenDate, -1 ) )
      nYTemp--
      aRetVal[ 2 ] := ft_AcctAdj( aRetVal[ 2 ] )
      aRetVal[ 3 ] := ft_AcctAdj( aRetVal[ 3 ], .T. )

   ELSEIF dGivenDate > aRetVal[ 3 ]

      aRetVal    := ft_Year( ft_MAdd( dGivenDate, 1 ) )
      nYTemp++
      aRetVal[ 2 ] := ft_AcctAdj( aRetVal[ 2 ] )
      aRetVal[ 3 ] := ft_AcctAdj( aRetVal[ 3 ], .T. )

   ENDIF

   aRetVal[ 1 ] := Str( nYTemp, 4 )

   RETURN aRetVal


[System] You are an expert Harbour (xBase/Clipper) programmer. Write clean, efficient code following Harbour conventions. Use proper Hungarian notation for variable names (c=character, n=numeric, l=logical, a=array, o=object, b=codeblock).

[User] Generate Harbour code for: Header file for contribution module 'xhb' (Extended Harbour functions): contrib/xhb/xhbver.ch. Defines 10 constants including: HB_VERX_CH_, _HB_VER_MAJOR, _HB_VER_MINOR, _HB_VER_REVISION, _HB_VER_LEX. Defines Harbour internal constants and macros

[Assistant]
#ifndef HB_VERX_CH_
#define HB_VERX_CH_

#define _HB_VER_MAJOR                1
#define _HB_VER_MINOR                2
#define _HB_VER_REVISION             3
#define _HB_VER_LEX                  4
#define _HB_VER_AS_STRING            5
#define _HB_PCODE_VER                6
#define _HB_VER_COMPILER             7
#define _HB_VER_PLATFORM             8
#define _HB_VER_BUILD_DATE           9
#define _HB_VER_BUILD_TIME          10
#define _HB_VER_LENTRY              11
#define _HB_VER_CHLCVS              12
#define _HB_VER_C_USR               13
#define _HB_VER_L_USR               14
#define _HB_VER_PRG_USR             15
#define _HB_EXTENSION               16
#define _HB_C52_UNDOC               17
#define _HB_C52_STRICT              18
#define _HB_COMPAT_C53              19
#define _HB_COMPAT_XPP              20
#define _HB_COMPAT_VO               21
#define _HB_COMPAT_FLAGSHIP         22
#define _HB_COMPAT_FOXPRO           23
#define _HB_COMPAT_DBASE            24
#define _HB_HARBOUR_OBJ_GENERATION  25
#define _HB_HARBOUR_STRICT_ANSI_C   26
#define _HB_CPLUSPLUS               27
#define _HB_HARBOUR_YYDEBUG         28
#define _HB_SYMBOL_NAME_LEN         29
#define _HB_MULTITHREAD             30
#define _HB_VM_OPTIMIZATION         31
#define _HB_LANG_ID                 32
#define _HB_ARRAY_MODE              33
#define _HB_CREDITS                 34
#define _HB_VER_LAST                35

#endif


[System] You are an expert Harbour (xBase/Clipper) programmer. Write clean, efficient code following Harbour conventions. Use proper Hungarian notation for variable names (c=character, n=numeric, l=logical, a=array, o=object, b=codeblock).

[User]
Here is a Harbour (xBase/Clipper) implementation:

Header file for contribution module 'xhb' (Extended Harbour functions): contrib/xhb/hbctypes.ch. Defines 10 constants including: __HBCTYPES_CH_, CTYPE_VOID, CTYPE_CHAR, CTYPE_UNSIGNED_CHAR, CTYPE_CHAR_PTR. Defines error handling constants and codes

[Assistant]
#ifndef __HBCTYPES_CH_
#define __HBCTYPES_CH_

#define CTYPE_VOID                  0

#define CTYPE_CHAR                  1
#define CTYPE_UNSIGNED_CHAR         -1
#define CTYPE_CHAR_PTR              10
#define CTYPE_UNSIGNED_CHAR_PTR     -10

#define CTYPE_SHORT                 2
#define CTYPE_UNSIGNED_SHORT        -2
#define CTYPE_SHORT_PTR             20
#define CTYPE_UNSIGNED_SHORT_PTR    -20

#define CTYPE_INT                   3
#define CTYPE_UNSIGNED_INT          -3
#define CTYPE_INT_PTR               30
#define CTYPE_UNSIGNED_INT_PTR      -30

#define CTYPE_LONG                  4
#define CTYPE_UNSIGNED_LONG         -4
#define CTYPE_LONG_PTR              40
#define CTYPE_UNSIGNED_LONG_PTR     -40

#define CTYPE_FLOAT                 5
#define CTYPE_FLOAT_PTR             50

#define CTYPE_DOUBLE                6
#define CTYPE_DOUBLE_PTR            60

#define CTYPE_VOID_PTR              7

#define CTYPE_STRUCTURE             1000
#define CTYPE_STRUCTURE_PTR         10000

#endif


[System] You are an expert Harbour (xBase/Clipper) programmer. Write clean, efficient code following Harbour conventions. Use proper Hungarian notation for variable names (c=character, n=numeric, l=logical, a=array, o=object, b=codeblock).

[User] Write a Harbour program with procedures: Main, test. Harbour test program: tests/str.prg. Contains procedures: Main, test. This test file exercises basic Harbour language features

[Assistant]
PROCEDURE Main()

   ? "Running with SET FIXED OFF (the default setting):"
   ?
   test()
   WAIT "Pause before running again with SET FIXED ON:"
   ? "Running with SET FIXED ON:"
   ?
   Set( _SET_FIXED, .T. )
   test()

   RETURN

PROCEDURE test()

   LOCAL a := 15.1
   LOCAL b := 10.0002575
   LOCAL nI, c, d

   ?? "1: "
   ?? 10
   ?? a
   ?? -a
   ?? b
   ?? -b
   ?

   ?? "2: "
   ?? a + b
   ?? a - b
   ?? a
   ?? "3: "
   ?? a % b
   ?? a ^ b
   ?

   c := a
   ?? "4: "
   ?? Str( c )
   ?? Str( d )
   ?

   ?? "5: "
   ?? Str( c + d )
   ?? Str( c - d )
   ?? Str( c
   ?? "6: "
   ?? a + b + c
   ?? c - b - a
   ?? b
      ?? Str( 6 + nI ) + ": "
      ?? 10 ^ nI + ( 1.02
   ?? "27: "
   ?? Str( a ), a
   ?

   ?? "28: "
   ?? Str( b ), b
   ?

   ?? "29: "
   ?? Str( b, 15 )
   ?

   ?? "30: "
   ?? Str( b, 20, 5 )
   ?

   ?? "31: "
   ?? Str( b, 20, 10 )
   ?

   ?? "32: "
   ?? Str( b, 5, 10 )
   ?

   ?? "33: "
   ?? Str( b, 20, -10 )
   ?

   ?? "34: "
   ?? Str( b, -12, 7 )
   ?

   ?? "35: "
   ?? Str( b, 0 )
   ?

   ?
   a := 15.1004
   ?? "36: "
   ?? Str( a ), a
   ?

   RETURN


[System] You are an expert Harbour (xBase/Clipper) programmer. Write clean, efficient code following Harbour conventions. Use proper Hungarian notation for variable names (c=character, n=numeric, l=logical, a=array, o=object, b=codeblock).

[User]
Write the following Harbour (xBase/Clipper) code:

Harbour header file: include/hboo.ch. Defines 10 constants including: HB_OO_CH_, HB_MSGLISTALL, HB_MSGLISTCLASS, HB_MSGLISTPURE, HB_OO_CLSTP_EXPORTED. Defines error handling constants and codes

[Assistant]
#ifndef HB_OO_CH_
#define HB_OO_CH_

#define HB_MSGLISTALL    0
#define HB_MSGLISTCLASS  1
#define HB_MSGLISTPURE   2

#define HB_OO_CLSTP_EXPORTED        1
#define HB_OO_CLSTP_PROTECTED       2
#define HB_OO_CLSTP_HIDDEN          4
#define HB_OO_CLSTP_CTOR            8
#define HB_OO_CLSTP_READONLY       16
#define HB_OO_CLSTP_SHARED         32
#define HB_OO_CLSTP_CLASS          64
#define HB_OO_CLSTP_SUPER         128
#define HB_OO_CLSTP_PERSIST       256
#define HB_OO_CLSTP_NONVIRTUAL    512
#define HB_OO_CLSTP_OVERLOADED   1024
#define HB_OO_CLSTP_SYNC         2048

#define HB_OO_MSG_METHOD        0
#define HB_OO_MSG_DATA          1
#define HB_OO_MSG_CLASSDATA     2
#define HB_OO_MSG_INLINE        3
#define HB_OO_MSG_VIRTUAL       4
#define HB_OO_MSG_SUPER         5
#define HB_OO_MSG_ONERROR       6
#define HB_OO_MSG_CLSMTHD       7
#define HB_OO_MSG_ASSIGN        8
#define HB_OO_MSG_ACCESS        9
#define HB_OO_MSG_CLSASSIGN    10
#define HB_OO_MSG_CLSACCESS    11
#define HB_OO_MSG_REALCLASS    12
#define HB_OO_MSG_DESTRUCTOR   13
#define HB_OO_MSG_INITIALIZED  14
#define HB_OO_MSG_PERFORM      15
#define HB_OO_MSG_DELEGATE     16

#define HB_OO_PROPERTY          32
#define HB_OO_MSG_PROPERTY      HB_OO_PROPERTY + HB_OO_MSG_DATA
#define HB_OO_MSG_CLASSPROPERTY HB_OO_PROPERTY + HB_OO_MSG_CLASSDATA

#define HB_OO_DATA_SYMBOL       1
#define HB_OO_DATA_VALUE        2
#define HB_OO_DATA_TYPE         3
#define HB_OO_DATA_SCOPE        4

#define HB_OO_CLSD_SYMBOL       1
#define HB_OO_CLSD_VALUE        2
#define HB_OO_CLSD_TYPE         3
#define HB_OO_CLSD_SCOPE        4

#define HB_OO_MTHD_SYMBOL       1
#define HB_OO_MTHD_PFUNCTION    2
#define HB_OO_MTHD_SCOPE        3

#define HB_OO_CLSM_SYMBOL       1
#define HB_OO_CLSM_PFUNCTION    2
#define HB_OO_CLSM_SCOPE        3

#define HB_OO_DELEG_SYMBOL      1
#define HB_OO_DELEG_MESSAGE     2
#define HB_OO_DELEG_OBJECT      3
#define HB_OO_DELEG_SCOPE       4

#endif


[System] You are an expert Harbour (xBase/Clipper) programmer. Write clean, efficient code following Harbour conventions. Use proper Hungarian notation for variable names (c=character, n=numeric, l=logical, a=array, o=object, b=codeblock).

[User]
Write the following Harbour (xBase/Clipper) code:

Header file for contribution module 'hbnf' (NanForum Toolkit - legacy Clipper compatibility functions): contrib/hbnf/ftint86.ch. Defines 10 constants including: __FTINT86_CH__, INT86_MAX_REGS, AX, BX, CX. Declares 1 preprocessor translations

[Assistant]
#ifndef __FTINT86_CH__
#define __FTINT86_CH__

#define INT86_MAX_REGS      10

#define AX                  1
#define BX                  2
#define CX                  3
#define DX                  4
#define SI                  5
#define DI                  6
#define BP                  7
#define DS                  8
#define ES                  9
#define FLAGS               10

#define FLAG_CARRY          0
#define FLAG_PARITY         2
#define FLAG_AUX            4
#define FLAG_ZERO           6
#define FLAG_SIGN           7
#define FLAG_TRAP           8
#define FLAG_INT            9
#define FLAG_DIR            10
#define FLAG_OFLOW          11

#translate MAKEHI( <X> )        => ( ( <X> )


[System] You are an expert Harbour (xBase/Clipper) programmer. Write clean, efficient code following Harbour conventions. Use proper Hungarian notation for variable names (c=character, n=numeric, l=logical, a=array, o=object, b=codeblock).

[User] Define Harbour macros and constants: Harbour header file: include/directry.ch. Defines 7 constants including: _DIRECTRY_CH, F_NAME, F_SIZE, F_DATE, F_TIME. Defines file I/O constants

[Assistant]
#ifndef _DIRECTRY_CH
#define _DIRECTRY_CH

#define F_NAME          1
#define F_SIZE          2
#define F_DATE          3
#define F_TIME          4
#define F_ATTR          5

#define F_LEN           5

#endif


[System] You are an expert Harbour (xBase/Clipper) programmer. Write clean, efficient code following Harbour conventions. Use proper Hungarian notation for variable names (c=character, n=numeric, l=logical, a=array, o=object, b=codeblock).

[User] Implement this Harbour module: Harbour test program: tests/hsx.prg. Contains procedures: Main. This test file tests specific function APIs

[Assistant]
#include "dbinfo.ch"

PROCEDURE Main()

   FIELD FIRST, LAST, STREET, CITY
   LOCAL n, hs

   IF AScan( rddList( 1 ), "RMDBFCDX" ) != 0
      rddSetDefault( "RMDBFCDX" )
   ENDIF

   USE test shared
   hs := hs_Index( "test", "FIRST+LAST+STREET+CITY", 2, 0, , .T., 3 )

   hs_Set( hs, "SHERMAN" )
   WHILE ( n := hs_Next( hs ) ) > 0
      dbGoto( n )
      IF hs_Verify( hs ) > 0
         ? RTrim( FIRST + LAST + STREET + CITY )
      ENDIF
   ENDDO
   WAIT

   IF dbInfo( DBI_RM_SUPPORTED )

      hs_Filter( hs, "SHERMAN" )
      dbGoTop()
      Browse()
   ENDIF
   hs_Close( hs )

   RETURN


[System] You are an expert Harbour (xBase/Clipper) programmer. Write clean, efficient code following Harbour conventions. Use proper Hungarian notation for variable names (c=character, n=numeric, l=logical, a=array, o=object, b=codeblock).

[User] Generate Harbour code for: Harbour Runtime Library file: src/rtl/browse.prg. Provides functions: Browse, DoGet, ExitKey, Skipped. Contains procedures: StatLine, FreshOrder. This file provides utility functions

[Assistant]
#include "box.ch"
#include "inkey.ch"
#include "setcurs.ch"

FUNCTION Browse( nTop, nLeft, nBottom, nRight )

   LOCAL oBrw
   LOCAL lContinue, lAppend, lKeyPressed, lRefresh
   LOCAL n, nOldCursor, nKey
   LOCAL cOldScreen
   LOCAL bAction

   IF ! Used()
      RETURN .F.
   ENDIF

   lAppend := lKeyPressed := lRefresh := .F.

   IF PCount() < 4
      nTop    := 1
      nLeft   := 0
      nBottom := MaxRow()
      nRight  := MaxCol()
   ENDIF

   DispBegin()

   nOldCursor := SetCursor( SC_NONE )
   cOldScreen := SaveScreen( nTop, nLeft, nBottom, nRight )

   hb_DispBox( nTop, nLeft, nBottom, nRight, HB_B_DOUBLE_SINGLE_UNI )
   hb_DispOutAtBox( nTop + 3, nLeft, hb_UTF8ToStrBox( "╞" ) )
   hb_DispOutAtBox( nTop + 3, nRight, hb_UTF8ToStrBox( "╡" ) )
   hb_DispOutAt( nTop + 1, nLeft + 1, Space( nRight - nLeft - 1 ) )

   oBrw := TBrowseDB( nTop + 2, nLeft + 1, nBottom - 1, nRight - 1 )
   oBrw:HeadSep := " " + hb_UTF8ToStrBox( "═" )
   oBrw:SkipBlock := {| nRecs | Skipped( nRecs, lAppend ) }

   FOR n := 1 TO FCount()
      oBrw:AddColumn( TBColumnNew( FieldName( n ), FieldBlock( FieldName( n ) ) ) )
   NEXT

   IF Eof()
      dbGoTop()
   ENDIF

   oBrw:ForceStable()

   DispEnd()

   IF LastRec() == 0
      nKey := K_DOWN
      lKeyPressed := .T.
   ENDIF

   lContinue := .T.

   DO WHILE lContinue

      DO WHILE ! lKeyPressed .AND. ! oBrw:Stabilize()
         lKeyPressed := ( nKey := Inkey() ) != 0
      ENDDO

      IF lKeyPressed
         lKeyPressed := .F.
      ELSE
         IF oBrw:HitBottom .AND. ( ! lAppend .OR. RecNo() != LastRec() + 1 )
            IF lAppend
               oBrw:RefreshCurrent()
               oBrw:ForceStable()
               dbGoBottom()
            ELSE
               lAppend := .T.
               SetCursor( iif( ReadInsert(), SC_INSERT, SC_NORMAL ) )
            ENDIF
            oBrw:Down()
            oBrw:ForceStable()
            oBrw:ColorRect( { oBrw:RowPos, 1, oBrw:RowPos, oBrw:ColCount }, ;
               { 2, 2 } )
         ENDIF

         StatLine( oBrw, lAppend )

         oBrw:ForceStable()

         nKey := Inkey( 0 )
         IF ( bAction := SetKey( nKey ) ) != NIL
            Eval( bAction, ProcName( 1 ), ProcLine( 1 ), "" )
            LOOP
         ENDIF
      ENDIF

      SWITCH nKey

#ifdef HB_COMPAT_C53
      CASE K_LBUTTONDOWN
      CASE K_LDBLCLK
         TBMouse( oBrw, MRow(), MCol() )
         EXIT
#endif
#ifndef HB_CLP_STRICT
      CASE K_MWFORWARD
#endif
      CASE K_UP
         IF lAppend
            lRefresh := .T.
         ELSE
            oBrw:Up()
         ENDIF
         EXIT

#ifndef HB_CLP_STRICT
      CASE K_MWBACKWARD
#endif
      CASE K_DOWN
         IF lAppend
            oBrw:HitBottom := .T.
         ELSE
            oBrw:Down()
         ENDIF
         EXIT

      CASE K_PGUP
         IF lAppend
            lRefresh := .T.
         ELSE
            oBrw:PageUp()
         ENDIF
         EXIT

      CASE K_PGDN
         IF lAppend
            oBrw:HitBottom := .T.
         ELSE
            oBrw:PageDown()
         ENDIF
         EXIT

      CASE K_CTRL_PGUP
         IF lAppend
            lRefresh := .T.
         ELSE
            oBrw:GoTop()
         ENDIF
         EXIT

      CASE K_CTRL_PGDN
         IF lAppend
            lRefresh := .T.
         ELSE
            oBrw:GoBottom()
         ENDIF
         EXIT

      CASE K_LEFT
         oBrw:Left()
         EXIT

      CASE K_RIGHT
         oBrw:Right()
         EXIT

      CASE K_HOME
         oBrw:Home()
         EXIT

      CASE K_END
         oBrw:End()
         EXIT

      CASE K_CTRL_LEFT
         oBrw:panLeft()
         EXIT

      CASE K_CTRL_RIGHT
         oBrw:panRight()
         EXIT

      CASE K_CTRL_HOME
         oBrw:panHome()
         EXIT

      CASE K_CTRL_END
         oBrw:panEnd()
         EXIT

      CASE K_INS
         IF lAppend
            SetCursor( iif( ReadInsert( ! ReadInsert() ), ;
               SC_NORMAL, SC_INSERT ) )
         ENDIF
         EXIT

      CASE K_DEL
         IF RecNo() != LastRec() + 1
            IF Deleted()
               dbRecall()
            ELSE
               dbDelete()
            ENDIF
         ENDIF
         EXIT

      CASE K_ENTER
         IF lAppend .OR. RecNo() != LastRec() + 1
            lKeyPressed := ( nKey := DoGet( oBrw, lAppend ) ) != 0
         ELSE
            nKey := K_DOWN
            lKeyPressed := .T.
         ENDIF
         EXIT

      CASE K_ESC
         lContinue := .F.
         EXIT

      OTHERWISE
         IF ! hb_keyChar( nKey ) == ""
            hb_keyIns( nKey )
            nKey := K_ENTER
            lKeyPressed := .T.
         ENDIF
      ENDSWITCH

      IF lRefresh
         lRefresh := lAppend := .F.
         FreshOrder( oBrw )
         SetCursor( SC_NONE )
      ENDIF

   ENDDO

   RestScreen( nTop, nLeft, nBottom, nRight, cOldScreen )
   SetCursor( nOldCursor )

   RETURN .T.

STATIC PROCEDURE StatLine( oBrw, lAppend )

   LOCAL nTop   := oBrw:nTop - 1
   LOCAL nRight := oBrw:nRight

   LOCAL nRecNo := RecNo()
   LOCAL nLastRec := LastRec()

   hb_DispOutAt( nTop, nRight - 27, "Record " )

   IF nLastRec == 0 .AND. ! lAppend
      hb_DispOutAt( nTop, nRight - 20, "<none>               " )
   ELSEIF nRecNo == nLastRec + 1
      hb_DispOutAt( nTop, nRight - 40, "         " )
      hb_DispOutAt( nTop, nRight - 20, "                <new>" )
   ELSE
      hb_DispOutAt( nTop, nRight - 40, iif( Deleted(), "<Deleted>", "         " ) )
      hb_DispOutAt( nTop, nRight - 20, PadR( hb_ntos( nRecNo ) + "/" + ;
         hb_ntos( nLastRec ), 16 ) + ;
         iif( oBrw:HitTop, "<bof>", "     " ) )
   ENDIF

   RETURN

STATIC FUNCTION DoGet( oBrw, lAppend )

   LOCAL lScore, lExit, bIns, nCursor
   LOCAL oCol, oGet
   LOCAL cIndexKey, cForExp, xKeyValue
   LOCAL bIndexKey
   LOCAL lSuccess, nKey, xValue

   oBrw:HitTop := .F.
   StatLine( oBrw, lAppend )
   oBrw:ForceStable()

   lScore := Set( _SET_SCOREBOARD, .F. )
   lExit := Set( _SET_EXIT, .T. )
   bIns := SetKey( K_INS, {|| SetCursor( iif( ReadInsert( ! ReadInsert() ), ;
      SC_NORMAL, SC_INSERT ) ) } )
   nCursor := SetCursor( iif( ReadInsert(), SC_INSERT, SC_NORMAL ) )
   IF ! Empty( cIndexKey := IndexKey( 0 ) )
      xKeyValue := Eval( bIndexKey := hb_macroBlock( cIndexKey ) )
   ENDIF

   oCol := oBrw:GetColumn( oBrw:ColPos )
   xValue := Eval( oCol:Block )
   oGet := GetNew( Row(), Col(), ;
      {| xNewVal | iif( PCount() == 0, xValue, xValue := xNewVal ) }, ;
      "mGetVar", NIL, oBrw:ColorSpec )
   lSuccess := .F.
   IF ReadModal( { oGet } )
      IF lAppend .AND. RecNo() == LastRec() + 1
         dbAppend()
      ENDIF
      Eval( oCol:Block, xValue )

      IF ! lAppend .AND. ! Empty( cForExp := ordFor( IndexOrd() ) ) .AND. ;
         ! Eval( hb_macroBlock( cForExp ) )
         dbGoTop()
      ENDIF
      IF ! lAppend .AND. ! Empty( bIndexKey ) .AND. ! xKeyValue == Eval( bIndexKey )
         lSuccess := .T.
      ENDIF
   ENDIF

   IF lSuccess
      FreshOrder( oBrw )
      nKey := 0
   ELSE
      oBrw:RefreshCurrent()
      nKey := ExitKey( lAppend )
   ENDIF

   IF lAppend
      oBrw:ColorRect( { oBrw:RowPos, 1, oBrw:RowPos, oBrw:ColCount }, ;
         { 2, 2 } )
   ENDIF

   SetCursor( nCursor )
   SetKey( K_INS, bIns )
   Set( _SET_EXIT, lExit )
   Set( _SET_SCOREBOARD, lScore )

   RETURN nKey

STATIC FUNCTION ExitKey( lAppend )

   LOCAL nKey

   SWITCH nKey := LastKey()
   CASE K_PGDN
      RETURN iif( lAppend, 0, K_DOWN )
   CASE K_PGUP
      RETURN iif( lAppend, 0, K_UP )
   CASE K_DOWN
   CASE K_UP
      RETURN nKey
   ENDSWITCH

   RETURN iif( nKey == K_ENTER .OR. !( hb_keyChar( nKey ) == "" ), K_RIGHT, 0 )

STATIC PROCEDURE FreshOrder( oBrw )

   LOCAL nRec := RecNo()

   oBrw:RefreshAll()
   oBrw:ForceStable()

   IF nRec != LastRec() + 1
      DO WHILE RecNo() != nRec .AND. ! Bof()
         oBrw:Up()
         oBrw:ForceStable()
      ENDDO
   ENDIF

   RETURN

STATIC FUNCTION Skipped( nRecs, lAppend )

   LOCAL nSkipped := 0

   IF LastRec() != 0
      DO CASE


[System] You are an expert Harbour (xBase/Clipper) programmer. Write clean, efficient code following Harbour conventions. Use proper Hungarian notation for variable names (c=character, n=numeric, l=logical, a=array, o=object, b=codeblock).

[User]
Here is a Harbour (xBase/Clipper) implementation:

Harbour contribution module 'hbmisc' (Miscellaneous utility functions): contrib/hbmisc/tests/udpds.prg. Contains procedures: Main. This file provides utility functions

[Assistant]
#require "hbmisc"

PROCEDURE Main( cParam )

   LOCAL h

   IF ! hb_mtvm()
      ? "This sample should be compiled using MultiThread"
      RETURN
   ENDIF

   IF cParam == NIL
      ? "udpdstst {c|s|cs}"
      ? "Parameter:"
      ? "   s - run as a server"
      ? "   c - run as a client"
      RETURN
   ENDIF

   IF "S" $ Upper( cParam )
      IF ! Empty( h := hb_udpds_Start( 39999, "UDPDSDemo", NetName() + " " + hb_TSToStr( hb_DateTime() ) ) )
         hb_idleSleep( 0.1 )
      ENDIF
   ENDIF

   IF "C" $ Upper( cParam )
      ? hb_ValToExp( hb_udpds_Find( 39999, "UDPDSDemo" ) )
   ENDIF

   IF "S" $ Upper( cParam )
      ? "Press any key to stop server"
      Inkey( 0 )
      hb_udpds_Stop( h )
   ENDIF

   RETURN


[System] You are an expert Harbour (xBase/Clipper) programmer. Write clean, efficient code following Harbour conventions. Use proper Hungarian notation for variable names (c=character, n=numeric, l=logical, a=array, o=object, b=codeblock).

[User] Define Harbour macros and constants: Harbour test program: tests/mt/mttest10.prg. This test file tests specific function APIs

[Assistant]
#include "inkey.ch"

#ifdef __PLATFORM__WINDOWS
   REQUEST HB_GT_WVT_DEFAULT
   #define THREAD_GT hb_gtVersion()
#else
   REQUEST HB_GT_STD_DEFAULT
   #define THREAD_GT "XWC"
#endif

proc main( cGT )
   local i, aThreads

   if ! hb_mtvm()
      ? "This program needs HVM with MT support"
      quit
   endif

   if empty( cGT )
      cGT := THREAD_GT
   endif

   if  cGT == "QTC" .and. ! cGT == hb_gtVersion()

      hb_gtReload( cGT )
   endif

   ? "Starting threads..."
   aThreads := {}
   for i := 1 to 3
      aadd( aThreads, hb_threadStart( @thFunc(), cGT ) )
      ? i, "=>", atail( aThreads )
   next

   ? "Waiting for threads"
   while inkey() != K_ESC
      if hb_threadWait( aThreads, 0.1, .T. ) == len( aThreads )
         wait
         exit
      endif
      ?? "."
   enddo
return

proc thFunc( cGT )

   hb_gtReload( cGT )
   if ! dbExists( "test" ) .and. dbExists( "../test" )
      use ../test shared
   else
      use test shared
   endif
   browse()
return


[System] You are an expert Harbour (xBase/Clipper) programmer. Write clean, efficient code following Harbour conventions. Use proper Hungarian notation for variable names (c=character, n=numeric, l=logical, a=array, o=object, b=codeblock).

[User] Generate Harbour code for: Harbour contribution module 'hbct' (CA-Tools compatibility library): contrib/hbct/tests/charlist.prg. Contains procedures: Main. This file provides legacy compatibility functions

[Assistant]
#ifdef __HARBOUR__
#require "hbct"
#endif

PROCEDURE Main()

   ctinit()

   ? "Begin test of CharList()"
   ?

   ? "Simple tests:"
   ? '  CharList( "Hello World !" ) == "Helo Wrd!" ? -> "' + CharList( "Hello World !" ) + '"'
   ? '  CharList( NIL ) == "" ? -> "' + CharList( NIL ) + '"'

   ? "End test of CharList()"
   ?

   ctexit()

   RETURN


[System] You are an expert Harbour (xBase/Clipper) programmer. Write clean, efficient code following Harbour conventions. Use proper Hungarian notation for variable names (c=character, n=numeric, l=logical, a=array, o=object, b=codeblock).

[User] Generate Harbour code for: Harbour test program: tests/gfx2.prg. Contains procedures: Main. This test file tests specific function APIs

[Assistant]
#include "hbgtinfo.ch"
#include "hbgfx.ch"

PROCEDURE Main()

   LOCAL nRed, nGreen, nBlue

#if defined( __HBSCRIPT__HBSHELL )
#  if defined( __PLATFORM__WINDOWS )
      hbshell_gtSelect( "GTWVT" )
#  elif defined( __PLATFORM__UNIX )
      hbshell_gtSelect( "GTXWC" )
#  endif
#else
#  if defined( __PLATFORM__WINDOWS )
     REQUEST HB_GT_WVT_DEFAULT
#  elif defined( __PLATFORM__UNIX )
     REQUEST HB_GT_XWC_DEFAULT
#  endif
#endif

   ? "GT" + hb_gtVersion()
   IF ! hb_gtInfo( HB_GTI_ISGRAPHIC )
      ? "You are using a non graphics capable gt"
      QUIT
   ENDIF

   nRed   := hb_gfxMakeColor( 200, 32, 32 )
   nGreen := hb_gfxMakeColor( 32, 200, 32 )
   nBlue  := hb_gfxMakeColor( 32, 32, 200 )

   hb_gfxLine( 100, 300, 200, 400, nRed )
   WAIT
   hb_gfxLine( 200, 300, 100, 400, nBlue )
   WAIT
   hb_gfxLine( 100, 420, 200, 320, nGreen )
   WAIT
   hb_gfxLine( 200, 420, 100, 320, nGreen )
   WAIT
   hb_gfxRect( 100, 300, 200, 420, nRed )
   WAIT
   hb_gfxRect(  90, 290, 210, 430, nBlue )
   WAIT
   hb_gfxLine( 100, 450, 100, 550, nRed )
   hb_gfxLine( 100, 550, 200, 550, nRed )
   hb_gfxLine( 200, 550, 200, 450, nRed )
   hb_gfxLine( 200, 450, 100, 450, nRed )
   WAIT
   hb_gfxRect( 100, 450, 200, 550, nGreen )
   WAIT

   hb_gfxFilledRect( 220, 300, 320, 400, nRed )
   WAIT
   hb_gfxRect( 219, 449, 321, 551, nRed )
   WAIT
   hb_gfxFilledRect( 320, 550, 220, 450, nGreen )
   WAIT
   hb_gfxRect( 230, 310, 310, 390, nGreen )
   WAIT
   hb_gfxCircle( 270, 350, 40, nBlue )
   WAIT
   hb_gfxFilledCircle( 270, 500, 50, nBlue )
   WAIT

   hb_gfxRect( 329, 299, 391, 501, nRed )
   hb_gfxFilledRect( 330, 300, 390, 500, nBlue )
   WAIT
   hb_gfxFilledEllipse( 360, 400, 30, 100, nGreen )
   WAIT
   hb_gfxEllipse( 360, 400, 15, 50, nRed )
   WAIT

   hb_gfxRect( 0, 0, hb_gtInfo( HB_GTI_SCREENHEIGHT ) - 1, ;
                     hb_gtInfo( HB_GTI_SCREENWIDTH ) - 1, nGreen )
   WAIT

   RETURN


[System] You are an expert Harbour (xBase/Clipper) programmer. Write clean, efficient code following Harbour conventions. Use proper Hungarian notation for variable names (c=character, n=numeric, l=logical, a=array, o=object, b=codeblock).

[User]
Here is a Harbour (xBase/Clipper) implementation:

Harbour test program: tests/tb1.prg. Contains procedures: Main, hb_idleSleep. This test file tests specific function APIs

[Assistant]
#include "inkey.ch"
#include "button.ch"
#include "setcurs.ch"
#include "box.ch"

#ifdef __HARBOUR__
   #define _DRAW_1 hb_UTF8ToStr( "├" )
   #define _DRAW_2 hb_UTF8ToStr( "┤" )
   #define _DRAW_3 hb_UTF8ToStrBox( "┐ ┌─" )
   #define _DRAW_4 hb_UTF8ToStrBox( "┘ └─" )
   #define _DRAW_5 hb_UTF8ToStrBox( "│ │" )
   #define _DRAW_6 hb_UTF8ToStrBox( "┐ ┌─┤HIDE├─" )
   #define _DRAW_7 hb_UTF8ToStrBox( "╖ ╓─┤HIDE├─" )
   #define _DRAW_8 hb_UTF8ToStrBox( "╜ ╙─" )
   #define _DRAW_9 hb_UTF8ToStrBox( "║ ║" )
#else
   #define _DRAW_1 Chr( 195 )
   #define _DRAW_2 Chr( 180 )
   #define _DRAW_3 Chr( 191 ) + " " + Chr( 218 ) + Chr( 196 )
   #define _DRAW_4 Chr( 217 ) + " " + Chr( 192 ) + Chr( 196 )
   #define _DRAW_5 Chr( 179 ) + " " + Chr( 179 )
   #define _DRAW_6 Chr( 191 ) + " " + Chr( 218 ) + Chr( 196 ) + "HIDE" + Chr( 195 ) + Chr( 196 )
   #define _DRAW_7 Chr( 183 ) + " " + Chr( 214 ) + Chr( 196 ) + "HIDE" + Chr( 195 ) + Chr( 196 )
   #define _DRAW_8 Chr( 189 ) + " " + Chr( 211 ) + Chr( 196 )
   #define _DRAW_9 Chr( 186 ) + " " + Chr( 186 )
   #define hb_keyCode( n ) Asc( n )
#endif

PROCEDURE Main()

   STATIC s_nCount := 0
   STATIC s_nPos   := 1
   STATIC s_nSize  := 100

   LOCAL nTop, nLeft, nBottom, nRight
   LOCAL cColor
   LOCAL oBrw, oCol1, oCol2, oCol3, oCol4
   LOCAL nKey, nCol

   nTop    := 2
   nLeft   := 10
   nBottom := 20
   nRight  := 70
   cColor  := "W+/R,G+/BR,RG+/B,BG+/G,N/GR,GR+/BG,B/GR*"

   Set( _SET_DATEFORMAT, "yyyy-mm-dd" )

#ifdef _SET_EVENTMASK
   Set( _SET_EVENTMASK, INKEY_ALL )
   MSetCursor( .T. )
#endif

   CLS
#ifdef HB_B_DOUBLE_SINGLE_UNI
   DispBox( nTop, nLeft, nBottom, nRight, HB_B_DOUBLE_SINGLE_UNI, cColor )
#else
   DispBox( nTop, nLeft, nBottom, nRight, B_DOUBLE_SINGLE, cColor )
#endif
   oBrw := TBrowseNew( nTop + 1, nLeft + 1, nBottom - 1, nRight - 1 )
   DispOutAt( nTop + 3,    nLeft,  _DRAW_1, cColor )
   DispOutAt( nTop + 3,    nRight, _DRAW_2, cColor )
   DispOutAt( nBottom - 2, nLeft,  _DRAW_1, cColor )
   DispOutAt( nBottom - 2, nRight, _DRAW_2, cColor )

   oBrw:colorSpec := cColor
   oBrw:headSep := _DRAW_3
   oBrw:footSep := _DRAW_4
   oBrw:colSep  := _DRAW_5

   oBrw:SkipBlock     := {| n | hb_idleSleep( 0.2 ), ;
      n := iif( n < 0, Max( n, 1 - s_nPos ), ;
      Min( s_nSize - s_nPos, n ) ), ;
      s_nPos += n, n }
   oBrw:GoTopBlock    := {|| s_nPos := 1 }
   oBrw:GoBottomBlock := {|| s_nPos := s_nSize }

   oCol1 := TBColumnNew( "COL;1;", {|| s_nPos } )
   oCol1:defColor := { 2, 1, 3, 4 }
   oCol1:footing := "position"
   oCol1:colorBlock := {| val | { val % 5 + 1, val % 3 + 2 } }

   oCol2 := TBColumnNew( "COL;2",  {|| s_nCount++ } )
   oCol2:defColor := { 3, 4, 5, 6 }
   oCol2:footing := "counter"
   oCol2:headSep := _DRAW_6

   oCol3 := TBColumnNew( "COL 3",  {|| s_nPos % 3 == 0 } )
   oCol3:defColor := { 5, 6, 2, 3 }
   oCol3:footing := "logical"
   oCol3:picture := "@YR [Y]"
   oCol3:headSep := _DRAW_7
   oCol3:footSep := _DRAW_8
   oCol3:colSep  := _DRAW_9

   oCol4 := TBColumnNew( "   SHOW;   ALL",  {|| Date() - s_nPos } )
   oCol4:defColor := { 6, 3, 4, 2 }
   oCol4:footing := "date"

   oBrw:addColumn( oCol1 )
   oBrw:addColumn( oCol2 )
   oBrw:addColumn( oCol3 )
   oBrw:addColumn( oCol4 )

   oBrw:goBottom()

   WHILE .T.
      WHILE ! oBrw:stabilize() .AND. NextKey() == 0
      ENDDO
      nKey := Inkey( 0 )
      IF nKey == K_ESC
         EXIT
      ELSEIF nKey == K_INS
         oBrw:colorRect( { oBrw:rowPos, 1, oBrw:rowPos, 4 }, { 7, 6 } )
      ELSEIF nKey == K_DEL
         oBrw:refreshCurrent()
      ELSEIF nKey >= hb_keyCode( "0" ) .AND. nKey <= hb_keyCode( "3" )
         oBrw:freeze := nKey - hb_keyCode( "0" )
      ELSEIF nKey == K_LBUTTONDOWN .AND. ;
            oBrw:HitTest( MRow(), MCol() ) == HTHEADSEP .AND. ;
            ( ( nCol := oBrw:mColPos ) == 2 .OR. nCol == 3 )
         IF nCol == 2
            oCol2:width := 0
         ELSE
            oCol3:width := 0
         ENDIF
         oBrw:configure()
      ELSEIF nKey == K_LBUTTONDOWN .AND. ;
            oBrw:HitTest( MRow(), MCol() ) == HTHEADING .AND. ;
            oBrw:mColPos == 4
         oCol2:width := 10
         oCol3:width := 7
         oBrw:configure()
      ELSE
         oBrw:applyKey( nKey )
      ENDIF
   ENDDO

   RETURN

#ifndef __HARBOUR__

PROCEDURE hb_idleSleep( n )

   n += Seconds()
   WHILE Seconds() < n
   ENDDO

   RETURN

#endif


[System] You are an expert Harbour (xBase/Clipper) programmer. Write clean, efficient code following Harbour conventions. Use proper Hungarian notation for variable names (c=character, n=numeric, l=logical, a=array, o=object, b=codeblock).

[User]
Here is a Harbour (xBase/Clipper) implementation:

Harbour contribution module 'hblzf' (LZF compression library): contrib/hblzf/tests/test2.prg. Contains procedures: Main, MakeTest. This file provides utility functions

[Assistant]
#require "hbbz2"
#require "hblzf"

#define _NREPL_     50

PROCEDURE Main()

   LOCAL cStr := Replicate( hb_MemoRead( hb_argv( 0 ) ), _NREPL_ )
   LOCAL aCompressedData := { NIL, NIL, NIL, NIL }
   LOCAL hFuncs := { ;
      "GZIP" => @hb_gzCompress(), ;
      "ZLIB" => @hb_ZCompress(), ;
      "BZ2 " => @hb_bz2_Compress(), ;
      "LZF " => @hb_lzf_compress();
      }
   LOCAL hFuncs2 := { ;
      "GZIP" => @hb_ZUncompress(), ;
      "ZLIB" => @hb_ZUncompress(), ;
      "BZ2 " => @hb_bz2_Uncompress(), ;
      "LZF " => @hb_lzf_decompress();
      }

   MakeTest( @hFuncs, @aCompressedData, @cStr )
   MakeTest( @hFuncs2, @aCompressedData )

   RETURN

STATIC PROCEDURE MakeTest( ... )

   LOCAL e, e2, cRes, cFmt
   LOCAL nResult := 0
   LOCAL nBegin, nEnd
   LOCAL lCmp := ( PCount() > 2 )

   FOR EACH e, e2 IN hb_PValue( 1 ), hb_PValue( 2 )
      nBegin := hb_SecondsCPU()
      cRes := Eval( e:__enumValue(), iif( lCmp, hb_PValue( 3 ), e2 ), NIL, @nResult )
      nEnd := hb_SecondsCPU()
      IF lCmp
         e2 := cRes
      ENDIF
      cFmt := hb_StrFormat( ;
         "%s: %d -> %d, Ratio %.2f%%, Times %.2f", ;
         e:__enumKey(), ;
         Len( iif( lCmp, hb_PValue( 3 ), e2 ) ), Len( cRes ), ;
         ( Len( cRes ) / Len( iif( lCmp, hb_PValue( 3 ), e2 ) ) )


[System] You are an expert Harbour (xBase/Clipper) programmer. Write clean, efficient code following Harbour conventions. Use proper Hungarian notation for variable names (c=character, n=numeric, l=logical, a=array, o=object, b=codeblock).

[User] Write a Harbour program with procedures: Main_TRANS. Harbour utility program: utils/hbtest/rt_trans.prg. Contains procedures: Main_TRANS. This file is part of the test framework

[Assistant]
#include "rt_main.ch"

#include "rt_vars.ch"

PROCEDURE Main_TRANS()

   LOCAL cOldDate  := Set( _SET_DATEFORMAT )
   LOCAL cOldFixed := Set( _SET_FIXED )
   LOCAL cOldDecim := Set( _SET_DECIMALS )
   LOCAL dt, df

   HBTEST Transform( NIL       , NIL        )          IS "E 1 BASE 1122 Argument error (TRANSFORM) OS:0 #:0 A:2:U:NIL;U:NIL F:S"
   HBTEST Transform( NIL       , ""         )          IS "E 1 BASE 1122 Argument error (TRANSFORM) OS:0 #:0 A:2:U:NIL;C: F:S"
   HBTEST Transform( NIL       , "@"        )          IS "E 1 BASE 1122 Argument error (TRANSFORM) OS:0 #:0 A:2:U:NIL;C:@ F:S"
   HBTEST Transform( {}        , NIL        )          IS "E 1 BASE 1122 Argument error (TRANSFORM) OS:0 #:0 A:2:A:{.[0].};U:NIL F:S"
   HBTEST Transform( {}        , ""         )          IS "E 1 BASE 1122 Argument error (TRANSFORM) OS:0 #:0 A:2:A:{.[0].};C: F:S"
   HBTEST Transform( {}        , "@"        )          IS "E 1 BASE 1122 Argument error (TRANSFORM) OS:0 #:0 A:2:A:{.[0].};C:@ F:S"
   HBTEST Transform( ErrorNew(), NIL        )          IS "E 1 BASE 1122 Argument error (TRANSFORM) OS:0 #:0 A:2:O:ERROR Object;U:NIL F:S"
   HBTEST Transform( ErrorNew(), ""         )          IS "E 1 BASE 1122 Argument error (TRANSFORM) OS:0 #:0 A:2:O:ERROR Object;C: F:S"
   HBTEST Transform( ErrorNew(), "@"        )          IS "E 1 BASE 1122 Argument error (TRANSFORM) OS:0 #:0 A:2:O:ERROR Object;C:@ F:S"
   HBTEST Transform( {|| NIL } , NIL        )          IS "E 1 BASE 1122 Argument error (TRANSFORM) OS:0 #:0 A:2:B:{||...};U:NIL F:S"
   HBTEST Transform( {|| NIL } , ""         )          IS "E 1 BASE 1122 Argument error (TRANSFORM) OS:0 #:0 A:2:B:{||...};C: F:S"
   HBTEST Transform( {|| NIL } , "@"        )          IS "E 1 BASE 1122 Argument error (TRANSFORM) OS:0 #:0 A:2:B:{||...};C:@ F:S"

   HBTEST Transform( "", "" )                          IS ""
   HBTEST Transform( "", "@" )                         IS ""
#ifndef __XPP__
   HBTEST Transform( "", NIL )                         IS ""
#endif
   HBTEST Transform( "", 100 )                         IS "E 1 BASE 1122 Argument error (TRANSFORM) OS:0 #:0 A:2:C:;N:100 F:S"
   HBTEST Transform( "hello", "" )                     IS "hello"
   HBTEST Transform( "hello", "@" )                    IS "hello"
#ifndef __XPP__
   HBTEST Transform( "hello", NIL )                    IS "hello"
#endif
   HBTEST Transform( "hello", 100 )                    IS "E 1 BASE 1122 Argument error (TRANSFORM) OS:0 #:0 A:2:C:hello;N:100 F:S"
   HBTEST Transform( 100.2, "" )                       IS "       100.2"
   HBTEST Transform( 100.2, "@" )                      IS "       100.2"
#ifndef __XPP__
   HBTEST Transform( 100.2, NIL )                      IS "       100.2"
#endif
   HBTEST Transform( 100.2, 100 )                      IS "E 1 BASE 1122 Argument error (TRANSFORM) OS:0 #:0 A:2:N:100.2;N:100 F:S"
   HBTEST Transform( 100.20, "" )                      IS "       100.20"
   HBTEST Transform( 100.20, "@" )                     IS "       100.20"
#ifndef __XPP__
   HBTEST Transform( 100.20, NIL )                     IS "       100.20"
#endif
   HBTEST Transform( 100.20, 100 )                     IS "E 1 BASE 1122 Argument error (TRANSFORM) OS:0 #:0 A:2:N:100.20;N:100 F:S"
   HBTEST Transform( Val( "100.2" ), "" )              IS "100.2"
   HBTEST Transform( Val( "100.2" ), "@" )             IS "100.2"
#ifndef __XPP__
   HBTEST Transform( Val( "100.2" ), NIL )             IS "100.2"
#endif
   HBTEST Transform( Val( "100.2" ), 100 )             IS "E 1 BASE 1122 Argument error (TRANSFORM) OS:0 #:0 A:2:N:100.2;N:100 F:S"
   HBTEST Transform( Val( "100.20" ), "" )             IS "100.20"

#ifndef __XPP__
   HBTEST Transform( Val( "100.20" ), NIL )            IS "100.20"
#endif
   HBTEST Transform( Val( "100.20" ), 100 )            IS "E 1 BASE 1122 Argument error (TRANSFORM) OS:0 #:0 A:2:N:100.20;N:100 F:S"
   HBTEST Transform( sdDate, "" )                      IS "1984-03-25"
   HBTEST Transform( sdDate, "@" )                     IS "1984-03-25"
#ifndef __XPP__
   HBTEST Transform( sdDate, NIL )                     IS "1984-03-25"
#endif
   HBTEST Transform( sdDate, 100 )                     IS "E 1 BASE 1122 Argument error (TRANSFORM) OS:0 #:0 A:2:D:0d19840325;N:100 F:S"
   HBTEST Transform( .T., "" )                         IS "T"
   HBTEST Transform( .T., "@" )                        IS "T"
#ifndef __XPP__
   HBTEST Transform( .F., NIL )                        IS "F"
#endif
   HBTEST Transform( .F., 100 )                        IS "E 1 BASE 1122 Argument error (TRANSFORM) OS:0 #:0 A:2:L:.F.;N:100 F:S"

   HBTEST Transform( scStringM, "!!!!!"    )           IS "HELLO"
   HBTEST Transform( scStringM, "@!"       )           IS "HELLO"
#ifdef __HARBOUR__
   HBTEST Transform( @scStringM, "!!!!!"    )          IS "HELLO"
   HBTEST Transform( @scStringM, "@!"       )          IS "HELLO"
#endif
   HBTEST Transform( scStringM, "" )                   IS "Hello"
#ifndef __XPP__
   HBTEST Transform( scStringM, NIL )                  IS "Hello"
#endif
   HBTEST Transform( scStringM, 100 )                  IS "E 1 BASE 1122 Argument error (TRANSFORM) OS:0 #:0 A:2:C:Hello;N:100 F:S"

   HBTEST Transform( "abcdef", "@! !lkm!" )            IS "ABkmE"
   HBTEST Transform( "abcdefghijklmnopqrstuvwxyz", "@! 1234567890" ) IS "12345678I0"
   HBTEST Transform( "abcdefghijklmnopqrstuvwxyzabcdefg", "@! abcdefghijklmnopqrstuvwxyzabcdefg" ) IS "AbcdefghijkLmNopqrstuvwXYzAbcdefg"
   HBTEST Transform( "abcdefghijklmnopqrstuvwxyz", "@! `~!@#$% ^&*()_+-={}\|;':" )  IS "`~C@E$% ^&*()_+-={}\|;':"
   HBTEST Transform( "abcdefghijklmnopqrstuvwxyz", "@! ,./<>?" )                    IS ",./<>?"
   HBTEST Transform( "hello", " @!" )                  IS " @L"

   HBTEST Transform( "abcdef", "@R! !lkm!" )           IS "ABkmC"
   HBTEST Transform( "abcdefghijklmnopqrstuvwxyz", "@R! 1234567890" ) IS "12345678A0"
   HBTEST Transform( "abcdefghijklmnopqrstuvwxyzabcdefg", "@R! abcdefghijklmnopqrstuvwxyzabcdefg" ) IS "AbcdefghijkBmCopqrstuvwDNzFbcdefg"
   HBTEST Transform( "abcdefghijklmnopqrstuvwxyz", "@R! `~!@#$% ^&*()_+-={}\|;':" )  IS "`~A@B$% ^&*()_+-={}\|;':"
   HBTEST Transform( "abcdefghijklmnopqrstuvwxyz", "@R! ,./<>?" )                    IS ",./<>?ABCDEFGHIJKLMNOPQRSTUVWXYZ"
   HBTEST Transform( "hello", " @R!" )                 IS " @RL"

   HBTEST Transform( "abc", "@R !!!!" )                IS "ABC "
   HBTEST Transform( "abc", "@R XXXX" )                IS "abc "
   HBTEST Transform( "abc", "@R !!" )                  IS "AB"
   HBTEST Transform( "abc", "@R XX" )                  IS "ab"
   HBTEST Transform( "abc", "@!R !!!!" )               IS "ABC "
   HBTEST Transform( "abc", "@!R XXXX" )               IS "ABC "
   HBTEST Transform( "abc", "@!R !!" )                 IS "AB"
   HBTEST Transform( "abc", "@!R XX" )                 IS "AB"

   HBTEST Transform( "Hallo   ", "!!!!!"    )          IS "HALLO"
   HBTEST Transform( "Hallo   ", "!!A!!"    )          IS "HAlLO"
   HBTEST Transform( "Hallo   ", "!!A9!"    )          IS "HAllO"
   HBTEST Transform( "Hallo   ", "!QA9!"    )          IS "HQllO"
   HBTEST Transform( "Hallo   ", "ZQA9!"    )          IS "ZQllO"
   HBTEST Transform( "Hall"    , "ZQA9!"    )          IS "ZQll"
   HBTEST Transform( "Hallo   ", "!AAA"     )          IS "Hall"
   HBTEST Transform( "Hallo   ", "@!"       )          IS "HALLO   "
   HBTEST Transform( "Hallo   ", "@! AA"    )          IS "HA"
   HBTEST Transform( "Hallo   ", "@R"       )          IS "Hallo   "
   HBTEST Transform( "Hallo   ", "@Z"       )          IS "        "
   HBTEST Transform( "Hallo   ", "@R !!"    )          IS "HA"
   HBTEST Transform( "Hi"      , "@R !!!"   )          IS "HI "
   HBTEST Transform( "Hallo   ", ""         )          IS "Hallo   "

   HBTEST Transform( .T.       , ""         )          IS "T"
   HBTEST Transform( .F.       , ""         )          IS "F"
   HBTEST Transform( .T.       , "L"        )          IS "T"


[System] You are an expert Harbour (xBase/Clipper) programmer. Write clean, efficient code following Harbour conventions. Use proper Hungarian notation for variable names (c=character, n=numeric, l=logical, a=array, o=object, b=codeblock).

[User] Define Harbour macros and constants: Harbour contribution module 'hbsqlit3' (SQLite3 database client library): contrib/hbsqlit3/tests/hdbc.prg. Contains procedures: Main. This file handles database operations

[Assistant]
#require "hbsqlit3"

#define _NUMROWS_ 10

PROCEDURE Main()

   LOCAL oConn, oMeta, oStmt, cSql, n, oRs

   oConn := hdbcSQLTConnection():New( "test.db", .T. )

   oMeta := oConn:getMetaData()

   ? hb_ValToExp( oMeta:getTables() )

   IF AScan( oMeta:getTables(), {| a | "test" == a[ 3 ] } ) > 0
      ? "test table already exist let's drop it"
      oStmt := oConn:createStatement()
      oStmt:executeUpdate( "DROP TABLE test" )
      oStmt:Close()
      ? "dropped"
   ENDIF

   ? "Creating test table..."
   cSql := "CREATE TABLE test("
   cSql += "     Code integer not null primary key, "
   cSql += "     dept Integer, "
   cSql += "     Name Varchar (40), "
   cSql += "     Sales boolean, "
   cSql += "     Tax Float4, "
   cSql += "     Salary Double Precision, "
   cSql += "     Budget Numeric (12,2), "
   cSql += "     Discount Numeric (5,2), "
   cSql += "     Creation Date, "
   cSql += "     Description text ) "

   oStmt := oConn:createStatement()
   oStmt:executeUpdate( cSql )
   oStmt:Close()
   ? "created"

   ? "Inserting, declared transaction control "
   oConn:StartTransaction()

   ? "Inserting using direct statement..."

   ? Time()
   FOR n := 1 TO _NUMROWS_
      cSql := "INSERT INTO test(code, dept, name, sales, tax, salary, budget, Discount, Creation, Description) "
      cSql += "VALUES( " + Str( n ) + ", 2, 'TEST', '" + iif( n % 2 != 0, "y", "n" ) + "', 5, 3000, 1500.2, 7.5, '12-22-2003', 'Short Description ')"

      oStmt := oConn:createStatement()
      oStmt:executeUpdate( cSql )

      oStmt:close()
   NEXT
   ? Time()

   oConn:Commit()

   oStmt := oConn:createStatement()

   ? "Excecuting query"

   oRs := oStmt:executeQuery( "SELECT code, name, description, sales FROM test" )

   ? "Showing metadata"

   ? oRs:getMetaData():getColumnCount()

   ? "Showing results"

   ? "nRows", oRs:nRows
   ? "getrow", oRs:getRow()
   ? "isbeforefirst", oRs:isBeforeFirst()
   ? "next", oRs:next()
   ? "isfirst", oRs:isFirst()
   ? "getrow", oRs:getRow()
   ? "previous", oRs:previous()
   ? "getrow", oRs:getRow()
   ? "first", oRs:first()
   ? "getrow", oRs:getRow()
   ? "last", oRs:last()
   ? "getrow", oRs:getRow()
   ? "isbeforefirst", oRs:isBeforeFirst()
   oRs:beforeFirst()

   ? "ascending"

   DO WHILE oRs:next()
      ? oRs:getrow(), oRs:getString( "code" ), oRs:getString( "name" ), oRs:getString( "description" ), oRs:getBoolean( "sales" )
   ENDDO

   ? "isafterlast", oRs:isAfterLast()

   oRs:AfterLast()

   ? "descending"

   DO WHILE oRs:previous()
      ? oRs:getrow(), oRs:getString( "code" ), oRs:getString( "name" ), oRs:getString( "description" ), oRs:getBoolean( "sales" )
   ENDDO

   ? "isbeforefirst", oRs:isBeforeFirst()

   oRs:Close()

   oStmt:Close()

   ? hb_ValToExp( oConn:getMetaData():getPrimaryKeys( "", "public", "test" ) )

   oStmt := oConn:createStatement()

   ? "Excecuting query"

   oRs := oStmt:executeQuery( "SELECT * FROM test" )

   oRs:setTableName( "TEST" )
   oRs:setPrimaryKeys( { { "code", "N" } } )

   oRs:moveToInsertRow()
   oRs:updateNumber( 1, 11 )
   oRs:updateString( "description", "Inserted" )
   oRs:insertRow()

   oRs:first()
   oRs:updateNumber( 8, 99.99 )
   oRs:updateDate( 9, Date() )
   oRs:updateString( "description", "Updated" )
   oRs:updateRow()

   oRs:next()
   oRs:deleteRow()
   oRs:next()
   oRs:deleteRow()

   oRs:Close()

   oRs := oStmt:executeQuery( "SELECT * FROM test order by code" )

   DO WHILE oRs:next()
      ? oRs:getrow(), oRs:getString( "code" ), oRs:getString( "name" ), oRs:getString( "description" ), oRs:getBoolean( "sales" ), oRs:getString( "Creation" )
   ENDDO

   oRs:close()
   oStmt:close()

   oConn:Close()

   ? "Closing..."

   RETURN


[System] You are an expert Harbour (xBase/Clipper) programmer. Write clean, efficient code following Harbour conventions. Use proper Hungarian notation for variable names (c=character, n=numeric, l=logical, a=array, o=object, b=codeblock).

[User] Write Harbour functions: dbModifyStructure, dbImport, dbMerge. Harbour contribution module 'xhb' (Extended Harbour functions): contrib/xhb/xdbmodst.prg. Provides functions: dbModifyStructure, dbImport, dbMerge. This file provides legacy compatibility functions

[Assistant]
#include "dbstruct.ch"

#include "dbinfo.ch"
#include "error.ch"

#ifndef EG_RENAME
#define EG_RENAME       26
#endif

#xtranslate Throw( <oErr> ) => ( Eval( ErrorBlock(), <oErr> ), Break( <oErr> ) )

FUNCTION dbModifyStructure( cFile )

   LOCAL lRet
   LOCAL cExt
   LOCAL cTable
   LOCAL cBakFile
   LOCAL cStructureFile
   LOCAL cNewFile
   LOCAL oErr
   LOCAL nPresetArea := Select()
   LOCAL nSourceArea
   LOCAL cDateTime   := SubStr( DToS( Date() ), 3 ) + "." + StrTran( Left( Time(), 5 ), ":", "." )

   BEGIN SEQUENCE WITH {| oErr | Break( oErr ) }

      USE ( cFile ) ALIAS ModifySource EXCLUSIVE NEW
      nSourceArea := Select()

      cFile := dbInfo( DBI_FULLPATH )
      cExt  := dbInfo( DBI_TABLEEXT )

      hb_FNameSplit( cFile, , @cTable )

      cBakFile       := cTable + ".bak." + cDateTime + cExt
      cStructureFile := cTable + ".str." + cDateTime + cExt
      cNewFile       := cTable + ".new." + cDateTime + cExt

      COPY STRUCTURE EXTENDED TO ( cStructureFile )

      USE ( cStructureFile ) ALIAS NewStructure EXCLUSIVE NEW

      Browse( 0, 0, Min( 20, MaxRow() - 1 ), Min( MaxCol() - 30, 50 ) )

      PACK
      CLOSE

      CREATE ( cNewFile ) FROM ( cStructureFile ) ALIAS NEW_MODIFIED NEW

      lRet := dbImport( nSourceArea )
      CLOSE

      SELECT ( nSourceArea )
      CLOSE

      SELECT ( nPresetArea )

      IF lRet
         IF FRename( cFile, cBakFile ) == -1
            BREAK
         ENDIF

         IF FRename( cNewFile, cFile ) == -1

            IF FRename( cBakFile, cFile ) == -1

               oErr := ErrorNew()
               oErr:severity     := ES_ERROR
               oErr:genCode      := EG_RENAME
               oErr:subSystem    := "DBCMD"
               oErr:canDefault   := .F.
               oErr:canRetry     := .F.
               oErr:canSubtitute := .F.
               oErr:operation    := cFile
               oErr:subCode      := 1101
               oErr:args         := { cNewFile, cBakFile }

               BREAK oErr
            ENDIF
         ENDIF
      ENDIF

   RECOVER USING oErr
      IF oErr:className() == "ERROR"
         IF oErr:genCode == EG_RENAME

            lRet := Throw( oErr )
         ELSE
            lRet := .F.
         ENDIF
      ELSE
         lRet := .F.
      ENDIF
   END SEQUENCE

   SELECT ( nPresetArea )

   RETURN lRet

FUNCTION dbImport( xSource )

   RETURN dbMerge( xSource )

FUNCTION dbMerge( xSource, lAppend )

   LOCAL nArea, nSource, nRecNo
   LOCAL aFields
   LOCAL cField, xField
   LOCAL nSourcePos, aTranslate := {}, aTranslation

   LOCAL cTargetType

   IF LastRec() > 0
      IF ! lAppend
         RETURN .F.
      ENDIF
   ENDIF

   IF HB_ISSTRING( xSource )
      nArea := Select()

      USE ( xSource ) ALIAS MergeSource EXCLUSIVE NEW
      nSource := Select()

      SELECT ( nArea )
   ELSEIF HB_ISNUMERIC( xSource )
      nSource := xSource
   ELSE
      RETURN .F.
   ENDIF

   IF LastRec() == 0
      APPEND BLANK
   ENDIF

   aFields := Array( FCount() )
   AFields( aFields )

   FOR EACH cField IN aFields
      nSourcePos := ( nSource )->( FieldPos( cField ) )

      IF nSourcePos > 0
         BEGIN SEQUENCE WITH {| oErr | Break( oErr ) }

            xField := FieldGet( cField:__EnumIndex() )

            FieldPut( cField:__EnumIndex(), ( nSource )->( FieldGet( nSourcePos ) ) )

            FieldPut( cField:__EnumIndex(), xField )

            AAdd( aTranslate, { cField:__EnumIndex(), nSourcePos, {| xSource | xSource } } )
         RECOVER
            cTargetType := ValType( FieldGet( cField:__EnumIndex() ) )

            BEGIN SEQUENCE WITH {| oErr | Break( oErr ) }

               FieldPut( cField:__EnumIndex(), ValToType( ( nSource )->( FieldGet( nSourcePos ) ), cTargetType ) )

               FieldPut( cField:__EnumIndex(), xField )

               AAdd( aTranslate, { cField:__EnumIndex(), nSourcePos, {| xSource | ValToType( xSource, cTargetType ) } } )
            RECOVER

            END SEQUENCE
         END SEQUENCE
      ENDIF
   NEXT

   IF LastRec() == 1 .AND. ! lAppend
      DELETE
      ZAP
   ENDIF

   nRecNo := ( nSource )->( RecNo() )
   ( nSource )->( dbGoTop() )

   WHILE ! ( nSource )->( Eof() )
      APPEND BLANK

      FOR EACH aTranslation IN aTranslate
         FieldPut( aTranslation[ 1 ], Eval( aTranslation[ 3 ], ( nSource )->( FieldGet( aTranslation[ 2 ] ) ) ) )
      NEXT

      ( nSource )->( dbSkip() )
   ENDDO

   ( nSource )->( dbGoto( nRecNo ) )

   IF ! Empty( nArea )
      SELECT ( nSource )
      CLOSE
      SELECT ( nArea )
   ENDIF

   RETURN .T.


[System] You are an expert Harbour (xBase/Clipper) programmer. Write clean, efficient code following Harbour conventions. Use proper Hungarian notation for variable names (c=character, n=numeric, l=logical, a=array, o=object, b=codeblock).

[User] Define Harbour macros and constants: Harbour header file: include/hbver.ch. Defines 10 constants including: HB_VER_CH_, HB_VERSION_HARBOUR, HB_VERSION_COMPILER, HB_VERSION_MAJOR, HB_VERSION_MINOR. Defines Harbour internal constants and macros

[Assistant]
#ifndef HB_VER_CH_
#define HB_VER_CH_

#define HB_VERSION_HARBOUR              0
#define HB_VERSION_COMPILER             1
#define HB_VERSION_MAJOR                2
#define HB_VERSION_MINOR                3
#define HB_VERSION_RELEASE              4
#define HB_VERSION_STATUS               5
#define HB_VERSION_REVISION             6
#define HB_VERSION_COMMIT_INFO          7
#define HB_VERSION_ID                   8
#define HB_VERSION_PCODE_VER            9
#define HB_VERSION_PCODE_VER_STR        10
#define HB_VERSION_BUILD_DATE_STR       11
#define HB_VERSION_BUILD_DATE           12
#define HB_VERSION_BUILD_TIME           13
#define HB_VERSION_BUILD_TIMESTAMP_UTC  30
#define HB_VERSION_BUILD_PLAT           22
#define HB_VERSION_BUILD_COMP           23
#define HB_VERSION_FLAG_PRG             14
#define HB_VERSION_FLAG_C               15
#define HB_VERSION_FLAG_LINKER          16
#define HB_VERSION_BITWIDTH             17
#define HB_VERSION_ENDIANNESS           18
#define HB_VERSION_MT                   19
#define HB_VERSION_SHARED               26
#define HB_VERSION_UNIX_COMPAT          20
#define HB_VERSION_PLATFORM             21
#define HB_VERSION_CPU                  24
#define HB_VERSION_COMPILER_CPP         25
#define HB_VERSION_URL_BASE             27
#define HB_VERSION_URL_SOURCE           28
#define HB_VERSION_OPTIONS              29
#define HB_VERSION_MAX_                 30

#define HB_VERSION_CHANGELOG_LAST       HB_VERSION_COMMIT_INFO
#define HB_VERSION_CHANGELOG_ID         HB_VERSION_ID

#define HB_VERSION_ENDIAN_LITTLE        1
#define HB_VERSION_ENDIAN_BIG           2
#define HB_VERSION_ENDIAN_PDP           3

#endif


[System] You are an expert Harbour (xBase/Clipper) programmer. Write clean, efficient code following Harbour conventions. Use proper Hungarian notation for variable names (c=character, n=numeric, l=logical, a=array, o=object, b=codeblock).

[User] Generate Harbour code for: Harbour header file: include/tbrowse.ch. Defines 10 constants including: _TBROWSE_CH, TBR_EXIT, TBR_CONTINUE, TBR_EXCEPTION, TBR_APPEND

[Assistant]
#ifndef _TBROWSE_CH
#define _TBROWSE_CH

#define TBR_EXIT         -1
#define TBR_CONTINUE     0
#define TBR_EXCEPTION    1

#define TBR_APPEND       1
#define TBR_APPENDING    2
#define TBR_MODIFY       3
#define TBR_MOVE         4
#define TBR_SIZE         5
#define TBR_CUSTOM       6

#define TBC_READWRITE    1
#define TBC_MOVE         2
#define TBC_SIZE         3
#define TBC_CUSTOM       4

#endif


[System] You are an expert Harbour (xBase/Clipper) programmer. Write clean, efficient code following Harbour conventions. Use proper Hungarian notation for variable names (c=character, n=numeric, l=logical, a=array, o=object, b=codeblock).

[User]
Here is a Harbour (xBase/Clipper) implementation:

Harbour contribution module 'hbct' (CA-Tools compatibility library): contrib/hbct/tests/num1.prg. Contains procedures: Main. This file provides legacy compatibility functions

[Assistant]
#ifdef __HARBOUR__
#require "hbct"
#endif

PROCEDURE Main()

   ctinit()

   SET DECIMAL TO 14

   ?? "Test of Numeric functions - part 1"

   ? "Celsius( 33.8 ) =   1
   ?  Space( 10 ),  Celsius( 33.8 ), " <-- CT for Harbour "
   ?

   ? "Celsius( 338.0 ) = 170
   ?  Space( 11 ),  Celsius( 338.0 ), " <-- CT for Harbour "
   ?

   ? "Celsius( 3380.0 ) = 1860
   ?  Space( 12 ),  Celsius( 3380.0 ), " <-- CT for Harbour "
   ?

   ? "Celsius( -33.8 ) = -36.5555..
   ?  Space( 10 ), Celsius( -33.8 ), " <-- CT for Harbour "
   ?

   ? "Fahrenheit( 12.5 ) = 54.5
   ?  Space( 12 ), Fahrenheit( 12.5 ), " <-- CT for Harbour "
   ?

   ? "Fahrenheit( 125 ) = 257
   ?  Space( 12 ), Fahrenheit( 125 ), " <-- CT for Harbour "
   ?

   ? "Fahrenheit( 1250 ) = 2282
   ?  Space( 14 ), Fahrenheit( 1250 ), " <-- CT for Harbour "
   ?
   ? "Fahrenheit( -155 ) = -247
   ?  Space( 14 ), Fahrenheit( -155 ), " <-- CT for Harbour "
   ?

   ?  "Infinity()
   ?  Space( 8 ), Str( Infinity(), 30, 15 ), "  <-- CT for Harbour"
   ?

   ctexit()

   RETURN


[System] You are an expert Harbour (xBase/Clipper) programmer. Write clean, efficient code following Harbour conventions. Use proper Hungarian notation for variable names (c=character, n=numeric, l=logical, a=array, o=object, b=codeblock).

[User] Generate Harbour code for: Harbour contribution module 'hbct' (CA-Tools compatibility library): contrib/hbct/tests/finan.prg. Contains procedures: Main. This file provides legacy compatibility functions

[Assistant]
#ifdef __HARBOUR__
#require "hbct"
#endif

PROCEDURE Main()

   ctinit()

   SET DECIMAL TO 3
   CLS
   ?? "Testing Financial functions...."
   ?
   ? "Calculate how loan summs if you make deposits for $175.00 for 24 months,"
   ? "if the annual rate of the Bank for this mortage is 9.5% fixed"
   ? "PV( 175, 0.095 / 12, 24 ) = 3811.433
   ? Space( 21 ), PV( 175, 0.095 / 12, 24 ), "  <-- CT for Harbour"
   ?
   ?

   ? "Calculate the amount in your account after 3 years, if you make deposits"
   ? "for $150.00 per month, and the annual rate of the Bank for this is 6%"
   ? "Capital = FV( 150, 0.06 / 12, 36 ) = 5900.416
   ? Space( 30 ), FV( 150, 0.06 / 12, 36 ), "  <-- CT for Harbour"
   ?
   ?

   ? "Calculate the monthly payment for a loan of $2000.00 at an annual rate"
   ? "of 10%, within 24 month "
   ? "Payment( 2000.00, 0.10 / 12, 24 ) =  92.290
   ? Space( 28 ), Payment( 2000.00, 0.10 / 12, 24 ), "  <-- CT for Harbour"
   ?
   ? "  PRESS ANY KEY"

   Inkey( 0 )
   ? "Continue Testing Financial functions...."
   ?
   ? "Calculate how many month do you need to cancel a loan of $4000.00 at"
   ? "an annual rate of 9.5% with payments of $200.00 max"
   ? "Periods( 4000.00, 200.00, 0.095 / 12 ) =  21.859
   ? Space( 33 ), Periods( 4000.00, 200.00, 0.095 / 12 ), "  <-- CT for Harbour"
   ?
   ?

   ? "Calculate which is the effective anual rate of your Bank, for a loan"
   ? "of $2500.00 if you pay $86.67 per month for 3 years"
   ? "Rate( 2500.00, 86.67, 36 )
   ? Space( 24 ), Rate( 2500.00, 86.67, 36 ) * 12.0, "  <-- CT for Harbour"
   ?
   ? "  PRESS ANY KEY"
   Inkey( 0 )

   ctexit()

   RETURN


[System] You are an expert Harbour (xBase/Clipper) programmer. Write clean, efficient code following Harbour conventions. Use proper Hungarian notation for variable names (c=character, n=numeric, l=logical, a=array, o=object, b=codeblock).

[User]
Write the following Harbour (xBase/Clipper) code:

Harbour contribution module 'sddmy' (): contrib/sddmy/tests/test1.prg. Contains procedures: Main, CreateTable. This file handles database operations

[Assistant]
#require "rddsql"
#require "sddmy"

#include "dbinfo.ch"
#include "error.ch"

REQUEST SDDMY, SQLMIX

ANNOUNCE RDDSYS

FIELD RESIDENTS

PROCEDURE Main()

#if defined( __HBSCRIPT__HBSHELL )
   rddRegister( "SQLBASE" )
   rddRegister( "SQLMIX" )
   hb_SDDMY_Register()
#endif

   rddSetDefault( "SQLMIX" )

   AEval( rddList(), {| x | QOut( x ) } )

   IF rddInfo( RDDI_CONNECT, { "MYSQL", "localhost", "test", , "test" } ) == 0
      ? "Unable connect to the server"
      RETURN
   ENDIF

   CreateTable()

   ? "Let's browse table (press any key)"
   Inkey( 0 )
   dbUseArea( .T., , "SELECT * FROM country", "country" )
   Browse()

   ? "Let's browse table ordered by resident count (press any key)"
   Inkey( 0 )
   INDEX ON RESIDENTS TAG residents TO country
   Browse()

   dbCloseAll()

   RETURN

STATIC PROCEDURE CreateTable()

   ? rddInfo( RDDI_EXECUTE, "DROP TABLE country" )
   ? rddInfo( RDDI_EXECUTE, "CREATE TABLE country (CODE char(3), NAME char(50), RESIDENTS int(11))" )
   ? rddInfo( RDDI_EXECUTE, "INSERT INTO country values ('LTU', 'Lithuania', 3369600), ('USA', 'United States of America', 305397000), ('POR', 'Portugal', 10617600), ('POL', 'Poland', 38115967), ('AUS', 'Australia', 21446187), ('FRA', 'France', 64473140), ('RUS', 'Russia', 141900000)" )

   RETURN


[System] You are an expert Harbour (xBase/Clipper) programmer. Write clean, efficient code following Harbour conventions. Use proper Hungarian notation for variable names (c=character, n=numeric, l=logical, a=array, o=object, b=codeblock).

[User]
Here is a Harbour (xBase/Clipper) implementation:

Harbour Runtime Library file: src/rtl/tpopuphb.prg. Defines classes: hb_PopupMenu. This file implements menu system classes

[Assistant]
#include "hbclass.ch"

#ifdef HB_COMPAT_C53

CREATE CLASS hb_PopupMenu INHERIT HBPopupMenu

   EXPORTED:

   METHOD shadowed( lShadowed ) SETGET

   METHOD setCoors( nRow, nCol, lTop )
   METHOD isShortCut( nKey,  nID )
   METHOD isQuick( nKey,  nID )

ENDCLASS

METHOD shadowed( lShadowed ) CLASS hb_PopupMenu

   IF lShadowed != NIL
      ::lShadowed := __eInstVar53( Self, "SHADOWED", lShadowed, "L", 1001 )
   ENDIF

   RETURN ::lShadowed

METHOD setCoors( nRow, nCol, lTop ) CLASS hb_PopupMenu

   LOCAL oItem
   LOCAL nDif

   ::setMetrics()

   IF ::nTop == -1 .OR. ::nLeft == -1
      ::nTop    := nRow
      ::nLeft   := nCol
      ::nBottom := ::nTop + ::nItemCount + 1
      ::nRight  := ::nLeft + ::nWidth - 1

      IF ::nRight > MaxCol()
         nDif     := ::nRight - MaxCol()
         ::nRight -= nDif
         ::nLeft  -= nDif
         IF ! lTop
            ::nTop++
            ::nBottom++
         ENDIF
      ENDIF

      IF ::nLeft < 0
         nDif     := ::nLeft
         ::nRight -= nDif
         ::nLeft  -= nDif
      ENDIF

      IF ::nBottom > MaxRow()
         nDif      := ::nBottom - MaxRow()
         ::nBottom -= nDif
         ::nTop    -= nDif
      ENDIF

      IF ::nTop < 0
         nDif      := ::nTop
         ::nBottom -= nDif
         ::nTop    -= nDif
      ENDIF

      FOR EACH oItem IN ::aItems
         IF oItem:isPopup()
            oItem:data:setCoors( nRow + oItem:__enumIndex(), ::nRight + 1, .F. )
         ENDIF
      NEXT
   ENDIF

   RETURN Self

METHOD isShortCut( nKey,  nID ) CLASS hb_PopupMenu

   LOCAL nItem
   LOCAL nTotal
   LOCAL nShortCut
   LOCAL oItem
   LOCAL i

   DO CASE

   CASE ( nShortCut := ::getShortCt( nKey ) ) > 0 .AND. ;
        ( oItem := ::getItem( nShortcut ) ):enabled .AND. ;
        ! oItem:isPopUp()

      ::select( nShortCut )
      Eval( oItem:data, oItem )
      nID := oItem:id

      RETURN .T.

   CASE nShortCut == 0
      nTotal := ::nItemCount
      nItem  := ::nCurrent
      IF nItem == 0
         nItem := 1
      ENDIF

      FOR i := 1 TO nTotal
         IF ( oItem := ::getItem( nItem ) ):enabled .AND. ;
            oItem:isPopUp() .AND. ;
            oItem:data:isQuick( nKey, @nID )
            RETURN .T.
         ENDIF
         IF ++nItem > nTotal
            nItem := 1
         ENDIF
      NEXT

   ENDCASE

   RETURN .F.

METHOD isQuick( nKey,  nID ) CLASS hb_PopupMenu

   LOCAL nShortCut
   LOCAL oItem

   IF ( nShortCut := ::getShortCt( nKey ) ) == 0

      FOR EACH oItem IN ::aItems
         IF oItem:Enabled .AND. ;
            oItem:isPopUp() .AND. ;
            oItem:data:isQuick( nKey, @nID )
            RETURN .T.
         ENDIF
      NEXT

   ELSEIF !( oItem := ::getItem( nShortCut ) ):IsPopUp()

      IF oItem:enabled
         ::select( nShortCut )
         Eval( oItem:data, oItem )
         nID := oItem:id
         RETURN .T.
      ENDIF

   ENDIF

   RETURN .F.

#endif