diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 2e8d78634d..0235ec8d3b 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -17,6 +17,46 @@ past entries belonging to these authors: Viktor Szakats. */ +2009-05-12 09:25 UTC+0200 Viktor Szakats (harbour.01 syenar hu) + * doc/cmdline.txt + * doc/howtosvn.txt + + Added CC copyright. + + * source/rtl/alert.prg + * include/hbextern.ch + + HB_ALERT(). Now this function holds all extended features: + nDelay support and any type for first parameter. + * ALERT() now behaves completely along Clipper version, without + extensions. HB_EXTENSION no longer modifies its behaviour, so + if someone needs these extended features, there is no need to + build with HB_EXTENSION, only ALERT() calls have to be + converted to HB_ALERT(). INCOMPATIBLE (in some scenarios). + + * contrib/hbtip/utils.c + % TIP_TIMESTAMP() code cleaned to remove redundancy of + having two full distinct copies of this function. Now + platform independent parts are kept common. + ! TIP_TIMESTAMP() fixed hb_parl() to hb_parnl() for 'hours' + parameter. I wonder how this bug wasn't noticed till now. + Please someone test, maybe I'm missing the point of this + parameter, but it's unlikely the intent was a logical value + as it's later converted to timestamp. + + * contrib/hbtip/thtml.prg + * contrib/hbtip/sendmail.prg + * contrib/hbtip/httpcln.prg + * contrib/hbtip/ftpcln.prg + * END -> END* + * Minor formatting. + + * contrib/hbtip/base64x.c + * contrib/hbtip/smtpcln.prg + * Formatted. + * Minor optimizations (File() -> hb_FileExists(), ::AuthPlain() + simplification). + % BUILDUSERPASSSTRING() rewritten in Harbour. It's a very + simple function. + 2009-05-12 01:13 UTC+0200 Viktor Szakats (harbour.01 syenar hu) * utils/hbmk2/hbmk2.prg + Added -beep/nobeep/beep- options to enable beep signal diff --git a/harbour/contrib/hbtip/base64x.c b/harbour/contrib/hbtip/base64x.c index 6821dff6d2..21e462561b 100644 --- a/harbour/contrib/hbtip/base64x.c +++ b/harbour/contrib/hbtip/base64x.c @@ -53,22 +53,6 @@ #include "hbapi.h" -HB_FUNC( BUILDUSERPASSSTRING ) -{ - char * szUser = hb_parcx( 1 ); - char * szPass = hb_parcx( 2 ); - size_t u_len = strlen( szUser ); - size_t p_len = strlen( szPass ); - char * s = ( char * ) hb_xgrab( u_len + p_len + 3 ); - - s[ 0 ] = '\0'; - memcpy( s + 1, szUser, u_len ); - s[ u_len + 1 ] = '\0'; - memcpy( s + u_len + 2, szPass, p_len ); - - hb_retclen_buffer( s, u_len + p_len + 2 ); -} - HB_FUNC( HB_BASE64 ) { ULONG len = hb_parclen( 1 ); diff --git a/harbour/contrib/hbtip/ftpcln.prg b/harbour/contrib/hbtip/ftpcln.prg index 0411cb3063..7031fef932 100644 --- a/harbour/contrib/hbtip/ftpcln.prg +++ b/harbour/contrib/hbtip/ftpcln.prg @@ -357,7 +357,7 @@ METHOD TransferStart() CLASS tIPClientFTP IF ! Empty( ::nDefaultSndBuffSize ) ::InetSndBufSize( skt, ::nDefaultSndBuffSize ) ENDIF - + IF ! Empty( ::nDefaultRcvBuffSize ) ::InetRcvBufSize( skt, ::nDefaultRcvBuffSize ) ENDIF @@ -446,33 +446,35 @@ METHOD UserCommand( cCommand, lPasv, lReadPort, lGetReply ) CLASS tIPClientFTP RETURN .t. -METHOD ReadAuxPort(cLocalFile) CLASS tIPClientFTP - LOCAL cRet, cList := "",nFile:=0 +METHOD ReadAuxPort( cLocalFile ) CLASS tIPClientFTP + LOCAL cRet + LOCAL cList := "" + LOCAL nFile := 0 - IF .not. ::TransferStart() + IF ! ::TransferStart() RETURN NIL - END - IF !empty(cLocalFile) - nFile:=fcreate(cLocalFile) + ENDIF + IF ! Empty( cLocalFile ) + nFile := FCreate( cLocalFile ) ENDIF cRet := ::super:Read( 512 ) - WHILE cRet != NIL .and. len( cRet ) > 0 - IF nFile>0 - fwrite(nFile,cRet) - else - cList += cRet + DO WHILE cRet != NIL .AND. Len( cRet ) > 0 + IF nFile > 0 + FWrite( nFile, cRet ) + ELSE + cList += cRet ENDIF cRet := ::super:Read( 512 ) - END + ENDDO HB_InetClose( ::SocketCon ) ::SocketCon := ::SocketControl IF ::GetReply() - IF nFile>0 - fclose(nFile) - return(.t.) - ENDIF - RETURN cList + IF nFile > 0 + FClose( nFile ) + RETURN .t. + ENDIF + RETURN cList ENDIF RETURN NIL @@ -836,11 +838,11 @@ METHOD listFiles( cFileSpec ) CLASS tIPClientFTP FOR EACH cEntry IN aList IF Empty( cEntry ) //PM:09-08-2007 Needed because of the new HB_aTokens() - + hb_ADel(aList, cEntry:__enumIndex(), .T.) - + ELSE - + aFile := Array( F_LEN+3 ) nStart := 1 nEnd := hb_At( Chr(32), cEntry, nStart ) diff --git a/harbour/contrib/hbtip/httpcln.prg b/harbour/contrib/hbtip/httpcln.prg index b64999dad6..96481468fe 100644 --- a/harbour/contrib/hbtip/httpcln.prg +++ b/harbour/contrib/hbtip/httpcln.prg @@ -365,11 +365,11 @@ METHOD ReadAll() CLASS tIPClientHTTP ENDIF IF ::bChunked cChunk:=::read() - while cChunk != nil + do while cChunk != nil cOut+=cChunk // ::nLength:=-1 cChunk:=::read() - end + enddo else return(::read()) endif @@ -571,7 +571,7 @@ METHOD PostMultiPart( cPostData, cQuery ) CLASS tIPClientHTTP nbuf:=8192 nRead:=nBuf //cBuf:=space(nBuf) - while nRead == nBuf + do while nRead == nBuf //nRead := FRead( nFile,@cBuf,nBuf) cBuf:=FReadstr( nFile,nBuf) nRead:=len(cBuf) @@ -580,7 +580,7 @@ METHOD PostMultiPart( cPostData, cQuery ) CLASS tIPClientHTTP ENDIF */ cData+=cBuf - end + enddo fClose(nFile) cData+=cCrlf NEXT @@ -631,5 +631,3 @@ METHOD WriteAll( cFile ) CLASS tIPClientHTTP endif RETURN lSuccess - - diff --git a/harbour/contrib/hbtip/sendmail.prg b/harbour/contrib/hbtip/sendmail.prg index 3a55107f16..5b41e8960a 100644 --- a/harbour/contrib/hbtip/sendmail.prg +++ b/harbour/contrib/hbtip/sendmail.prg @@ -200,7 +200,7 @@ FUNCTION HB_SendMail( cServer, nPort, cFrom, aTo, aCC, aBCC, cBody, cSubject, aF ENDIF RECOVER lReturn := .F. - END + END SEQUENCE ENDIF @@ -212,7 +212,7 @@ FUNCTION HB_SendMail( cServer, nPort, cFrom, aTo, aCC, aBCC, cBody, cSubject, aF oUrl := tUrl():New( "smtp://" + cUser + "@" + cServer + "/" + cTo ) RECOVER lReturn := .F. - END + END SEQUENCE IF !lReturn RETURN .F. @@ -256,7 +256,7 @@ FUNCTION HB_SendMail( cServer, nPort, cFrom, aTo, aCC, aBCC, cBody, cSubject, aF oInmail := tIPClientSMTP():New( oUrl, lTrace) RECOVER lReturn := .F. - END + END SEQUENCE IF !lReturn RETURN .F. @@ -268,7 +268,7 @@ FUNCTION HB_SendMail( cServer, nPort, cFrom, aTo, aCC, aBCC, cBody, cSubject, aF IF oInMail:OpenSecure() - WHILE .T. + DO WHILE .T. oInMail:GetOk() IF oInMail:cReply == NIL EXIT @@ -314,7 +314,7 @@ FUNCTION HB_SendMail( cServer, nPort, cFrom, aTo, aCC, aBCC, cBody, cSubject, aF oInmail := tIPClientsmtp():New( oUrl, lTrace) RECOVER lReturn := .F. - END + END SEQUENCE oInmail:nConnTimeout:=nTimeOut diff --git a/harbour/contrib/hbtip/smtpcln.prg b/harbour/contrib/hbtip/smtpcln.prg index a871b7e8d2..3eda518b9b 100644 --- a/harbour/contrib/hbtip/smtpcln.prg +++ b/harbour/contrib/hbtip/smtpcln.prg @@ -7,7 +7,6 @@ * TIP Class oriented Internet protocol library * * Copyright 2003 Giancarlo Niccolai - * * www - http://www.harbour-project.org * * This program is free software; you can redistribute it and/or modify @@ -62,7 +61,7 @@ * Inet service manager: smtp */ -CLASS tIPClientSMTP FROM tIPClient +CREATE CLASS tIPClientSMTP FROM tIPClient METHOD New( oUrl, lTrace, oCredentials ) METHOD Open() @@ -74,108 +73,107 @@ CLASS tIPClientSMTP FROM tIPClient METHOD Commit() METHOD Quit() METHOD GetOK() - /* Method for smtp server that require login */ + + /* Methods for smtp server that require login */ METHOD OpenSecure() METHOD AUTH( cUser, cPass) // Auth by login method METHOD AUTHplain( cUser, cPass) // Auth by plain method - METHOD ServerSuportSecure(lAuthp,lAuthl) + METHOD ServerSuportSecure( lAuthp, lAuthl ) METHOD sendMail + HIDDEN: - DATA isAuth INIT .F. + + VAR isAuth INIT .F. + ENDCLASS METHOD New( oUrl, lTrace, oCredentials ) CLASS tIPClientSMTP -local cFile :="sendmail" -local n:=1 + LOCAL n + ::super:New( oUrl, lTrace, oCredentials ) ::nDefaultPort := 25 ::nConnTimeout := 5000 ::nAccessMode := TIP_WO // a write only - if ::ltrace - if !file("sendmail.log") - ::nHandle := fcreate("sendmail.log") - else - while file(cFile+hb_NToS(n)+".log") - n++ - enddo - ::nHandle := fcreate(cFile+hb_NToS(n)+".log") - endif - endif -RETURN Self + IF ::ltrace + IF ! hb_FileExists( "sendmail.log" ) + ::nHandle := FCreate( "sendmail.log" ) + ELSE + n := 1 + DO WHILE hb_FileExists( "sendmail" + hb_NToS( n ) + ".log" ) + n++ + ENDDO + ::nHandle := FCreate( "sendmail" + hb_NToS( n ) + ".log" ) + ENDIF + ENDIF + + RETURN Self METHOD Open( cUrl ) CLASS tIPClientSMTP - IF .not. ::super:Open( cUrl ) + IF ! ::super:Open( cUrl ) RETURN .F. ENDIF HB_InetTimeout( ::SocketCon, ::nConnTimeout ) - IF .not. Empty ( ::oUrl:cUserid ) + IF ! Empty( ::oUrl:cUserid ) ::InetSendall( ::SocketCon, "HELO " + ::oUrl:cUserid + ::cCRLF ) ELSE ::InetSendall( ::SocketCon, "HELO tipClientSMTP" + ::cCRLF ) ENDIF -RETURN ::GetOk() - + RETURN ::GetOk() METHOD GetOk() CLASS tIPClientSMTP LOCAL nLen ::cReply := ::InetRecvLine( ::SocketCon, @nLen, 512 ) - IF ::InetErrorCode( ::SocketCon ) != 0 .or. Substr( ::cReply, 1, 1 ) == "5" + IF ::InetErrorCode( ::SocketCon ) != 0 .OR. SubStr( ::cReply, 1, 1 ) == "5" RETURN .F. ENDIF -RETURN .T. + RETURN .T. METHOD Close() CLASS tIPClientSMTP HB_InetTimeOut( ::SocketCon, ::nConnTimeout ) - if ::ltrace - fClose(::nHandle) - endif + IF ::ltrace + FClose(::nHandle) + ENDIF ::Quit() -RETURN ::super:Close() + RETURN ::super:Close() METHOD Commit() CLASS tIPClientSMTP ::InetSendall( ::SocketCon, ::cCRLF + "." + ::cCRLF ) -RETURN ::GetOk() - + RETURN ::GetOk() METHOD Quit() CLASS tIPClientSMTP ::InetSendall( ::SocketCon, "QUIT" + ::cCRLF ) ::isAuth := .F. -RETURN ::GetOk() - + RETURN ::GetOk() METHOD Mail( cFrom ) CLASS tIPClientSMTP ::InetSendall( ::SocketCon, "MAIL FROM: <" + cFrom +">" + ::cCRLF ) -RETURN ::GetOk() - + RETURN ::GetOk() METHOD Rcpt( cTo ) CLASS tIPClientSMTP ::InetSendall( ::SocketCon, "RCPT TO: <" + cTo + ">" + ::cCRLF ) -RETURN ::GetOk() - + RETURN ::GetOk() METHOD Data( cData ) CLASS tIPClientSMTP ::InetSendall( ::SocketCon, "DATA" + ::cCRLF ) - IF .not. ::GetOk() + IF ! ::GetOk() RETURN .F. ENDIF ::InetSendall(::SocketCon, cData + ::cCRLF + "." + ::cCRLF ) -RETURN ::GetOk() - - + RETURN ::GetOk() METHOD OpenSecure( cUrl ) CLASS tIPClientSMTP - Local cUser + LOCAL cUser - IF .not. ::super:Open( cUrl ) + IF ! ::super:Open( cUrl ) RETURN .F. ENDIF @@ -183,79 +181,81 @@ METHOD OpenSecure( cUrl ) CLASS tIPClientSMTP cUser := ::oUrl:cUserid - IF .not. Empty ( ::oUrl:cUserid ) + IF ! Empty ( ::oUrl:cUserid ) ::InetSendall( ::SocketCon, "EHLO " + cUser + ::cCRLF ) ELSE ::InetSendall( ::SocketCon, "EHLO tipClientSMTP" + ::cCRLF ) ENDIF -RETURN ::getOk() + RETURN ::getOk() -METHOD AUTH( cUser, cPass) CLASS tIPClientSMTP +METHOD AUTH( cUser, cPass ) CLASS tIPClientSMTP - Local cEncodedUser - Local cEncodedPAss + LOCAL cEncodedUser + LOCAL cEncodedPAss - cUser := StrTran( cUser,"&at;", "@") + cUser := StrTran( cUser, "&at;", "@" ) - cEncodedUser := alltrim(HB_BASE64(cuser,len(cuser))) - cEncodedPAss := alltrim(HB_BASE64(cPass,len(cpass))) + cEncodedUser := AllTrim( HB_BASE64( cUser, Len( cUser ) ) ) + cEncodedPAss := AllTrim( HB_BASE64( cPass, Len( cPass ) ) ) + ::InetSendall( ::SocketCon, "AUTH LOGIN" + ::ccrlf ) - ::InetSendall( ::SocketCon, "AUTH LOGIN" +::ccrlf ) + IF ::GetOk() + ::InetSendall( ::SocketCon, cEncodedUser + ::cCrlf ) + IF ::Getok() + ::InetSendall( ::SocketCon, cEncodedPass + ::cCrlf ) + ENDIF + ENDIF - if ::GetOk() - ::InetSendall( ::SocketCon, cEncodedUser+::cCrlf ) - if ::Getok() - ::InetSendall( ::SocketCon, cEncodedPass +::cCrlf ) - endif - endif - - return ::isAuth := ::GetOk() + RETURN ::isAuth := ::GetOk() METHOD AuthPlain( cUser, cPass) CLASS tIPClientSMTP - Local cBase := BUILDUSERPASSSTRING( cUser, cPass ) - Local cen := HB_BASE64( cBase, 2 + Len( cUser ) + Len( cPass ) ) - - ::InetSendall( ::SocketCon, "AUTH PLAIN" + cen + ::cCrlf) - return ::isAuth := ::GetOk() + ::InetSendall( ::SocketCon, "AUTH PLAIN" +; + HB_BASE64( BUILDUSERPASSSTRING( cUser, cPass ) ) +; + ::cCrlf ) + RETURN ::isAuth := ::GetOk() METHOD Write( cData, nLen, bCommit ) CLASS tIPClientSMTP -Local aTo,cRecpt - IF .not. ::bInitialized + LOCAL aTo + LOCAL cRecpt + + IF ! ::bInitialized //IF Empty( ::oUrl:cUserid ) .or. Empty( ::oUrl:cFile ) - IF Empty( ::oUrl:cFile ) //GD user id not needed if we did not auth + IF Empty( ::oUrl:cFile ) // GD user id not needed if we did not auth RETURN -1 ENDIF - IF .not. ::Mail( ::oUrl:cUserid ) + IF ! ::Mail( ::oUrl:cUserid ) RETURN -1 ENDIF - aTo:= HB_RegexSplit(",", ::oUrl:cFile ) + aTo := HB_RegexSplit( ",", ::oUrl:cFile ) - FOR each cRecpt in Ato - IF .not. ::Rcpt(cRecpt) + FOR EACH cRecpt IN Ato + IF ! ::Rcpt( cRecpt ) RETURN -1 ENDIF NEXT ::InetSendall( ::SocketCon, "DATA" + ::cCRLF ) - IF .not. ::GetOk() + IF ! ::GetOk() RETURN -1 ENDIF ::bInitialized := .T. ENDIF ::nLastWrite := ::super:Write( cData, nLen, bCommit ) -RETURN ::nLastWrite -METHOD ServerSuportSecure(lAuthp,lAuthl) CLASS tIPClientSMTP - Local lAuthLogin := .F.,lAuthPlain :=.F. + RETURN ::nLastWrite + +METHOD ServerSuportSecure( /* @ */ lAuthp, /* @ */ lAuthl ) CLASS tIPClientSMTP + LOCAL lAuthLogin := .F. + LOCAL lAuthPlain := .F. IF ::OPENSECURE() - WHILE .T. + DO WHILE .T. ::GetOk() IF ::cReply == NIL EXIT @@ -265,25 +265,26 @@ METHOD ServerSuportSecure(lAuthp,lAuthl) CLASS tIPClientSMTP lAuthPlain := .T. ENDIF ENDDO - ::CLOSE() - ENDIF + ::CLOSE() + ENDIF - lAuthp:=lAuthPlain - lAuthl:=lAuthLogin - -RETURN lAuthLogin .OR. lAuthPlain + lAuthp := lAuthPlain + lAuthl := lAuthLogin + RETURN lAuthLogin .OR. lAuthPlain METHOD sendMail( oTIpMail ) CLASS TIpClientSmtp - LOCAL cFrom, cTo, aTo + LOCAL cFrom + LOCAL cTo + LOCAL aTo - IF .NOT. ::isOpen + IF ! ::isOpen RETURN .F. ENDIF - IF .NOT. ::isAuth + IF ! ::isAuth ::auth( ::oUrl:cUserId, ::oUrl:cPassWord ) - IF .NOT. ::isAuth + IF ! ::isAuth RETURN .F. ENDIF ENDIF @@ -292,14 +293,17 @@ METHOD sendMail( oTIpMail ) CLASS TIpClientSmtp cTo := oTIpMail:getFieldPart( "To" ) cTo := StrTran( cTo, HB_InetCRLF(), "" ) - cTo := StrTran( cTo, Chr(9) , "" ) - cTo := StrTran( cTo, Chr(32) , "" ) + cTo := StrTran( cTo, Chr( 9 ), "" ) + cTo := StrTran( cTo, Chr( 32 ), "" ) - aTo := HB_RegExSplit( "," , cTo ) + aTo := HB_RegExSplit( ",", cTo ) ::mail( cFrom ) FOR EACH cTo IN aTo - ::rcpt( cTo ) + ::rcpt( cTo ) NEXT -RETURN ::data( oTIpMail:toString() ) + RETURN ::data( oTIpMail:toString() ) + +FUNCTION BUILDUSERPASSSTRING( cUser, cPass ) + RETURN Chr( 0 ) + cUser + Chr( 0 ) + cPass diff --git a/harbour/contrib/hbtip/thtml.prg b/harbour/contrib/hbtip/thtml.prg index 590697f37f..907f53fa0a 100644 --- a/harbour/contrib/hbtip/thtml.prg +++ b/harbour/contrib/hbtip/thtml.prg @@ -414,7 +414,7 @@ METHOD Next() CLASS THtmlIterator lExit := .T. oFound := NIL ::nCurrent := 0 - END + END SEQUENCE ENDDO RETURN oFound @@ -642,7 +642,7 @@ METHOD isType( nType ) CLASS THtmlNode lRet := hb_bitAnd( ::htmlTagType[2], nType ) > 0 RECOVER lRet := .F. - END + END SEQUENCE RETURN lRet @@ -715,7 +715,8 @@ METHOD parseHtml( parser ) CLASS THtmlNode ELSEIF Chr(10) $ cText cText := Trim(cText) nPos := Len(cText) + 1 - DO WHILE nPos > 0 .AND. SubStr( cText, --nPos, 1 ) $ Chr(9)+Chr(10)+Chr(13) ; ENDDO + DO WHILE nPos > 0 .AND. SubStr( cText, --nPos, 1 ) $ Chr(9)+Chr(10)+Chr(13) + ENDDO oThisTag:addNode( THtmlNode():new( oThisTag, "_text_", , Left(cText,nPos) ) ) ELSE oThisTag:addNode( THtmlNode():new( oThisTag, "_text_", , cText ) ) @@ -815,7 +816,7 @@ METHOD parseHtml( parser ) CLASS THtmlNode ENDIF ENDIF - END + ENDSWITCH IF lRewind oThisTag := oThisTag:parent @@ -859,7 +860,8 @@ METHOD parseHtmlFixed( parser ) CLASS THtmlNode ENDIF // back to "<" - DO WHILE !( P_PREV( parser ) == "<" ) ; ENDDO /* NOTE: != changed to !( == ) */ + DO WHILE !( P_PREV( parser ) == "<" ) + ENDDO /* NOTE: != changed to !( == ) */ nEnd := parser:p_pos ::addNode( THtmlNode():new( self, "_text_", , SubStr( parser:p_Str, nStart, nEnd - nStart ) ) ) @@ -1065,8 +1067,8 @@ METHOD toString( nIndent ) CLASS THtmlNode #else FOR EACH oNode IN ::htmlContent IF .NOT. oNode:isInline() .OR. oNode:htmlTagName == "!--" - cHtml += chr(13)+Chr(10) - ENDIF + cHtml += chr(13)+Chr(10) + ENDIF cHtml += oNode:toString( nIndent+1 ) NEXT #endif @@ -1106,7 +1108,7 @@ METHOD attrToString() CLASS THtmlNode RECOVER // Tag has no attributes aAttr := {} - END + END SEQUENCE cAttr := "" hb_HEval( ::htmlAttributes, {|cKey,cValue| cAttr+=__AttrToStr( cKey, cValue, aAttr, self ) } ) ENDIF @@ -1231,7 +1233,7 @@ METHOD getAttribute( cName ) CLASS THtmlNode cValue := hHash[cName] RECOVER cValue := NIL - END + END SEQUENCE RETURN cValue @@ -1348,7 +1350,7 @@ STATIC FUNCTION __ParseAttr( parser ) OTHERWISE aAttr[nMode] += cChr - END + ENDSWITCH ENDDO IF .NOT. aAttr[1] == "" @@ -1375,7 +1377,7 @@ METHOD setAttribute( cName, cValue ) CLASS THtmlNode RECOVER // Tag has no attributes aAttr := {} - END + END SEQUENCE IF ( nPos := AScan( aAttr, {|a| a[1] == Lower( cName ) } ) ) == 0 // Tag doesn't have this attribute @@ -1407,7 +1409,7 @@ METHOD delAttribute( cName ) CLASS THtmlNode lRet := .T. RECOVER lRet := .F. - END + END SEQUENCE ENDIF RETURN lRet @@ -1425,7 +1427,7 @@ METHOD isAttribute( cName ) CLASS THtmlNode lRet := hb_HHasKey( ::getAttributes(), cName ) RECOVER lRet := .F. - END + END SEQUENCE RETURN lRet @@ -1625,7 +1627,7 @@ FUNCTION THtmlTagType( cTagName ) aType := shTagTypes[ cTagName ] RECOVER aType := shTagTypes[ "_text_" ] - END + END SEQUENCE RETURN aType @@ -1644,7 +1646,7 @@ FUNCTION THtmlIsValid( cTagName, cAttrName ) ENDIF RECOVER lRet := .F. - END + END SEQUENCE RETURN lRet /* @@ -4370,7 +4372,8 @@ FUNCTION AnsiToHtml( cAnsiText ) nEnd := parser:p_pos cText := SubStr( parser:p_str, nStart, nEnd-nStart ) - DO WHILE .NOT. ( (cChr := P_NEXT(parser)) $ "; " ) .AND. .NOT. parser:p_pos == 0; ENDDO + DO WHILE .NOT. ( (cChr := P_NEXT(parser)) $ "; " ) .AND. .NOT. parser:p_pos == 0 + ENDDO SWITCH cChr CASE ";" @@ -4390,7 +4393,7 @@ FUNCTION AnsiToHtml( cAnsiText ) nStart := nEnd cHtmlText += "&" + SubStr( cText, 2 ) LOOP - END + ENDSWITCH nStart := parser:p_pos FOR EACH aEntity IN saHtmlAnsiEntities diff --git a/harbour/contrib/hbtip/utils.c b/harbour/contrib/hbtip/utils.c index e4758019ca..6bb5100142 100644 --- a/harbour/contrib/hbtip/utils.c +++ b/harbour/contrib/hbtip/utils.c @@ -7,7 +7,6 @@ * TIP Class oriented Internet protocol library * * Copyright 2003 Giancarlo Niccolai - * * www - http://www.harbour-project.org * * This program is free software; you can redistribute it and/or modify @@ -69,28 +68,30 @@ #include "hbvm.h" #include "hbdate.h" -#ifndef HB_OS_WIN - #include -#else +#ifdef HB_OS_WIN #include +#else + #include #endif #ifndef TIME_ZONE_ID_INVALID - #define TIME_ZONE_ID_INVALID (DWORD)0xFFFFFFFF + #define TIME_ZONE_ID_INVALID ( DWORD ) 0xFFFFFFFF #endif /************************************************************ * Useful internet timestamp based on RFC822 */ -/* sadly, many strftime windows implementations are broken */ -#ifdef HB_OS_WIN - HB_FUNC( TIP_TIMESTAMP ) { PHB_ITEM pDate = hb_param( 1, HB_IT_DATE ); - ULONG ulHour = hb_parl(2); + ULONG ulHour = hb_parnl( 2 ); int nLen; + char *szRet = ( char * ) hb_xgrab( 64 ); + +/* sadly, many strftime windows implementations are broken */ +#ifdef HB_OS_WIN + TIME_ZONE_INFORMATION tzInfo; LONG lDate; int iYear, iMonth, iDay; @@ -100,25 +101,14 @@ HB_FUNC( TIP_TIMESTAMP ) "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" }; - char *szRet = (char *) hb_xgrab( 64 ); SYSTEMTIME st; - - if ( !ulHour ) - { - ulHour = 0; - } - - if ( GetTimeZoneInformation( &tzInfo ) == TIME_ZONE_ID_INVALID ) - { + if( GetTimeZoneInformation( &tzInfo ) == TIME_ZONE_ID_INVALID ) tzInfo.Bias = 0; - } else - { tzInfo.Bias -= tzInfo.Bias; - } - if ( !pDate ) + if( !pDate ) { GetLocalTime( &st ); @@ -142,35 +132,14 @@ HB_FUNC( TIP_TIMESTAMP ) (int)( tzInfo.Bias % 60 > 0 ? - tzInfo.Bias % 60 : tzInfo.Bias % 60 ) ); } - nLen = strlen( szRet ); - if ( nLen < 64 ) - { - szRet = (char *) hb_xrealloc( szRet, nLen + 1 ); - } - hb_retclen_buffer( szRet, nLen ); - -} - #else -HB_FUNC( TIP_TIMESTAMP ) -{ - PHB_ITEM pDate = hb_param( 1, HB_IT_DATE ); - ULONG ulHour = hb_parl(2); - int nLen; - char szDate[9]; + char szDate[ 9 ]; struct tm tmTime; time_t current; - char *szRet = (char *) hb_xgrab( 64 ); - - if ( !ulHour ) - { - ulHour = 0; - } - /* init time structure anyway */ time( ¤t ); #if defined( HB_HAS_LOCALTIME_R ) @@ -204,15 +173,14 @@ HB_FUNC( TIP_TIMESTAMP ) nLen = strftime( szRet, 64, "%a, %d %b %Y %H:%M:%S %z", &tmTime ); +#endif + if ( nLen < 64 ) - { - szRet = (char *) hb_xrealloc( szRet, nLen + 1 ); - } + szRet = ( char * ) hb_xrealloc( szRet, nLen + 1 ); + hb_retclen_buffer( szRet, nLen ); } -#endif - /** Detects the mimetype of a given file */ typedef struct tag_mime diff --git a/harbour/doc/cmdline.txt b/harbour/doc/cmdline.txt index f091d34237..25da703905 100644 --- a/harbour/doc/cmdline.txt +++ b/harbour/doc/cmdline.txt @@ -10,21 +10,21 @@ compiler and #pragma directives in the source code. The command line always overrides the envvar. -Note that some switches are not accepted in envvar, +Note that some switches are not accepted in envvar, some others in #pragmas. First the parser should start to step through -all the tokens in the string separated by +all the tokens in the string separated by whitespace. (or just walk through all argv[]) 1.) If the token begins with "-", it should be treated as a new style switch. One or more switch characters can follow - this. The "-" sign inside the token + this. The "-" sign inside the token will turn off the switch. - If the switch has an argument all the following + If the switch has an argument all the following characters are treated as part of the argument. The "/" sign has no special meaning here. @@ -44,7 +44,7 @@ whitespace. (or just walk through all argv[]) -w- -w -w- ( finally: !W ) -2.) If the token begins with "/", it +2.) If the token begins with "/", it should be treated as a compatibility style switch. The parser scans the token for the next "/" sign or EOS @@ -55,7 +55,7 @@ whitespace. (or just walk through all argv[]) allowing the usage of quote characters. This is mostly a problem on systems which use "/" as path separator. - The "-" sign has no special meaning here, it can't be + The "-" sign has no special meaning here, it can't be used to disable a switch. /w/n ( W N ) @@ -72,14 +72,14 @@ The Harbour switches are always case insensitive. In the Harbour commandline the two style can be used together: harbour -wnes2 /gc0/q0 -iC:\hello -Exceptions: +Exceptions: -- Handlig of the /CREDIT undocumented switch +- Handlig of the /CREDIT undocumented switch on Harbour command line is unusual, check the current code for this. - The CLIPPER, HARBOUR and Harbour application - command line parsing is a different beast, + command line parsing is a different beast, see cmdarg.c for a NOTE. Just some examples for the various accepted forms: @@ -91,4 +91,8 @@ Exceptions: "//" should always be used on the command line. -Viktor Szakats + +[ Copyright (c) 1999-2009 Viktor Szakats + Licensed under Creative Commons Attribution-ShareAlike 3.0: + http://creativecommons.org/licenses/by-sa/3.0/ + See COPYING. ] diff --git a/harbour/doc/howtosvn.txt b/harbour/doc/howtosvn.txt index 0c8be8e9cc..82b3f7f423 100644 --- a/harbour/doc/howtosvn.txt +++ b/harbour/doc/howtosvn.txt @@ -190,3 +190,9 @@ Note that last dollar sign is mandatory. Run these commands and commit: svn propset svn:keywords "Author Date Id Revision" "filename" svn propset svn:eol-style native "filename" + + +[ Copyright (c) 1999-2009 Viktor Szakats + Licensed under Creative Commons Attribution-ShareAlike 3.0: + http://creativecommons.org/licenses/by-sa/3.0/ + See COPYING. ] diff --git a/harbour/include/hbextern.ch b/harbour/include/hbextern.ch index 0dfadc1d96..1ac7790cfd 100644 --- a/harbour/include/hbextern.ch +++ b/harbour/include/hbextern.ch @@ -917,6 +917,7 @@ EXTERNAL HB_DISABLEWAITLOCKS EXTERNAL HB_MACROBLOCK EXTERNAL HB_MMIDDLEDOWN EXTERNAL HB_STRFORMAT +EXTERNAL HB_ALERT EXTERNAL HB_INISETCOMMENT EXTERNAL HB_INIREAD diff --git a/harbour/source/rtl/alert.prg b/harbour/source/rtl/alert.prg index 0ee7858d96..c45ac74dff 100644 --- a/harbour/source/rtl/alert.prg +++ b/harbour/source/rtl/alert.prg @@ -4,7 +4,7 @@ /* * Harbour Project source code: - * ALERT() function + * ALERT(), HB_ALERT() functions * * Released to Public Domain by Vladimir Kazimirchik * www - http://www.harbour-project.org @@ -39,21 +39,14 @@ /* NOTE: Clipper handles these buttons { "Ok", "", "Cancel" } in a buggy way. This is fixed. [vszakats] */ -/* NOTE: nDelay parameter is a Harbour extension. */ - #ifdef HB_C52_UNDOC STATIC s_lNoAlert #endif -FUNCTION Alert( xMessage, aOptions, cColorNorm, nDelay ) - LOCAL cMessage +FUNCTION Alert( cMessage, aOptions, cColorNorm ) LOCAL cColorHigh LOCAL aOptionsOK LOCAL nEval -#ifdef HB_EXTENSION - LOCAL lFirst - LOCAL cLine -#endif #ifdef HB_C52_UNDOC @@ -65,7 +58,62 @@ FUNCTION Alert( xMessage, aOptions, cColorNorm, nDelay ) #endif -#ifdef HB_EXTENSION + IF ! ISCHARACTER( cMessage ) + RETURN NIL + ENDIF + + cMessage := StrTran( cMessage, ";", Chr( 10 ) ) + + IF ! ISARRAY( aOptions ) + aOptions := {} + ENDIF + + IF ! ISCHARACTER( cColorNorm ) .OR. Empty( cColorNorm ) + cColorNorm := "W+/R" // first pair color (Box line and Text) + cColorHigh := "W+/B" // second pair color (Options buttons) + ELSE + cColorHigh := StrTran( StrTran( iif( At( "/", cColorNorm ) == 0, "N", SubStr( cColorNorm, At( "/", cColorNorm ) + 1 ) ) + "/" +; + iif( At( "/", cColorNorm ) == 0, cColorNorm, Left( cColorNorm, At( "/", cColorNorm ) - 1 ) ), "+", "" ), "*", "" ) + ENDIF + + aOptionsOK := {} + FOR nEval := 1 TO Len( aOptions ) + IF ISCHARACTER( aOptions[ nEval ] ) .AND. ! Empty( aOptions[ nEval ] ) + AAdd( aOptionsOK, aOptions[ nEval ] ) + ENDIF + NEXT + + IF Len( aOptionsOK ) == 0 + aOptionsOK := { "Ok" } +#ifdef HB_C52_STRICT + /* NOTE: Clipper allows only four options [vszakats] */ + ELSEIF Len( aOptionsOK ) > 4 + ASize( aOptionsOK, 4 ) +#endif + ENDIF + + RETURN hb_gtAlert( cMessage, aOptionsOK, cColorNorm, cColorHigh ) + +/* NOTE: xMessage can be of any type. This is a Harbour extension over Alert(). */ +/* NOTE: nDelay parameter is a Harbour extension over Alert(). */ + +FUNCTION hb_Alert( xMessage, aOptions, cColorNorm, nDelay ) + LOCAL cMessage + LOCAL cColorHigh + LOCAL aOptionsOK + LOCAL nEval + LOCAL lFirst + LOCAL cLine + +#ifdef HB_C52_UNDOC + + DEFAULT s_lNoAlert TO hb_argCheck( "NOALERT" ) + + IF s_lNoAlert + RETURN NIL + ENDIF + +#endif IF PCount() == 0 RETURN NIL @@ -88,21 +136,11 @@ FUNCTION Alert( xMessage, aOptions, cColorNorm, nDelay ) cMessage := hb_CStr( xMessage ) ENDIF -#else - - IF !ISCHARACTER( xMessage ) - RETURN NIL - ENDIF - - cMessage := StrTran( xMessage, ";", Chr( 10 ) ) - -#endif - - IF !ISARRAY( aOptions ) + IF ! ISARRAY( aOptions ) aOptions := {} ENDIF - IF !ISCHARACTER( cColorNorm ) .OR. EMPTY( cColorNorm ) + IF !ISCHARACTER( cColorNorm ) .OR. Empty( cColorNorm ) cColorNorm := "W+/R" // first pair color (Box line and Text) cColorHigh := "W+/B" // second pair color (Options buttons) ELSE @@ -112,7 +150,7 @@ FUNCTION Alert( xMessage, aOptions, cColorNorm, nDelay ) aOptionsOK := {} FOR nEval := 1 TO Len( aOptions ) - IF ISCHARACTER( aOptions[ nEval ] ) .AND. !Empty( aOptions[ nEval ] ) + IF ISCHARACTER( aOptions[ nEval ] ) .AND. ! Empty( aOptions[ nEval ] ) AAdd( aOptionsOK, aOptions[ nEval ] ) ENDIF NEXT