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

2009-07-08 01:11 UTC+0200 Viktor Szakats (harbour.01 syenar.hu)

Browse Source 
* contrib/hbtip/encurl.prg
  * contrib/hbtip/thtml.prg
  * contrib/hbtip/sessid.prg
  * contrib/hbtip/popcln.prg
  * contrib/hbtip/cgi.prg
  * contrib/hbtip/url.prg
  * contrib/hbtip/encqp.prg
  * contrib/hbtip/httpcln.prg
  * contrib/hbtip/client.prg
  * contrib/hbtip/encoder.prg
  * contrib/hbtip/smtpcln.prg
  * contrib/hbtip/encb64.prg
  * contrib/hbtip/mail.prg
  * contrib/hbtip/credent.prg
  * contrib/hbtip/ftpcln.prg
    * Some formatting.
    ! Reverted "CLASS VAR" to "CLASS DATA" as they are a little bit
      different.
This commit is contained in:
Viktor Szakats
2009-07-07 23:12:27 +00:00
parent 27f02095a2
commit 2d2e6a0cf6
16 changed files with 366 additions and 346 deletions
Download Patch File Download Diff File Expand all files Collapse all files

20
harbour/ChangeLog
View File

@@ -17,6 +17,26 @@
past entries belonging to author(s): Viktor Szakats.
*/
2009-07-08 01:11 UTC+0200 Viktor Szakats (harbour.01 syenar.hu)
* contrib/hbtip/encurl.prg
* contrib/hbtip/thtml.prg
* contrib/hbtip/sessid.prg
* contrib/hbtip/popcln.prg
* contrib/hbtip/cgi.prg
* contrib/hbtip/url.prg
* contrib/hbtip/encqp.prg
* contrib/hbtip/httpcln.prg
* contrib/hbtip/client.prg
* contrib/hbtip/encoder.prg
* contrib/hbtip/smtpcln.prg
* contrib/hbtip/encb64.prg
* contrib/hbtip/mail.prg
* contrib/hbtip/credent.prg
* contrib/hbtip/ftpcln.prg
* Some formatting.
! Reverted "CLASS VAR" to "CLASS DATA" as they are a little bit
different.
2009-07-08 00:42 UTC+0200 Viktor Szakats (harbour.01 syenar.hu)
* contrib/hbtip/Makefile
* contrib/hbtip/thtml.prg

132
harbour/contrib/hbtip/cgi.prg
View File

@@ -111,13 +111,13 @@ ENDCLASS
METHOD New() CLASS TIpCgi
local aTemp
local aVar
local lPost
local nCount
local nLen
local nRead
local cTemp
LOCAL aTemp
LOCAL aVar
LOCAL lPost
LOCAL nCount
LOCAL nLen
LOCAL nRead
LOCAL cTemp
::bSavedErrHandler := ErrorBlock( { |e| ::ErrHandler( e ) } )
@@ -128,7 +128,7 @@ METHOD New() CLASS TIpCgi
if lPost
nLen := val( getenv( "CONTENT_LENGTH" ) )
cTemp := space( nLen )
if ( ( nRead := fread( CGI_IN, @cTemp, nLen, 0 ) ) != nLen )
if ( ( nRead := FRead( CGI_IN, @cTemp, nLen, 0 ) ) != nLen )
::ErrHandler( "post error read " + str( nRead ) + " instead of " + str( nLen ) )
else
::HTTP_RAW_POST_DATA := cTemp
@@ -199,16 +199,16 @@ METHOD Print( cString ) CLASS TIpCgi
METHOD Flush() CLASS TIpCgi
local nLen
local cStream
local lRet
LOCAL nLen
LOCAL cStream
LOCAL lRet
local nH
local cFile
local nFileSize
LOCAL nH
LOCAL cFile
LOCAL nFileSize
local cSID := ::cSID
local cSession
LOCAL cSID := ::cSID
LOCAL cSession
hb_hEval( ::hCookies, { |k,v| ::cCgiHeader += "Set-Cookie: " + k + "=" + v + ";" + _CRLF } )
@@ -225,7 +225,7 @@ METHOD Flush() CLASS TIpCgi
if ( nH := FCreate( ::cDumpSavePath + "dump.html", FC_NORMAL ) ) != -1
Fwrite( nH, ::cHtmlPage, len( ::cHtmlPage ) )
endif
fclose( nH )
FClose( nH )
endif
::cCgiHeader := ""
@@ -240,10 +240,10 @@ METHOD Flush() CLASS TIpCgi
nFileSize := len( cSession )
if ( nH := FCreate( cFile, FC_NORMAL ) ) != -1
if ( fwrite( nH, @cSession, nFileSize ) ) != nFileSize
if ( FWrite( nH, @cSession, nFileSize ) ) != nFileSize
::Print( "ERROR: On writing session file : " + cFile + ", File error : " + hb_cStr( FError() ) )
endif
fclose( nH )
FClose( nH )
else
::Print( "ERROR: On writing session file : " + cFile + ", File error : " + hb_cStr( FError() ) )
endif
@@ -254,9 +254,9 @@ METHOD Flush() CLASS TIpCgi
METHOD DestroySession( cID ) CLASS TIpCgi
local cFile
local cSID := ::cSID
local lRet
LOCAL cFile
LOCAL cSID := ::cSID
LOCAL lRet
if !empty( cID )
cSID := cID
@@ -283,7 +283,7 @@ RETURN lRet
METHOD ErrHandler( xError ) CLASS TIpCgi
local nCalls
LOCAL nCalls
::Print( '<table border="1">' )
@@ -294,7 +294,7 @@ METHOD ErrHandler( xError ) CLASS TIpCgi
::Print( '<tr><td>OPERATION:</td><td>' + xError:Operation + '</td></tr>' )
::Print( '<tr><td>OS ERROR:</td><td>' + alltrim( str( xError:OsCode ) ) + ' IN ' + xError:SubSystem + '/' + alltrim( str( xError:SubCode ) ) + '</td></tr>' )
::Print( '<tr><td>FILENAME:</td><td>' + right( xError:FileName, 40 ) + '</td></tr>' )
elseif ISCHARACTER( xError )
ELSEIF ISCHARACTER( xError )
::Print( '<tr><td>ERROR MESSAGE:</td><td>' + xError + '</td></tr>' )
endif
@@ -308,7 +308,7 @@ METHOD ErrHandler( xError ) CLASS TIpCgi
::Flush()
RETURN nil
RETURN NIL
METHOD StartHtml( hOptions ) CLASS TIpCgi
@@ -360,40 +360,40 @@ METHOD EndFrameSet( hOptions ) CLASS TIpCgi
METHOD SaveHtmlPage( cFile ) CLASS TIpCgi
local nFile
local lSuccess
local nLen
local cStream
LOCAL nFile
LOCAL lSuccess
LOCAL nLen
LOCAL cStream
cStream := ::cHtmlPage + _CRLF
nLen := len( cStream )
nFile := fcreate( cFile )
nFile := FCreate( cFile )
if nFile != 0
lSuccess := ( fwrite( nFile, cStream, nLen ) == nLen )
fclose( nFile )
lSuccess := ( FWrite( nFile, cStream, nLen ) == nLen )
FClose( nFile )
else
lSuccess := .f.
lSuccess := .F.
endif
RETURN lSuccess
METHOD StartSession( cSID ) CLASS TIpCgi
local nH
local cFile
local nFileSize
local cBuffer
LOCAL nH
LOCAL cFile
LOCAL nFileSize
LOCAL cBuffer
if empty( cSID )
if ( nH := hb_HPos( ::hGets, "SESSIONID" ) ) != 0
cSID := hb_HValueAt( ::hGets, nH )
elseif ( nH := hb_HPos( ::hPosts, "SESSIONID" ) ) != 0
ELSEIF ( nH := hb_HPos( ::hPosts, "SESSIONID" ) ) != 0
cSID := hb_HValueAt( ::hPosts, nH )
elseif ( nH := hb_HPos( ::hCookies, "SESSIONID" ) ) != 0
ELSEIF ( nH := hb_HPos( ::hCookies, "SESSIONID" ) ) != 0
cSID := hb_HValueAt( ::hCookies, nH )
endif
@@ -419,7 +419,7 @@ METHOD StartSession( cSID ) CLASS TIpCgi
else
::SessionDecode( cBuffer )
endif
fclose( nH )
FClose( nH )
endif
else
::ErrHandler( "ERROR: On opening session file : " + cFile + ", file not exist." )
@@ -448,11 +448,11 @@ METHOD SessionDecode( cData ) CLASS TIpCgi
STATIC FUNCTION HtmlTag( xVal, cKey, cDefault )
local cVal := ""
LOCAL cVal := ""
DEFAULT cDefault TO ""
if !empty( xVal ) .and. !empty( cKey )
if !empty( xVal ) .AND. !empty( cKey )
if hb_hHasKey( xVal, cKey )
cVal := hb_hGet( xVal, cKey )
hb_hDel( xVal, cKey )
@@ -467,61 +467,61 @@ STATIC FUNCTION HtmlTag( xVal, cKey, cDefault )
cVal := "<" + cKey + ">" + cVal + "</" + cKey + ">"
endif
return cVal
RETURN cVal
STATIC FUNCTION HtmlAllTag( hTags, cSep )
local cVal := ""
LOCAL cVal := ""
DEFAULT cSep TO " "
hb_hEval( hTags, { |k| cVal += HtmlTag( hTags, k ) + cSep } )
return cVal
RETURN cVal
STATIC FUNCTION HtmlOption( xVal, cKey, cPre, cPost, lScan )
local cVal := ""
LOCAL cVal := ""
if !empty( xVal )
if empty( cKey )
cVal := xVal
elseif hb_hHasKey( xVal, cKey )
ELSEIF hb_hHasKey( xVal, cKey )
cVal := hb_hGet( xVal, cKey )
if empty( lScan )
hb_hDel( xVal, cKey )
endif
cVal := cKey + '="' + cVal + '"'
if cPre != nil
if cPre != NIL
cVal := cPre + cVal
endif
if cPost != nil
if cPost != NIL
cVal := cVal + cPost
endif
endif
endif
return cVal
RETURN cVal
STATIC FUNCTION HtmlAllOption( hOptions, cSep )
local cVal := ""
LOCAL cVal := ""
DEFAULT cSep TO " "
if !empty( hOptions )
hb_hEval( hOptions, { |k| cVal += HtmlOption( hOptions, k,,, .t. ) + cSep } )
hb_hEval( hOptions, { |k| cVal += HtmlOption( hOptions, k,,, .T. ) + cSep } )
endif
return cVal
RETURN cVal
STATIC FUNCTION HtmlValue( xVal, cKey, cDefault )
local cVal := ""
LOCAL cVal := ""
DEFAULT cDefault TO ""
if !empty( xVal ) .and. !empty( cKey )
if !empty( xVal ) .AND. !empty( cKey )
if hb_hHasKey( xVal, cKey )
cVal := hb_hGet( xVal, cKey )
hb_hDel( xVal, cKey )
@@ -532,11 +532,11 @@ STATIC FUNCTION HtmlValue( xVal, cKey, cDefault )
cVal := cDefault
endif
return cVal
RETURN cVal
STATIC FUNCTION HtmlAllValue( hValues, cSep )
local cVal := ""
LOCAL cVal := ""
DEFAULT cSep TO " "
@@ -544,13 +544,13 @@ STATIC FUNCTION HtmlAllValue( hValues, cSep )
hb_hEval( hValues, { |k| cVal += HtmlValue( hValues, k ) + cSep } )
endif
return cVal
RETURN cVal
STATIC FUNCTION HtmlScript( xVal, cKey )
local cVal := ""
local nPos
local cTmp
LOCAL cVal := ""
LOCAL nPos
LOCAL cTmp
DEFAULT cKey TO "script"
@@ -585,13 +585,13 @@ STATIC FUNCTION HtmlScript( xVal, cKey )
endif
endif
return cVal
RETURN cVal
STATIC FUNCTION HtmlStyle( xVal, cKey )
local cVal := ""
local nPos
local cTmp
LOCAL cVal := ""
LOCAL nPos
LOCAL cTmp
DEFAULT cKey TO "style"
@@ -626,4 +626,4 @@ STATIC FUNCTION HtmlStyle( xVal, cKey )
endif
endif
return cVal
RETURN cVal

