fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

2009-05-12 09:25 UTC+0200 Viktor Szakats (harbour.01 syenar hu)

Browse Source 
* 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.
This commit is contained in:
Viktor Szakats
2009-05-12 07:32:45 +00:00
parent 7298be02bd
commit 52e2e002e5
12 changed files with 286 additions and 238 deletions
Download Patch File Download Diff File Expand all files Collapse all files

40
harbour/ChangeLog
View File

@@ -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

16
harbour/contrib/hbtip/base64x.c
View File

@@ -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 );

44
harbour/contrib/hbtip/ftpcln.prg
View File

@@ -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 )

10
harbour/contrib/hbtip/httpcln.prg
View File

@@ -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

10
harbour/contrib/hbtip/sendmail.prg
View File

@@ -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

186
harbour/contrib/hbtip/smtpcln.prg
View File

@@ -7,7 +7,6 @@
* TIP Class oriented Internet protocol library
*
* Copyright 2003 Giancarlo Niccolai <gian@niccolai.ws>
*
* 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

37
harbour/contrib/hbtip/thtml.prg
View File

@@ -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 += "&amp;" + SubStr( cText, 2 )
LOOP
END
ENDSWITCH
nStart := parser:p_pos
FOR EACH aEntity IN saHtmlAnsiEntities

66
harbour/contrib/hbtip/utils.c
View File

@@ -7,7 +7,6 @@
* TIP Class oriented Internet protocol library
*
* Copyright 2003 Giancarlo Niccolai <gian@niccolai.ws>
*
* 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 <time.h>
#else
#ifdef HB_OS_WIN
#include <windows.h>
#else
#include <time.h>
#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( &current );
#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

24
harbour/doc/cmdline.txt
View File

@@ -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 <viktor.szakats@syenar.hu>
[ Copyright (c) 1999-2009 Viktor Szakats <harbour.01 syenar.hu>
Licensed under Creative Commons Attribution-ShareAlike 3.0:
http://creativecommons.org/licenses/by-sa/3.0/
See COPYING. ]

6
harbour/doc/howtosvn.txt
View File

@@ -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 <harbour.01 syenar.hu>
Licensed under Creative Commons Attribution-ShareAlike 3.0:
http://creativecommons.org/licenses/by-sa/3.0/
See COPYING. ]

1
harbour/include/hbextern.ch
View File

@@ -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

84
harbour/source/rtl/alert.prg
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* ALERT() function
* ALERT(), HB_ALERT() functions
*
* Released to Public Domain by Vladimir Kazimirchik <v_kazimirchik@yahoo.com>
* 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