4
harbour/contrib/hbtip/client.prg
View File

@@ -83,8 +83,8 @@
*/
CREATE CLASS tIPClient
CLASS VAR bInitSocks INIT .F.
CLASS VAR cCRLF INIT hb_inetCRLF()
CLASSDATA bInitSocks INIT .F.
CLASSDATA cCRLF INIT hb_inetCRLF()
VAR oUrl /* url to wich to connect */
VAR oCredentials /* credential needed to access the service */

8
harbour/contrib/hbtip/credent.prg
View File

@@ -58,8 +58,8 @@
* A way to give basic credentials
*/
CLASS tIPCredentials
DATA cMethod
DATA cUserid
DATA cPassword
CREATE CLASS tIPCredentials
VAR cMethod
VAR cUserid
VAR cPassword
ENDCLASS

4
harbour/contrib/hbtip/encb64.prg
View File

@@ -53,11 +53,11 @@
#include "hbclass.ch"
CLASS TIPEncoderBase64 FROM TIPEncoder
CREATE CLASS TIPEncoderBase64 FROM TIPEncoder
// Set this to .T. to enable RFC 2068 (HTTP/1.1) exception to
// RFC 2045 (MIME) base64 format. This exception consists in
// not applying CRLF after each 76 output bytes.
DATA bHttpExcept
VAR bHttpExcept
METHOD New() Constructor
METHOD Encode( cData )

8
harbour/contrib/hbtip/encoder.prg
View File

@@ -83,10 +83,10 @@ FUNCTION TIp_GetEncoder( cModel )
CASE cModel == "quoted-printable"
oEncoder := TIPEncoderQP():New()
CASE cModel == "url" .or. cModel == "urlencoded"
CASE cModel == "url" .OR. cModel == "urlencoded"
oEncoder := TIPEncoderURL():New()
CASE cModel == "7bit" .or. cModel == "8bit"
CASE cModel == "7bit" .OR. cModel == "8bit"
oEncoder := TIPEncoder():New( cModel )
oEncoder:cName := cModel
@@ -99,8 +99,8 @@ RETURN oEncoder
CLASS TIPEncoder
DATA cName
CREATE CLASS TIPEncoder
VAR cName
METHOD New( cModel )
METHOD Encode( cData )

4
harbour/contrib/hbtip/encqp.prg
View File

@@ -54,8 +54,8 @@
#include "hbclass.ch"
CLASS TIPEncoderQP FROM TIPEncoder
METHOD New() Constructor
CREATE CLASS TIPEncoderQP FROM TIPEncoder
METHOD New() CONSTRUCTOR
METHOD Encode( cData )
METHOD Decode( cData )
ENDCLASS

4
harbour/contrib/hbtip/encurl.prg
View File

@@ -54,8 +54,8 @@
#include "hbclass.ch"
CLASS TIPEncoderUrl FROM TIPEncoder
METHOD New() Constructor
CREATE CLASS TIPEncoderUrl FROM TIPEncoder
METHOD New() CONSTRUCTOR
METHOD Encode()
METHOD Decode()
ENDCLASS

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

@@ -106,16 +106,16 @@ STATIC s_nPort := 16000
* Inet service manager: ftp
*/
CLASS tIPClientFTP FROM tIPClient
DATA nDataPort
DATA cDataServer
DATA bUsePasv
DATA RegBytes
DATA RegPasv
CREATE CLASS tIPClientFTP FROM tIPClient
VAR nDataPort
VAR cDataServer
VAR bUsePasv
VAR RegBytes
VAR RegPasv
// Socket opened in response to a port command
DATA SocketControl
DATA SocketPortServer
DATA cLogFile
VAR SocketControl
VAR SocketPortServer
VAR cLogFile
METHOD New( oUrl, lTrace, oCredentials )
METHOD Open()
@@ -164,8 +164,8 @@ ENDCLASS
METHOD New( oUrl,lTrace, oCredentials) CLASS tIPClientFTP
local cFile :="ftp"
local n := 0
LOCAL cFile :="ftp"
LOCAL n := 0
::super:new( oUrl, lTrace, oCredentials)
::nDefaultPort := 21
@@ -177,13 +177,13 @@ METHOD New( oUrl,lTrace, oCredentials) CLASS tIPClientFTP
if ::ltrace
if !hb_FileExists("ftp.log")
::nHandle := fcreate("ftp.log")
::nHandle := FCreate("ftp.log")
else
while hb_FileExists(cFile+hb_NToS(Int(n))+".log")
n++
enddo
::cLogFile:= cFile+hb_NToS(Int(n))+".log"
::nHandle := fcreate(::cLogFile)
::nHandle := FCreate(::cLogFile)
endif
endif
@@ -195,8 +195,8 @@ RETURN Self
METHOD StartCleanLogFile() CLASS tIPClientFTP
fclose(::nHandle)
::nHandle := fcreate(::cLogFile)
FClose(::nHandle)
::nHandle := FCreate(::cLogFile)
RETURN NIL
@@ -206,11 +206,11 @@ METHOD Open( cUrl ) CLASS tIPClientFTP
::oUrl := tUrl():New( cUrl )
ENDIF
IF Len( ::oUrl:cUserid ) == 0 .or. Len( ::oUrl:cPassword ) == 0
IF Len( ::oUrl:cUserid ) == 0 .OR. Len( ::oUrl:cPassword ) == 0
RETURN .F.
ENDIF
IF .not. ::super:Open()
IF ! ::super:Open()
RETURN .F.
ENDIF
@@ -220,7 +220,7 @@ METHOD Open( cUrl ) CLASS tIPClientFTP
IF ::GetReply()
::InetSendall( ::SocketCon, "PASS " + ::oUrl:cPassword + ::cCRLF )
// set binary by default
IF ::GetReply() .and. ::TypeI()
IF ::GetReply() .AND. ::TypeI()
RETURN .T.
ENDIF
ENDIF
@@ -240,13 +240,13 @@ METHOD GetReply() CLASS tIPClientFTP
ENDIF
// now, if the reply has a "-" as fourth character, we need to proceed...
DO WHILE .not. Empty(cRep) .and. SubStr( cRep, 4, 1 ) == "-"
DO WHILE ! Empty(cRep) .AND. SubStr( cRep, 4, 1 ) == "-"
::cReply := ::InetRecvLine( ::SocketCon, @nLen, 128 )
cRep := IIf(ISCHARACTER(::cReply), ::cReply, "")
ENDDO
// 4 and 5 are error codes
IF ::InetErrorCode( ::SocketCon ) != 0 .or. Left( ::cReply, 1 ) >= "4"
IF ::InetErrorCode( ::SocketCon ) != 0 .OR. Left( ::cReply, 1 ) >= "4"
RETURN .F.
ENDIF
@@ -256,7 +256,7 @@ METHOD Pasv() CLASS tIPClientFTP
LOCAL aRep
::InetSendall( ::SocketCon, "PASV" + ::cCRLF )
IF .not. ::GetReply()
IF ! ::GetReply()
RETURN .F.
ENDIF
aRep := HB_Regex( ::RegPasv, ::cReply )
@@ -314,7 +314,7 @@ RETURN ::GetReply()
METHOD PWD() CLASS tIPClientFTP
::InetSendall( ::SocketCon, "PWD" + ::cCRLF )
IF .not. ::GetReply()
IF ! ::GetReply()
RETURN .F.
ENDIF
::cReply := SubStr( ::cReply, At('"', ::cReply) + 1, ;
@@ -331,7 +331,7 @@ RETURN ::GetReply()
METHOD ScanLength() CLASS tIPClientFTP
LOCAL aBytes
aBytes := HB_Regex( ::RegBytes, ::cReply )
IF .not. Empty(aBytes)
IF ! Empty(aBytes)
::nLength := Val( aBytes[2] )
ENDIF
RETURN .T.
@@ -343,7 +343,7 @@ METHOD TransferStart() CLASS tIPClientFTP
IF ::bUsePasv
skt := HB_InetConnectIP( ::cDataServer, ::nDataPort )
IF skt != NIL .and. ::InetErrorCode( skt ) == 0
IF skt != NIL .AND. ::InetErrorCode( skt ) == 0
// Get the start message from the control connection
IF ! ::GetReply()
HB_InetClose( skt )
@@ -384,7 +384,7 @@ METHOD Commit() CLASS tIPClientFTP
::SocketCon := ::SocketControl
::bInitialized := .F.
IF .not. ::GetReply()
IF ! ::GetReply()
RETURN .F.
ENDIF
@@ -399,38 +399,38 @@ RETURN .T.
METHOD List( cSpec ) CLASS tIPClientFTP
LOCAL cStr
IF cSpec == nil
IF cSpec == NIL
cSpec := ""
ELSE
cSpec := " " + cSpec
ENDIF
IF ::bUsePasv
IF .not. ::Pasv()
IF ! ::Pasv()
//::bUsePasv := .F.
RETURN NIL
ENDIF
ENDIF
IF .not. ::bUsePasv
IF .not. ::Port()
IF ! ::bUsePasv
IF ! ::Port()
RETURN NIL
ENDIF
ENDIF
::InetSendAll( ::SocketCon, "LIST" + cSpec + ::cCRLF )
cStr := ::ReadAuxPort()
::bEof := .f.
::bEof := .F.
RETURN cStr
METHOD UserCommand( cCommand, lPasv, lReadPort, lGetReply ) CLASS tIPClientFTP
DEFAULT cCommand TO ""
DEFAULT lPasv TO .t.
DEFAULT lReadPort TO .t.
DEFAULT lGetReply TO .f.
DEFAULT lPasv TO .T.
DEFAULT lReadPort TO .T.
DEFAULT lGetReply TO .F.
if ::bUsePasv .and. lPasv .and. !::Pasv()
return .f.
if ::bUsePasv .AND. lPasv .AND. !::Pasv()
RETURN .F.
endif
::InetSendAll( ::SocketCon, cCommand )
@@ -443,7 +443,7 @@ METHOD UserCommand( cCommand, lPasv, lReadPort, lGetReply ) CLASS tIPClientFTP
lGetReply := ::GetReply()
endif
RETURN .t.
RETURN .T.
METHOD ReadAuxPort( cLocalFile ) CLASS tIPClientFTP
@@ -472,7 +472,7 @@ METHOD ReadAuxPort( cLocalFile ) CLASS tIPClientFTP
IF ::GetReply()
IF nFile > 0
FClose( nFile )
RETURN .t.
RETURN .T.
ENDIF
RETURN cList
ENDIF
@@ -482,7 +482,7 @@ RETURN NIL
METHOD Stor( cFile ) CLASS tIPClientFTP
IF ::bUsePasv
IF .not. ::Pasv()
IF ! ::Pasv()
//::bUsePasv := .F.
RETURN .F.
ENDIF
@@ -530,11 +530,11 @@ RETURN ::GetReply()
METHOD Read( nLen ) CLASS tIPClientFTP
LOCAL cRet
IF .not. ::bInitialized
IF ! ::bInitialized
IF .not. Empty( ::oUrl:cPath )
IF ! Empty( ::oUrl:cPath )
IF .not. ::CWD( ::oUrl:cPath )
IF ! ::CWD( ::oUrl:cPath )
::bEof := .T. // no data for this transaction
RETURN NIL
@@ -549,7 +549,7 @@ METHOD Read( nLen ) CLASS tIPClientFTP
ENDIF
IF .not. ::Retr( ::oUrl:cFile )
IF ! ::Retr( ::oUrl:cFile )
::bEof := .T. // no data for this transaction
RETURN NIL
@@ -577,7 +577,7 @@ RETURN cRet
*
METHOD Write( cData, nLen ) CLASS tIPClientFTP
IF .not. ::bInitialized
IF ! ::bInitialized
IF Empty( ::oUrl:cFile )
@@ -585,15 +585,15 @@ METHOD Write( cData, nLen ) CLASS tIPClientFTP
ENDIF
IF .not. Empty( ::oUrl:cPath )
IF ! Empty( ::oUrl:cPath )
IF .not. ::CWD( ::oUrl:cPath )
IF ! ::CWD( ::oUrl:cPath )
RETURN -1
ENDIF
ENDIF
IF .not. ::Stor( ::oUrl:cFile )
IF ! ::Stor( ::oUrl:cFile )
RETURN -1
ENDIF
@@ -610,7 +610,7 @@ RETURN ::super:Write( cData, nLen, .F. )
METHOD Retr( cFile ) CLASS tIPClientFTP
IF ::bUsePasv
IF .not. ::Pasv()
IF ! ::Pasv()
//::bUsePasv := .F.
RETURN .F.
ENDIF
@@ -629,14 +629,14 @@ METHOD MGET( cSpec,cLocalPath ) CLASS tIPClientFTP
LOCAL cStr,cfile,aFiles
IF cSpec == nil
IF cSpec == NIL
cSpec := ""
ENDIF
IF cLocalPath == nil
IF cLocalPath == NIL
cLocalPath:=""
ENDIF
IF ::bUsePasv
IF .not. ::Pasv()
IF ! ::Pasv()
//::bUsePasv := .F.
RETURN .F.
ENDIF
@@ -724,7 +724,7 @@ METHOD LS( cSpec ) CLASS tIPClientFTP
LOCAL cStr
IF cSpec == nil
IF cSpec == NIL
cSpec := ""
ENDIF
@@ -749,7 +749,7 @@ RETURN cStr
/*Rename a traves del ftp */
METHOD Rename( cFrom, cTo ) CLASS tIPClientFTP
Local lResult := .F.
LOCAL lResult := .F.
::InetSendAll( ::SocketCon, "RNFR " + cFrom + ::cCRLF )

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

@@ -59,20 +59,20 @@
* Inet service manager: http
*/
CLASS tIPClientHTTP FROM tIPClient
DATA cMethod
DATA nReplyCode
DATA cReplyDescr
DATA nVersion INIT 1
DATA nSubversion INIT 0
DATA bChunked
DATA hHeaders INIT {=>}
DATA hCookies INIT {=>}
DATA hFields INIT {=>}
DATA cUserAgent INIT "Mozilla/3.0 compatible"
DATA cAuthMode INIT ""
DATA cBoundary
DATA aAttachments init {}
CREATE CLASS tIPClientHTTP FROM tIPClient
VAR cMethod
VAR nReplyCode
VAR cReplyDescr
VAR nVersion INIT 1
VAR nSubversion INIT 0
VAR bChunked
VAR hHeaders INIT {=>}
VAR hCookies INIT {=>}
VAR hFields INIT {=>}
VAR cUserAgent INIT "Mozilla/3.0 compatible"
VAR cAuthMode INIT ""
VAR cBoundary
VAR aAttachments init {}
METHOD New( oUrl,lTrace, oCredentials)
METHOD Get( cQuery )
@@ -104,7 +104,7 @@ RETURN Self
METHOD Get( cQuery ) CLASS tIPClientHTTP
IF .not. HB_IsString( cQuery )
IF ! HB_IsString( cQuery )
cQuery := ::oUrl:BuildQuery()
ENDIF
@@ -134,7 +134,7 @@ METHOD Post( cPostData, cQuery ) CLASS tIPClientHTTP
cData += cTmp + "&"
NEXT
cData := left( cData, len( cData ) - 1 )
elseIF HB_IsArray( cPostData )
ELSEIF HB_IsArray( cPostData )
cData := ""
y:=Len(cPostData)
FOR nI := 1 TO y
@@ -159,14 +159,14 @@ METHOD Post( cPostData, cQuery ) CLASS tIPClientHTTP
RETURN .F.
ENDIF
IF .not. HB_IsString( cQuery )
IF ! HB_IsString( cQuery )
cQuery := ::oUrl:BuildQuery()
ENDIF
::InetSendall( ::SocketCon, "POST " + cQuery + " HTTP/1.1" + ::cCRLF )
::StandardFields()
IF .not. "Content-Type" $ ::hFields
IF ! "Content-Type" $ ::hFields
::InetSendall( ::SocketCon, e"Content-Type: application/x-www-form-urlencoded\r\n" )
ENDIF
@@ -194,7 +194,7 @@ METHOD StandardFields() CLASS tIPClientHTTP
::InetSendall( ::SocketCon, "Connection: close" + ::cCRLF )
// Perform a basic authentication request
IF ::cAuthMode == "Basic" .and. .not. ("Authorization" $ ::hFields)
IF ::cAuthMode == "Basic" .AND. ! ("Authorization" $ ::hFields)
oEncoder := TIPEncoderBase64():New()
oEncoder:bHttpExcept := .T.
::InetSendall( ::SocketCon, "Authorization: Basic " +;
@@ -248,12 +248,12 @@ METHOD ReadHeaders(lClear) CLASS tIPClientHTTP
::nLength := -1
::bChunked := .F.
cLine := ::InetRecvLine( ::SocketCon, @nPos, 500 )
IF !lClear=.f. .AND. !empty(::hHeaders)
::hHeaders:={=>}
IF ! lClear == .F. .AND. !empty(::hHeaders)
::hHeaders := {=>}
ENDIF
DO WHILE ::InetErrorCode( ::SocketCon ) == 0 .and. .not. Empty( cLine )
DO WHILE ::InetErrorCode( ::SocketCon ) == 0 .AND. ! Empty( cLine )
aHead := HB_RegexSplit( ":", cLine,,, 1 )
IF aHead == NIL .or. Len( aHead ) != 2
IF aHead == NIL .OR. Len( aHead ) != 2
cLine := ::InetRecvLine( ::SocketCon, @nPos, 500 )
LOOP
ENDIF
@@ -262,7 +262,7 @@ METHOD ReadHeaders(lClear) CLASS tIPClientHTTP
DO CASE
// RFC 2068 forces to discard content length on chunked encoding
CASE lower( aHead[1] ) == "content-length" .and. .not. ::bChunked
CASE lower( aHead[1] ) == "content-length" .AND. ! ::bChunked
cLine := Substr( cLine, 16 )
::nLength := Val( cLine )
@@ -287,9 +287,9 @@ RETURN .T.
METHOD Read( nLen ) CLASS tIPClientHTTP
LOCAL cData, nPos, cLine, aHead
IF .not. ::bInitialized
IF ! ::bInitialized
::bInitialized := .T.
IF .not. ::Get()
IF ! ::Get()
RETURN NIL
ENDIF
ENDIF
@@ -299,7 +299,7 @@ METHOD Read( nLen ) CLASS tIPClientHTTP
nLenght is set to nRead plus the expected chunk size. After reading the
chunk, the footer is discarded, and nLenght is reset to -1.
*/
IF ::nLength == -1 .and. ::bChunked
IF ::nLength == -1 .AND. ::bChunked
cLine := ::InetRecvLine( ::SocketCon, @nPos, 1024 )
IF Empty( cLine )
@@ -311,7 +311,7 @@ METHOD Read( nLen ) CLASS tIPClientHTTP
// read the footers.
cLine := ::InetRecvLine( ::SocketCon, @nPos, 1024 )
DO WHILE .not. Empty( cLine )
DO WHILE ! Empty( cLine )
// add Headers to footers
aHead := HB_RegexSplit( ":", cLine,,, 1 )
IF aHead != NIL
@@ -344,7 +344,7 @@ METHOD Read( nLen ) CLASS tIPClientHTTP
cData := ::super:Read( nLen )
// If bEof is set with chunked encoding, this means that the whole chunk has been read;
IF ::bEof .and. ::bChunked
IF ::bEof .AND. ::bChunked
::bEof := .F.
::nLength := -1
//chunked data is followed by a blank line
@@ -356,31 +356,31 @@ RETURN cData
METHOD ReadAll() CLASS tIPClientHTTP
local cOut:="", cChunk
IF .not. ::bInitialized
LOCAL cOut:="", cChunk
IF ! ::bInitialized
::bInitialized := .T.
IF .not. ::Get()
IF ! ::Get()
RETURN NIL
ENDIF
ENDIF
IF ::bChunked
cChunk:=::read()
do while cChunk != nil
do while cChunk != NIL
cOut+=cChunk
// ::nLength:=-1
cChunk:=::read()
enddo
else
return(::read())
RETURN ::read()
endif
return(cOut)
RETURN cOut
METHOD setCookie(cLine) CLASS tIPClientHTTP
//docs from http://www.ietf.org/rfc/rfc2109.txt
local aParam
local cHost, cPath, cName, cValue, aElements, cElement
local cDefaultHost:=::oUrl:cServer, cDefaultPath:=::oUrl:cPath
local x,y
LOCAL aParam
LOCAL cHost, cPath, cName, cValue, aElements, cElement
LOCAL cDefaultHost:=::oUrl:cServer, cDefaultPath:=::oUrl:cPath
LOCAL x,y
IF empty(cDefaultPath)
cDefaultPath:="/"
ENDIF
@@ -420,22 +420,22 @@ METHOD setCookie(cLine) CLASS tIPClientHTTP
endif
::hCookies[cHost][cPath][cName]:=cValue
ENDIF
return NIL
RETURN NIL
METHOD getcookies(cHost,cPath) CLASS tIPClientHTTP
local x,y,aDomKeys:={},aKeys,z,cKey,aPathKeys,nPath
local a, b, cOut := "", c, d
IF cHost == nil
LOCAL x,y,aDomKeys:={},aKeys,z,cKey,aPathKeys,nPath
LOCAL a, b, cOut := "", c, d
IF cHost == NIL
cHost:=::oUrl:cServer
ENDIF
IF cPath == nil
IF cPath == NIL
cPath:=::oUrl:cPath
IF empty(cPath)
cPath:="/"
ENDIF
ENDIF
IF empty(cHost)
return(cOut)
RETURN cOut
ENDIF
//tail matching the domain
@@ -445,7 +445,7 @@ METHOD getcookies(cHost,cPath) CLASS tIPClientHTTP
cHost:=upper(cHost)
FOR x := 1 TO y
cKey:=upper(aKeys[x])
IF upper(right(cKey,z))==cHost.and.(len(cKey)=z .OR. substr(aKeys[x],0-z,1)==".")
IF upper(right(cKey,z))==cHost.AND.(len(cKey)=z .OR. substr(aKeys[x],0-z,1)==".")
aadd(aDomKeys,aKeys[x])
ENDIF
NEXT
@@ -461,7 +461,7 @@ METHOD getcookies(cHost,cPath) CLASS tIPClientHTTP
FOR a:= 1 TO b
cKey:=aKeys[a]
z:=len(cKey)
IF cKey=="/".or.(z<=nPath.and.substr(cKey,1,nPath)==cKey)
IF cKey=="/".OR.(z<=nPath.AND.substr(cKey,1,nPath)==cKey)
aadd(aPathKeys,aKeys[a])
ENDIF
NEXT
@@ -478,7 +478,7 @@ METHOD getcookies(cHost,cPath) CLASS tIPClientHTTP
NEXT
NEXT
NEXT
return(cOut)
RETURN cOut
METHOD Boundary(nType) CLASS tIPClientHTTP
/*
@@ -491,9 +491,9 @@ METHOD Boundary(nType) CLASS tIPClientHTTP
---------------------------41184676334 //in the header or CGI envirnment
*/
local cBound:=::cBoundary
LOCAL cBound:=::cBoundary
LOCAL i
IF nType == nil
IF nType == NIL
nType := 0
ENDIF
IF empty(cBound)
@@ -508,17 +508,17 @@ METHOD Boundary(nType) CLASS tIPClientHTTP
METHOD Attach(cName,cFileName,cType) CLASS tIPClientHTTP
aadd(::aAttachments,{cName,cFileName,cType})
return(nil)
RETURN NIL
METHOD PostMultiPart( cPostData, cQuery ) CLASS tIPClientHTTP
LOCAL cData:="", nI, cTmp,y,cBound:=::boundary()
local cCrlf:=::cCRlf,oSub
local nPos
local cFilePath,cName,cFile,cType
local nFile,cBuf,nBuf,nRead
LOCAL cCrlf:=::cCRlf,oSub
LOCAL nPos
LOCAL cFilePath,cName,cFile,cType
LOCAL nFile,cBuf,nBuf,nRead
IF empty(cPostData)
elseif HB_IsHash( cPostData )
ELSEIF HB_IsHash( cPostData )
FOR nI := 1 TO Len( cPostData )
cTmp := hb_HKeyAt( cPostData, nI )
cTmp := hb_cStr( cTmp )
@@ -531,7 +531,7 @@ METHOD PostMultiPart( cPostData, cQuery ) CLASS tIPClientHTTP
cTmp := TipEncoderUrl_Encode( cTmp )
cData += cTmp+cCrLf
NEXT
elseIF HB_IsArray( cPostData )
ELSEIF HB_IsArray( cPostData )
y:=Len(cPostData)
FOR nI := 1 TO y
cTmp := cPostData[ nI ,1]
@@ -554,20 +554,20 @@ METHOD PostMultiPart( cPostData, cQuery ) CLASS tIPClientHTTP
cFile:=oSub[2]
cType:=oSub[3]
cTmp:=strtran(cFile,"/","\")
if ( nPos := rat( "\", cTmp ) ) != 0
IF ( nPos := rat( "\", cTmp ) ) != 0
cFilePath := substr( cTmp, 1, nPos )
elseif ( nPos := rat( ":", cTmp ) ) != 0
ELSEIF ( nPos := rat( ":", cTmp ) ) != 0
cFilePath := substr( cTmp, 1, nPos )
else
ELSE
cFilePath := ""
endif
ENDIF
cTmp:=substr(cFile,Len(cFilePath)+1)
IF empty(cType)
cType:="text/html"
ENDIF
cData += cBound+cCrlf+'Content-Disposition: form-data; name="'+cName +'"; filename="'+cTmp+'"'+cCrlf+'Content-Type: '+cType+cCrLf+cCrLf
//hope this is not a big file....
nFile:=fopen(cFile)
nFile:=FOpen(cFile)
nbuf:=8192
nRead:=nBuf
//cBuf:=space(nBuf)
@@ -585,14 +585,14 @@ METHOD PostMultiPart( cPostData, cQuery ) CLASS tIPClientHTTP
cData+=cCrlf
NEXT
cData+=cBound+"--"+cCrlf
IF .not. HB_IsString( cQuery )
IF ! HB_IsString( cQuery )
cQuery := ::oUrl:BuildQuery()
ENDIF
::InetSendall( ::SocketCon, "POST " + cQuery + " HTTP/1.1" + ::cCRLF )
::StandardFields()
IF .not. "Content-Type" $ ::hFields
IF ! "Content-Type" $ ::hFields
::InetSendall( ::SocketCon, e"Content-Type: multipart/form-data; boundary="+::boundary(2)+::cCrlf )
ENDIF
@@ -612,22 +612,22 @@ RETURN .F.
METHOD WriteAll( cFile ) CLASS tIPClientHTTP
local nFile
local lSuccess
local nLen
local cStream
LOCAL nFile
LOCAL lSuccess
LOCAL nLen
LOCAL cStream
cStream := ::ReadAll()
nLen := len( cStream )
nFile := fcreate( cFile )
nFile := FCreate( cFile )
if nFile != 0
lSuccess := ( fwrite( nFile, cStream, nLen ) == nLen )
fclose( nFile )
lSuccess := ( FWrite( nFile, cStream, nLen ) == nLen )
FClose( nFile )
else
lSuccess := .f.
lSuccess := .F.
endif
RETURN lSuccess

58
harbour/contrib/hbtip/mail.prg
View File

@@ -63,10 +63,10 @@
#include "hbclass.ch"
#include "common.ch"
CLASS TipMail
DATA hHeaders
CREATE CLASS TipMail
VAR hHeaders
// received fields may be more than once.
DATA aReceived INIT {}
VAR aReceived INIT {}
METHOD New(cBody, oEncoder ) Constructor
METHOD SetBody( cBody )
@@ -107,11 +107,11 @@ CLASS TipMail
METHOD detachFile( cPath )
METHOD getFileName()
HIDDEN:
DATA cBody
Data lBodyEncoded init .f.
DATA oEncoder
DATA aAttachments
DATA nAttachPos INIT 1
VAR cBody
VAR lBodyEncoded init .F.
VAR oEncoder
VAR aAttachments
VAR nAttachPos INIT 1
ENDCLASS
@@ -152,7 +152,7 @@ RETURN .T.
METHOD SetBody( cBody ) CLASS TipMail
IF ::oEncoder != NIL
::cBody := ::oEncoder:Encode( cBody )
::lBodyEncoded:=.t. //GD needed to prevent an extra crlf from being appended
::lBodyEncoded:=.T. //GD needed to prevent an extra crlf from being appended
ELSE
::cBody := cBody
ENDIF
@@ -248,7 +248,7 @@ RETURN .T.
METHOD Attach( oSubPart ) CLASS TipMail
IF HB_IsObject( oSubPart ) .and. oSubPart:ClassName == "TIPMAIL"
IF HB_IsObject( oSubPart ) .AND. oSubPart:ClassName == "TIPMAIL"
// reset wrong content-type
IF At( "multipart/", Lower( ::GetFieldPart("Content-Type")) ) == 0
::hHeaders[ "Content-Type" ] := "multipart/mixed"
@@ -301,7 +301,7 @@ METHOD ToString() CLASS TipMail
cBoundary := ::GetFieldOption( "Content-Type", "Boundary" )
IF Empty( cBoundary )
cBoundary := ::MakeBoundary()
IF .not. ::SetFieldOption( "Content-Type", "Boundary", cBoundary )
IF ! ::SetFieldOption( "Content-Type", "Boundary", cBoundary )
::hHeaders[ "Content-Type" ] := ;
'multipart/mixed; boundary="' + cBoundary + '"'
ENDIF
@@ -337,12 +337,12 @@ METHOD ToString() CLASS TipMail
FOR i := 1 TO Len( ::hHeaders )
cElem := Lower(hb_HKeyAt( ::hHeaders, i ))
IF !( cElem == "return-path" ) .and.;
!( cElem == "delivered-to" ) .and.;
!( cElem == "date" ) .and.;
!( cElem == "from" ) .and.;
!( cElem == "to" ) .and.;
!( cElem == "subject" ) .and.;
IF !( cElem == "return-path" ) .AND.;
!( cElem == "delivered-to" ) .AND.;
!( cElem == "date" ) .AND.;
!( cElem == "from" ) .AND.;
!( cElem == "to" ) .AND.;
!( cElem == "subject" ) .AND.;
!( cElem == "mime-version" )
cRet += hb_HKeyAt( ::hHeaders, i ) + ": " +;
hb_HValueAt( ::hHeaders, i ) + e"\r\n"
@@ -353,7 +353,7 @@ METHOD ToString() CLASS TipMail
cRet += e"\r\n"
//Body
IF .not. Empty( ::cBody )
IF ! Empty( ::cBody )
IF empty(::aAttachments)
//cRet += ::cBody +iif(lAttachment,"", e"\r\n")
cRet += ::cBody + iif(::lBodyEncoded,"", e"\r\n")
@@ -368,7 +368,7 @@ METHOD ToString() CLASS TipMail
ENDIF
IF .not. Empty( ::aAttachments )
IF ! Empty( ::aAttachments )
//Eventually go with mime multipart
FOR i := 1 TO Len(::aAttachments )
cRet += "--" + cBoundary + e"\r\n"
@@ -405,8 +405,8 @@ METHOD FromString( cMail, cBoundary, nPos ) CLASS TipMail
nLinePos := hb_At( e"\r\n", cMail, nPos )
DO WHILE nLinePos > nPos
// going on with last field?
IF (SubStr( cMail, nPos, 1 ) == " " .or. SubStr( cMail, nPos, 1 ) == e"\t" );
.and. cLastField != NIL
IF (SubStr( cMail, nPos, 1 ) == " " .OR. SubStr( cMail, nPos, 1 ) == e"\t" );
.AND. cLastField != NIL
cValue := Ltrim(Substr( cMail, nPos, nLinePos - nPos ))
IF Lower(cLastField) == "received"
::aReceived[Len(::aReceived)] += " " + cValue
@@ -428,7 +428,7 @@ METHOD FromString( cMail, cBoundary, nPos ) CLASS TipMail
nPos := nLinePos + 2
nLinePos := hb_At( e"\r\n", cMail, nPos )
//Prevents malformed body to affect us
IF cBoundary != NIL .and. hb_At( "--"+cBoundary, cMail, nPos ) == 1
IF cBoundary != NIL .AND. hb_At( "--"+cBoundary, cMail, nPos ) == 1
RETURN 0
ENDIF
ENDDO
@@ -464,12 +464,12 @@ METHOD FromString( cMail, cBoundary, nPos ) CLASS TipMail
ENDIF
//have we met the boundary?
IF cBoundary != NIL .and. hb_At( "--"+cBoundary, cMail, nPos ) == nPos
IF cBoundary != NIL .AND. hb_At( "--"+cBoundary, cMail, nPos ) == nPos
EXIT
ENDIF
//Have we met a section?
IF cSubBoundary != NIL .and.;
IF cSubBoundary != NIL .AND.;
hb_At( "--" + cSubBoundary, cMail, nPos ) == nPos
//is it the last subsection?
@@ -565,11 +565,11 @@ METHOD setHeader( cSubject, cFrom, cTo, cCC, cBCC ) CLASS TipMail
RETURN .F.
ENDIF
IF .NOT. ::setFieldPart( "Subject", cSubject )
IF ! ::setFieldPart( "Subject", cSubject )
RETURN .F.
ENDIF
IF .NOT. ::setFieldPart( "From" , cFrom )
IF ! ::setFieldPart( "From" , cFrom )
RETURN .F.
ENDIF
@@ -579,7 +579,7 @@ METHOD setHeader( cSubject, cFrom, cTo, cCC, cBCC ) CLASS TipMail
cTo += "," + HB_InetCrlf() + Chr(9) + aTo[i]
NEXT
IF .NOT. ::setFieldPart( "To", cTo )
IF ! ::setFieldPart( "To", cTo )
RETURN .F.
ENDIF
@@ -590,7 +590,7 @@ METHOD setHeader( cSubject, cFrom, cTo, cCC, cBCC ) CLASS TipMail
cCC += "," + HB_InetCrlf() + Chr(9) + aCC[i]
NEXT
IF .NOT. ::setFieldPart( "Cc", cCC )
IF ! ::setFieldPart( "Cc", cCC )
RETURN .F.
ENDIF
ENDIF
@@ -602,7 +602,7 @@ METHOD setHeader( cSubject, cFrom, cTo, cCC, cBCC ) CLASS TipMail
cBCC += "," + HB_InetCrlf() + Chr(9) + aBCC[i]
NEXT
IF .NOT. ::setFieldPart( "Bcc", cBCC )
IF ! ::setFieldPart( "Bcc", cBCC )
RETURN .F.
ENDIF
ENDIF

34
harbour/contrib/hbtip/popcln.prg
View File

@@ -63,7 +63,7 @@
* Inet service manager: pop3
*/
CLASS tIPClientPOP FROM tIPClient
CREATE CLASS tIPClientPOP FROM tIPClient
METHOD New( oUrl, lTrace, oCredentials )
METHOD Open()
@@ -86,8 +86,8 @@ ENDCLASS
METHOD New( oUrl, lTrace, oCredentials ) CLASS tIPClientPOP
local cFile :="pop3"
local n := 0
LOCAL cFile :="pop3"
LOCAL n := 0
::super:New( oUrl, lTrace, oCredentials )
::nDefaultPort := 110
@@ -95,12 +95,12 @@ METHOD New( oUrl, lTrace, oCredentials ) CLASS tIPClientPOP
if ::ltrace
if !hb_FileExists("pop3.log")
::nHandle := fcreate("pop3.log")
::nHandle := FCreate("pop3.log")
else
while hb_FileExists(cFile+hb_NToS(n)+".log")
n++
enddo
::nHandle := fcreate(cFile+hb_NToS(n)+".log")
::nHandle := FCreate(cFile+hb_NToS(n)+".log")
endif
endif
@@ -108,11 +108,11 @@ RETURN Self
METHOD Open( cUrl ) CLASS tIPClientPOP
IF .not. ::super:Open( cUrl )
IF ! ::super:Open( cUrl )
RETURN .F.
ENDIF
IF Empty ( ::oUrl:cUserid ) .or. Empty ( ::oUrl:cPassword )
IF Empty ( ::oUrl:cUserid ) .OR. Empty ( ::oUrl:cPassword )
RETURN .F.
ENDIF
@@ -134,7 +134,7 @@ METHOD GetOk() CLASS tIPClientPOP
LOCAL nLen
::cReply := ::InetRecvLine( ::SocketCon, @nLen, 128 )
IF ::InetErrorCode( ::SocketCon ) != 0 .or. !( SubStr( ::cReply, 1, 1 ) == "+" )
IF ::InetErrorCode( ::SocketCon ) != 0 .OR. !( SubStr( ::cReply, 1, 1 ) == "+" )
RETURN .F.
ENDIF
RETURN .T.
@@ -189,12 +189,12 @@ METHOD Top( nMsgId ) CLASS tIPClientPOP
LOCAL cStr, cRet
::InetSendall( ::SocketCon, "TOP " + Str( nMsgId ) + " 0 " + ::cCRLF )
IF .not. ::GetOk()
IF ! ::GetOk()
RETURN NIL
ENDIF
cRet := ""
DO WHILE !( cStr == "." ) .and. ::InetErrorCode( ::SocketCon ) == 0
DO WHILE !( cStr == "." ) .AND. ::InetErrorCode( ::SocketCon ) == 0
cStr := ::InetRecvLine( ::SocketCon, @nPos, 256 )
IF !( cStr == "." )
cRet += cStr + ::cCRLF
@@ -217,12 +217,12 @@ METHOD List() CLASS tIPClientPOP
LOCAL cStr, cRet
::InetSendall( ::SocketCon, "LIST" + ::cCRLF )
IF .not. ::GetOk()
IF ! ::GetOk()
RETURN NIL
ENDIF
cRet := ""
DO WHILE !( cStr == "." ) .and. ::InetErrorCode( ::SocketCon ) == 0
DO WHILE !( cStr == "." ) .AND. ::InetErrorCode( ::SocketCon ) == 0
cStr := ::InetRecvLine( ::SocketCon, @nPos, 256 )
IF !( cStr == "." )
cRet += cStr + ::cCRLF
@@ -251,7 +251,7 @@ METHOD UIDL( nMsgId ) CLASS tIPClientPOP
::InetSendall( ::SocketCon, "UIDL" + ::cCRLF )
ENDIF
IF .not. ::GetOk()
IF ! ::GetOk()
RETURN NIL
ENDIF
@@ -263,7 +263,7 @@ METHOD UIDL( nMsgId ) CLASS tIPClientPOP
ELSE
cRet := ""
DO WHILE !( cStr == "." ) .and. ::InetErrorCode( ::SocketCon ) == 0
DO WHILE !( cStr == "." ) .AND. ::InetErrorCode( ::SocketCon ) == 0
cStr := ::InetRecvLine( ::SocketCon, @nPos, 256 )
IF !( cStr == "." )
cRet += cStr + ::cCRLF
@@ -289,9 +289,9 @@ METHOD Retrieve( nId, nLen ) CLASS tIPClientPOP
LOCAL cRet, nRetLen, cBuffer, nRead
LOCAL cEOM := ::cCRLF + "." + ::cCRLF // End Of Mail
IF .not. ::bInitialized
IF ! ::bInitialized
::InetSendall( ::SocketCon, "RETR "+ Str( nId ) + ::cCRLF )
IF .not. ::GetOk()
IF ! ::GetOk()
::bEof := .T.
RETURN NIL
ENDIF
@@ -364,7 +364,7 @@ METHOD retrieveAll( lDelete )
lDelete := .F.
ENDIF
IF .NOT. ::isOpen
IF ! ::isOpen
RETURN NIL
ENDIF

28
harbour/contrib/hbtip/sessid.prg
View File

@@ -70,12 +70,12 @@
FUNCTION TIP_GENERATESID( cCRCKey )
local cSID, nSIDCRC, cSIDCRC, n, cTemp
local nLenSID := SID_LENGTH
local cBaseKeys := BASE_KEY_STRING
local nLenKeys := Len( cBaseKeys )
local cRet
local nRand, nKey := 0
LOCAL cSID, nSIDCRC, cSIDCRC, n, cTemp
LOCAL nLenSID := SID_LENGTH
LOCAL cBaseKeys := BASE_KEY_STRING
LOCAL nLenKeys := Len( cBaseKeys )
LOCAL cRet
LOCAL nRand, nKey := 0
DEFAULT cCRCKey TO CRC_KEY_STRING
@@ -102,10 +102,10 @@ FUNCTION TIP_GENERATESID( cCRCKey )
FUNCTION TIP_CHECKSID( cSID, cCRCKey )
local nSIDCRC, cSIDCRC, n, cTemp
local nLenSID := SID_LENGTH
local cBaseKeys := BASE_KEY_STRING
local nRand, nKey := 0
LOCAL nSIDCRC, cSIDCRC, n, cTemp
LOCAL nLenSID := SID_LENGTH
LOCAL cBaseKeys := BASE_KEY_STRING
LOCAL nRand, nKey := 0
DEFAULT cCRCKey TO CRC_KEY_STRING
@@ -133,18 +133,18 @@ FUNCTION TIP_DATETOGMT( dDate, cTime )
LOCAL nDay, nMonth, nYear, nDoW
LOCAL aDays := { "Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday" }
LOCAL aMonths := { "Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" }
DEFAULT dDate TO DATE()
DEFAULT cTime TO TIME()
nDay := Day( dDate )
nMonth := Month( dDate )
nYear := Year( dDate)
nDoW := Dow( dDate )
cStr := aDays[ nDow ] + ", " + StrZero( nDay, 2 ) + "-" + aMonths[ nMonth ] + "-" + ;
Right( StrZero( nYear, 4 ), 2 ) + " " + cTime + " GMT"
Set( _SET_DATEFORMAT, cOldDateFormat )
RETURN cStr

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

@@ -223,7 +223,7 @@ METHOD Write( cData, nLen, bCommit ) CLASS tIPClientSMTP
LOCAL cRecpt
IF ! ::bInitialized
//IF Empty( ::oUrl:cUserid ) .or. Empty( ::oUrl:cFile )
//IF Empty( ::oUrl:cUserid ) .OR. Empty( ::oUrl:cFile )
IF Empty( ::oUrl:cFile ) // GD user id not needed if we did not auth
RETURN -1
ENDIF

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

@@ -107,16 +107,16 @@ STATIC slInit := .F. // initilization flag for HTML data
/*
* Class for handling an entire HTML document
*/
CLASS THtmlDocument MODULE FRIENDLY
CREATE CLASS THtmlDocument MODULE FRIENDLY
HIDDEN:
DATA oIterator
DATA nodes
VAR oIterator
VAR nodes
EXPORTED:
DATA root READONLY
DATA head READONLY
DATA body READONLY
DATA changed INIT .T.
VAR root READONLY
VAR head READONLY
VAR body READONLY
VAR changed INIT .T.
METHOD new( cHtmlString )
METHOD readFile( cFileName )
@@ -147,7 +147,7 @@ METHOD new( cHtmlString ) CLASS THtmlDocument
IF ! ISCHARACTER( cHtmlString )
::root := THtmlNode():new( cEmptyHtmlDoc )
ELSE
IF .NOT. "<html" $ Lower( Left( cHtmlString, 4096 ) )
IF ! "<html" $ Lower( Left( cHtmlString, 4096 ) )
::root := THtmlNode():new( cEmptyHtmlDoc )
nMode := 1
ELSE
@@ -316,7 +316,7 @@ RETURN ::oIterator:Find( cName, cAttrib, cValue, cData )
*
* (Adopted from TXMLIterator -> source\rtl\txml.prg)
*/
CLASS THtmlIterator MODULE FRIENDLY
CREATE CLASS THtmlIterator MODULE FRIENDLY
METHOD New( oNodeTop ) CONSTRUCTOR
METHOD Next()
METHOD Rewind()
@@ -327,15 +327,15 @@ CLASS THtmlIterator MODULE FRIENDLY
METHOD Clone()
HIDDEN:
DATA cName
DATA cAttribute
DATA cValue
DATA cData
DATA oNode
DATA oTop
DATA aNodes
DATA nCurrent
DATA nLast
VAR cName
VAR cAttribute
VAR cValue
VAR cData
VAR oNode
VAR oTop
VAR aNodes
VAR nCurrent
VAR nLast
METHOD MatchCriteria()
ENDCLASS
@@ -404,7 +404,7 @@ RETURN ::Next()
METHOD Next() CLASS THtmlIterator
LOCAL oFound, lExit := .F.
DO WHILE .NOT. lExit
DO WHILE ! lExit
BEGIN SEQUENCE WITH {|oErr| Break( oErr )}
oFound := ::aNodes[ ++::nCurrent ]
IF ::MatchCriteria( oFound )
@@ -441,11 +441,11 @@ RETURN Self
METHOD MatchCriteria( oFound ) CLASS THtmlIteratorScan
LOCAL xData
IF ::cName != NIL .and. !( Lower(::cName) == Lower(oFound:htmlTagName) )
IF ::cName != NIL .AND. !( Lower(::cName) == Lower(oFound:htmlTagName) )
RETURN .F.
ENDIF
IF ::cAttribute != NIL .and. .not. hb_HHasKey( oFound:getAttributes(), ::cAttribute )
IF ::cAttribute != NIL .AND. ! hb_HHasKey( oFound:getAttributes(), ::cAttribute )
RETURN .F.
ENDIF
@@ -485,23 +485,23 @@ RETURN Self
METHOD MatchCriteria( oFound ) CLASS THtmlIteratorRegex
LOCAL xData
IF ::cName != NIL .and. .not. hb_regexLike( Lower(oFound:htmlTagName), Lower(::cName) )
IF ::cName != NIL .AND. ! hb_regexLike( Lower(oFound:htmlTagName), Lower(::cName) )
RETURN .F.
ENDIF
IF ::cAttribute != NIL .and. ;
IF ::cAttribute != NIL .AND. ;
hb_hScan( oFound:getAttributes(), {|cKey| hb_regexLike( lower(::cAttribute), cKey ) } ) == 0
RETURN .F.
ENDIF
IF ::cValue != NIL .and.;
IF ::cValue != NIL .AND.;
hb_hScan( oFound:getAttributes(), {|xKey, cValue| HB_SYMBOL_UNUSED(xKey), hb_regexLike( ::cValue, cValue ) } ) == 0
RETURN .F.
ENDIF
IF ::cData != NIL
xData := oFound:getText(" ")
IF Empty(xData) .OR. .NOT. hb_regexHas( Alltrim(::cData), Alltrim(xData) )
IF Empty(xData) .OR. ! hb_regexHas( Alltrim(::cData), Alltrim(xData) )
RETURN .F.
ENDIF
ENDIF
@@ -511,12 +511,12 @@ RETURN .T.
* Class representing a HTML node tree.
* It parses a HTML formatted string
*/
CLASS THtmlNode MODULE FRIENDLY
CREATE CLASS THtmlNode MODULE FRIENDLY
HIDDEN:
DATA root
DATA _document
DATA parent
DATA htmlContent
VAR root
VAR _document
VAR parent
VAR htmlContent
METHOD parseHtml
METHOD parseHtmlFixed
@@ -528,10 +528,10 @@ CLASS THtmlNode MODULE FRIENDLY
EXPORTED:
DATA htmlTagName READONLY
DATA htmlEndTagName READONLY
DATA htmlTagType READONLY
DATA htmlAttributes READONLY
VAR htmlTagName READONLY
VAR htmlEndTagName READONLY
VAR htmlTagType READONLY
VAR htmlAttributes READONLY
METHOD new( oParent, cTagName, cAttrib, cContent )
@@ -597,7 +597,7 @@ ENDCLASS
METHOD new( oParent, cTagName, cAttrib, cContent ) CLASS THtmlNode
IF .NOT. slInit
IF ! slInit
THtmlInit(.T.)
ENDIF
@@ -685,7 +685,7 @@ METHOD parseHtml( parser ) CLASS THtmlNode
LOCAL oThisTag, oNextTag, oLastTag
LOCAL cTagName, cAttr, nStart, nEnd, nPos, cText
IF .NOT. "<" $ parser:p_Str
IF ! "<" $ parser:p_Str
// Plain text
::addNode( THtmlNode():new( self, "_text_", , parser:p_Str ) )
RETURN self
@@ -701,7 +701,7 @@ METHOD parseHtml( parser ) CLASS THtmlNode
cText := LTrim( SubStr( parser:p_str, nLastPos+1, nStart-nLastPos-1 ) )
cTagName := CutStr( " ", @cAttr )
IF .NOT. cText == ""
IF !( cText == "" )
IF Left( cText, 2 ) == "</"
// ending tag of previous node
cText := Lower( Alltrim( SubStr( CutStr( ">", @cText ), 3 ) ) )
@@ -774,7 +774,7 @@ METHOD parseHtml( parser ) CLASS THtmlNode
// the next tag is the same like this tag
// ( e.g. <p>|<tr>|<td>|<li>)
lRewind := .T.
CASE ( Lower( cTagName ) == Lower( oThisTag:parent:htmlTagName ) ) .AND. .NOT. oThisTag:isType( CM_LIST )
CASE ( Lower( cTagName ) == Lower( oThisTag:parent:htmlTagName ) ) .AND. ! oThisTag:isType( CM_LIST )
// the next tag is the same like the parent tag
// ( e.g. this is <td> and the next tag is <tr> )
lRewind := .T.
@@ -792,7 +792,7 @@ METHOD parseHtml( parser ) CLASS THtmlNode
ENDIF
ENDIF
IF .NOT. lRewind
IF ! lRewind
IF cAttr == ""
// tag has no attributes
oNextTag := THtmlNode():new( oThisTag, cTagName )
@@ -803,7 +803,7 @@ METHOD parseHtml( parser ) CLASS THtmlNode
oThisTag:addNode( oNextTag )
IF .NOT. oThisTag:isOptional() .AND. Lower( oThisTag:htmlTagName ) == Lower( ctagName )
IF ! oThisTag:isOptional() .AND. Lower( oThisTag:htmlTagName ) == Lower( ctagName )
oThisTag:htmlEndTagName := "/" + oThisTag:htmlTagName
ENDIF
@@ -811,7 +811,7 @@ METHOD parseHtml( parser ) CLASS THtmlNode
// do not spoil formatting of Html text
oNextTag:parseHtmlFixed( parser )
ELSEIF .NOT. oNextTag:isEmpty()
ELSEIF ! oNextTag:isEmpty()
// parse into node list of new tag
oThisTag := oNextTag
@@ -855,7 +855,7 @@ METHOD parseHtmlFixed( parser ) CLASS THtmlNode
P_SEEK( parser, "]]>" )
ENDIF
IF .NOT. P_PEEK( parser, "/" + ::htmlTagName )
IF ! P_PEEK( parser, "/" + ::htmlTagName )
// seek < /endtag>
P_SEEKI( parser, "/" + ::htmlTagName )
ENDIF
@@ -874,7 +874,7 @@ RETURN self
// adds a new CHILD node to the current one
METHOD addNode( oTHtmlNode ) CLASS THtmlNode
IF oTHtmlNode:parent != NIL .AND. .NOT. oTHtmlNode:parent == self
IF oTHtmlNode:parent != NIL .AND. ! oTHtmlNode:parent == self
oTHtmlNode:delete()
ENDIF
@@ -896,7 +896,7 @@ METHOD insertBefore( oTHtmlNode ) CLASS THtmlNode
RETURN ::error( "Cannot insert before root node", ::className(), ":insertBefore()", EG_ARG, HB_AParams() )
ENDIF
IF oTHtmlNode:parent != NIL .AND. .NOT. oTHtmlNode:parent == self
IF oTHtmlNode:parent != NIL .AND. ! oTHtmlNode:parent == self
oTHtmlNode:delete()
ENDIF
@@ -917,7 +917,7 @@ RETURN oTHtmlNode
METHOD insertAfter( oTHtmlNode ) CLASS THtmlNode
LOCAL nPos
IF oTHtmlNode:parent != NIL .AND. .NOT. oTHtmlNode:parent == self
IF oTHtmlNode:parent != NIL .AND. ! oTHtmlNode:parent == self
oTHtmlNode:delete()
ENDIF
@@ -997,7 +997,7 @@ METHOD nextNode() CLASS THtmlNode
ENDIF
/* NOTE: != changed to !( == ) */
IF !( ::htmlTagName == "_text_" ) .AND. .NOT. Empty( ::htmlContent )
IF !( ::htmlTagName == "_text_" ) .AND. ! Empty( ::htmlContent )
RETURN ::htmlContent[1]
ENDIF
@@ -1040,16 +1040,16 @@ METHOD toString( nIndent ) CLASS THtmlNode
cIndent := IIf( ::keepFormatting(), "", Space( Max(0,nIndent) ) )
IF .NOT. ::htmlTagName == "_root_"
IF ! ::htmlTagName == "_root_"
// all nodes but the root node have a HTML tag
IF .NOT. ::isInline() .OR. ::htmlTagName == "!--"
IF ! ::isInline() .OR. ::htmlTagName == "!--"
cHtml += cIndent
ELSEIF ::keepFormatting()
cHtml += Chr(13)+Chr(10)
ENDIF
cHtml += "<" + ::htmlTagName + ::attrToString()
IF .NOT. ::htmlEndTagName == "/"
IF ! ::htmlEndTagName == "/"
cHtml += ">"
ENDIF
ENDIF
@@ -1060,14 +1060,14 @@ METHOD toString( nIndent ) CLASS THtmlNode
imax := Len( ::htmlContent )
FOR i:=1 TO imax
oNode := ::htmlContent[i]
IF .NOT. oNode:isInline() .OR. oNode:htmlTagName == "!--"
IF ! oNode:isInline() .OR. oNode:htmlTagName == "!--"
cHtml += chr(13)+Chr(10)
ENDIF
cHtml += oNode:toString( nIndent+1 )
NEXT
#else
FOR EACH oNode IN ::htmlContent
IF .NOT. oNode:isInline() .OR. oNode:htmlTagName == "!--"
IF ! oNode:isInline() .OR. oNode:htmlTagName == "!--"
cHtml += chr(13)+Chr(10)
ENDIF
cHtml += oNode:toString( nIndent+1 )
@@ -1154,7 +1154,7 @@ STATIC FUNCTION __CollectTags( oTHtmlNode, stack, oEndNode )
LOCAL i, imax
S_PUSH( stack, oTHtmlNode )
IF oTHtmlNode:isNode() .AND. .NOT. oTHtmlNode == oEndNode
IF oTHtmlNode:isNode() .AND. ! oTHtmlNode == oEndNode
imax := Len( oTHtmlNode:htmlContent )
FOR i := 1 TO imax
__CollectTags( oTHtmlNode:htmlContent[i], stack, oEndNode )
@@ -1170,7 +1170,7 @@ STATIC FUNCTION __CollectTags( oTHtmlNode, stack, oEndNode )
LOCAL oSubNode
S_PUSH( stack, oTHtmlNode )
IF oTHtmlNode:isNode() .AND. .NOT. oTHtmlNode == oEndNode
IF oTHtmlNode:isNode() .AND. ! oTHtmlNode == oEndNode
FOR EACH oSubNode IN oTHtmlNode:htmlContent
__CollectTags( oSubNode, stack, oEndNode )
NEXT
@@ -1274,7 +1274,7 @@ STATIC FUNCTION __ParseAttr( parser )
hb_HSetCaseMatch( hHash, .F. )
DO WHILE .NOT. ( cChr := P_NEXT( parser ) ) == ""
DO WHILE ! ( cChr := P_NEXT( parser ) ) == ""
SWITCH cChr
CASE "="
@@ -1289,7 +1289,7 @@ STATIC FUNCTION __ParseAttr( parser )
CASE " "
IF nMode == 1
IF .NOT. aAttr[1] == ""
IF !( aAttr[1] == "" )
hHash[ aAttr[1] ] := aAttr[2]
aAttr[1] := ""
aAttr[2] := ""
@@ -1354,7 +1354,7 @@ STATIC FUNCTION __ParseAttr( parser )
ENDSWITCH
ENDDO
IF .NOT. aAttr[1] == ""
IF !( aAttr[1] == "" )
hHash[ aAttr[1] ] := aAttr[2]
ENDIF
@@ -1454,7 +1454,7 @@ METHOD noAttribute( cName, aValue ) CLASS THtmlNode
IF oNode == NIL
oNode := THtmlNode():new( self, cName )
IF .NOT. oNode:isOptional() .AND. .NOT. oNode:isEmpty()
IF ! oNode:isOptional() .AND. ! oNode:isEmpty()
oNode:htmlEndTagName := "/" + cName
ENDIF
::addNode( oNode )
@@ -1546,9 +1546,9 @@ METHOD pushNode( cTagName ) CLASS THtmlNode
RETURN ::error( "Cannot add HTML tag to: <" + ::htmlTagName + ">", ::className(), "+", EG_ARG, {cName} )
ENDIF
IF .NOT. hb_HHasKey( shTagTypes, cName )
IF ! hb_HHasKey( shTagTypes, cName )
IF Left( cName, 1 ) == "/" .AND. hb_HHasKey( shTagTypes, SubStr(cName,2) )
IF .NOT. Lower( SubStr(cName,2) ) == Lower( ::htmlTagName )
IF ! Lower( SubStr(cName,2) ) == Lower( ::htmlTagName )
RETURN ::error( "Not a valid closing HTML tag for: <" + ::htmlTagName + ">", ::className(), "-", EG_ARG, {cName} )
ENDIF
RETURN self:parent
@@ -1561,7 +1561,7 @@ METHOD pushNode( cTagName ) CLASS THtmlNode
ENDIF
oNode := THtmlNode():new( self, cName, cAttr )
IF .NOT. oNode:isOptional() .AND. .NOT. oNode:isEmpty()
IF ! oNode:isOptional() .AND. ! oNode:isEmpty()
oNode:htmlEndTagName := "/" + cName
ENDIF
::addNode( oNode )
@@ -1577,7 +1577,7 @@ METHOD popNode( cName ) CLASS THtmlNode
cName := SubStr( cName, 2 )
ENDIF
IF .NOT. Lower( cName ) == Lower( ::htmlTagName )
IF !( Lower( cName ) == Lower( ::htmlTagName ) )
RETURN ::error( "Invalid closing HTML tag for: <" + ::htmlTagName + ">", ::className(), "-", EG_ARG, {cName} )
ENDIF
RETURN self:parent
@@ -1599,12 +1599,12 @@ RETURN cLeftPart
FUNCTION THtmlInit( lInit )
IF ISLOGICAL( lInit ) .AND. .NOT. lInit
IF ISLOGICAL( lInit ) .AND. ! lInit
saHtmlAttr := NIL
shTagTypes := NIL
saHtmlAnsiEntities := NIL
RETURN .NOT. (slInit := .F. )
ELSEIF .NOT. slInit
RETURN ! ( slInit := .F. )
ELSEIF ! slInit
saHtmlAttr := Array( HTML_ATTR_COUNT )
_Init_Html_AnsiCharacterEntities()
_Init_Html_Attributes()
@@ -4373,7 +4373,7 @@ 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
DO WHILE ! ( (cChr := P_NEXT(parser)) $ "; " ) .AND. parser:p_pos != 0
ENDDO
SWITCH cChr

28
harbour/contrib/hbtip/url.prg
View File

@@ -64,16 +64,16 @@
* cFname cExt
*/
CLASS tURL
DATA cAddress
DATA cProto
DATA cServer
DATA cPath
DATA cQuery
DATA cFile
DATA nPort
DATA cUserid
DATA cPassword
CREATE CLASS tURL
VAR cAddress
VAR cProto
VAR cServer
VAR cPath
VAR cQuery
VAR cFile
VAR nPort
VAR cUserid
VAR cPassword
METHOD New( cUrl )
METHOD SetAddress( cUrl )
@@ -107,7 +107,7 @@ METHOD SetAddress( cUrl ) CLASS tURL
::cFile := ""
::nPort := -1
IF Empty( cUrl ) .or. Len( cUrl ) == 0
IF Empty( cUrl ) .OR. Len( cUrl ) == 0
RETURN .T.
ENDIF
@@ -149,7 +149,7 @@ METHOD BuildAddress() CLASS tURL
::cProto := Lower( ::cProto )
ENDIF
IF ! Empty( ::cProto ) .and. ! Empty( ::cServer )
IF ! Empty( ::cProto ) .AND. ! Empty( ::cServer )
cRet := ::cProto + "://"
ENDIF
@@ -168,7 +168,7 @@ METHOD BuildAddress() CLASS tURL
ENDIF
ENDIF
IF Len( ::cPath ) == 0 .or. !( Right( ::cPath, 1 ) == "/" )
IF Len( ::cPath ) == 0 .OR. !( Right( ::cPath, 1 ) == "/" )
::cPath += "/"
ENDIF
@@ -188,7 +188,7 @@ RETURN cRet
METHOD BuildQuery( ) CLASS tURL
LOCAL cLine
IF Len( ::cPath ) == 0 .or. !( Right( ::cPath, 1 ) == "/" )
IF Len( ::cPath ) == 0 .OR. !( Right( ::cPath, 1 ) == "/" )
::cPath += "/"
ENDIF