From 9ba5e3e9526876165aeca31f4c48663f5207c23e Mon Sep 17 00:00:00 2001 From: Viktor Szakats Date: Thu, 9 Jul 2009 13:03:59 +0000 Subject: [PATCH] 2009-07-09 14:58 UTC+0200 Viktor Szakats (harbour.01 syenar.hu) * include/hbextern.ch * source/rtl/Makefile + source/rtl/base64c.c + source/rtl/base64.prg + Added HB_BASE64ENCODE(), HB_BASE64DECODE() to core. They were copied from hbtip and hbvpdf and currently the decoder is .prg code while encoding is .c code. Latter has one TOFIX for an error situation. * contrib/hbtip/encurl.prg * contrib/hbtip/thtml.prg * contrib/hbtip/sessid.prg * contrib/hbtip/popcln.prg * contrib/hbtip/sendmail.prg * contrib/hbtip/tip.ch * contrib/hbtip/cgi.prg * contrib/hbtip/url.prg * contrib/hbtip/encqp.prg * contrib/hbtip/base64x.c * 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 + Added TOFIXes, QUESTIONs ! Fixed to use hb_MemoRead() instead of MemoRead() in one place. ! Fixed a wrong error checks after FCreate() calls. ! Fixed to use Len( hb_inetCRLF ) instead of hardwired length. ! Using hb_ntos() instead of Str() in POP3 commands. * Changed explicit values to manifest constants (F_ERROR) * Changed high ASCII chars in source to Chr() representation, now source can be edited with any editor. ! Added missing copyright header to tip.ch. Although this header seems to be unnecessary. ! TipMail:MakeBoundary() to not add any date punctuations in the ID. ! Fixed tIPClientFTP:fileSize() to not return permantent zero. % Heavier optimizations and cleanup in TIpClientSmtp(). % Optimizations. * Formatting. ; Please test. --- harbour/ChangeLog | 57 +- harbour/contrib/hbtip/base64x.c | 1 - harbour/contrib/hbtip/cgi.prg | 426 +-- harbour/contrib/hbtip/client.prg | 8 +- harbour/contrib/hbtip/credent.prg | 1 - harbour/contrib/hbtip/encb64.prg | 3 +- harbour/contrib/hbtip/encoder.prg | 26 +- harbour/contrib/hbtip/encqp.prg | 6 +- harbour/contrib/hbtip/encurl.prg | 10 +- harbour/contrib/hbtip/ftpcln.prg | 429 +-- harbour/contrib/hbtip/httpcln.prg | 523 ++- harbour/contrib/hbtip/mail.prg | 227 +- harbour/contrib/hbtip/popcln.prg | 123 +- harbour/contrib/hbtip/sendmail.prg | 458 ++- harbour/contrib/hbtip/sessid.prg | 3 +- harbour/contrib/hbtip/smtpcln.prg | 143 +- harbour/contrib/hbtip/thtml.prg | 5319 ++++++++++++++-------------- harbour/contrib/hbtip/tip.ch | 67 +- harbour/contrib/hbtip/url.prg | 114 +- harbour/include/hbextern.ch | 3 + harbour/source/rtl/Makefile | 2 + harbour/source/rtl/base64.prg | 119 + harbour/source/rtl/base64c.c | 100 + 23 files changed, 4137 insertions(+), 4031 deletions(-) create mode 100644 harbour/source/rtl/base64.prg create mode 100644 harbour/source/rtl/base64c.c diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 66d5486e63..a45e51ea97 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -17,6 +17,51 @@ past entries belonging to author(s): Viktor Szakats. */ +2009-07-09 14:58 UTC+0200 Viktor Szakats (harbour.01 syenar.hu) + * include/hbextern.ch + * source/rtl/Makefile + + source/rtl/base64c.c + + source/rtl/base64.prg + + Added HB_BASE64ENCODE(), HB_BASE64DECODE() to core. + They were copied from hbtip and hbvpdf and currently + the decoder is .prg code while encoding is .c code. + Latter has one TOFIX for an error situation. + + * contrib/hbtip/encurl.prg + * contrib/hbtip/thtml.prg + * contrib/hbtip/sessid.prg + * contrib/hbtip/popcln.prg + * contrib/hbtip/sendmail.prg + * contrib/hbtip/tip.ch + * contrib/hbtip/cgi.prg + * contrib/hbtip/url.prg + * contrib/hbtip/encqp.prg + * contrib/hbtip/base64x.c + * 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 + + Added TOFIXes, QUESTIONs + ! Fixed to use hb_MemoRead() instead of MemoRead() in one place. + ! Fixed a wrong error checks after FCreate() calls. + ! Fixed to use Len( hb_inetCRLF ) instead of hardwired length. + ! Using hb_ntos() instead of Str() in POP3 commands. + * Changed explicit values to manifest constants (F_ERROR) + * Changed high ASCII chars in source to Chr() representation, + now source can be edited with any editor. + ! Added missing copyright header to tip.ch. Although this header + seems to be unnecessary. + ! TipMail:MakeBoundary() to not add any date punctuations in the ID. + ! Fixed tIPClientFTP:fileSize() to not return permantent zero. + % Heavier optimizations and cleanup in TIpClientSmtp(). + % Optimizations. + * Formatting. + ; Please test. + 2009-07-09 14:40 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) * harbour/include/hbexpra.c % reduce macro expressions used in POP operation. @@ -50,7 +95,7 @@ * harbour/contrib/hbxbp/xbpstatic.prg + Implemented :type == XBPSTATIC_TYPE_BITMAP. - + * harbour/contrib/hbxbp/xbpwindow.prg + Implemented :setFont( oXbpFont ). ! Enhanced "Attribute" factor of :compoundName to accept bold and italic together. @@ -62,7 +107,7 @@ 2. Click on toolbar icon. 3. Adjust and select a font. 4. See the result in MLE text editor. - + + Demonstrated XbpBitmap() functionality as in Xbase++, code shows up with both compilers. 2009-07-08 16:50 UTC-0800 Pritpal Bedi (pritpal@vouchcac.com) @@ -118,17 +163,17 @@ ! Updated for exact constructor parameters. If the constructor accepts parameters with identical .prg supplied values, a new parameter is inserted as a first argument and then resolved in .cpp. - + oBrush := QBrush():new( "QPixmap" , pQPixmap ) oBrush := QBrush():new( "QImage" , pQImage ) oBrush := QBrush():new( "QGradient", pQGradient ) - + Note that constructor fetches only one argument, a pointer to relevant - object, which at prg to cpp level can never be differed so this + object, which at prg to cpp level can never be differed so this mechanism was necessary. The first parameter will be matched exact and hence it is case sensitive. If this parameter is of the same type object is being created then it call will only supply pointer: - + oBrush := QBrush():new( pQBrush_other ) 2009-07-08 22:47 UTC+0200 Viktor Szakats (harbour.01 syenar.hu) diff --git a/harbour/contrib/hbtip/base64x.c b/harbour/contrib/hbtip/base64x.c index c1e6fa8e22..82cbd051e0 100644 --- a/harbour/contrib/hbtip/base64x.c +++ b/harbour/contrib/hbtip/base64x.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 diff --git a/harbour/contrib/hbtip/cgi.prg b/harbour/contrib/hbtip/cgi.prg index a812433a92..570bb80a39 100644 --- a/harbour/contrib/hbtip/cgi.prg +++ b/harbour/contrib/hbtip/cgi.prg @@ -12,7 +12,6 @@ * TIP Class oriented Internet protocol library * * Copyright 2003 Giancarlo Niccolai - * * www - http://www.harbour-project.org * * CGI Session Manager Class @@ -62,30 +61,32 @@ */ #include "hbclass.ch" -#include "tip.ch" + #include "common.ch" #include "fileio.ch" +#include "tip.ch" + #define CGI_IN 0 #define CGI_OUT 1 -#define _CRLF chr(13)+chr(10) +#define _CRLF Chr( 13 ) + Chr( 10 ) #define _BR "
" -CLASS TIpCgi +CREATE CLASS TIpCgi - DATA HTTP_RAW_POST_DATA + VAR HTTP_RAW_POST_DATA - DATA cCgiHeader - DATA cHtmlPage - DATA hGets INIT {=>} - DATA hPosts INIT {=>} - DATA hCookies INIT {=>} - DATA hSession INIT {=>} - DATA bSavedErrHandler - DATA cSessionSavePath - DATA cSID - DATA cDumpSavePath - DATA lDumpHtml INIT FALSE + VAR cCgiHeader + VAR cHtmlPage + VAR hGets INIT { => } + VAR hPosts INIT { => } + VAR hCookies INIT { => } + VAR hSession INIT { => } + VAR bSavedErrHandler + VAR cSessionSavePath + VAR cSID + VAR cDumpSavePath + VAR lDumpHtml INIT .F. METHOD New() METHOD Header( hOptions ) @@ -124,64 +125,64 @@ METHOD New() CLASS TIpCgi ::cCgiHeader := "" ::cHtmlPage := "" - lPost := ( "POST" $ Upper( getenv( "REQUEST_METHOD" ) ) ) - if lPost - nLen := val( getenv( "CONTENT_LENGTH" ) ) - cTemp := space( nLen ) - if ( ( nRead := FRead( CGI_IN, @cTemp, nLen, 0 ) ) != nLen ) - ::ErrHandler( "post error read " + str( nRead ) + " instead of " + str( nLen ) ) - else + lPost := ( "POST" $ Upper( GetEnv( "REQUEST_METHOD" ) ) ) + IF lPost + nLen := Val( GetEnv( "CONTENT_LENGTH" ) ) + cTemp := Space( 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 - aTemp := HB_ATOKENS( cTemp, "&" ) + aTemp := hb_ATokens( cTemp, "&" ) nLen := Len( aTemp ) - if nLen > 0 - for nCount := 1 TO nLen - aVar := HB_ATOKENS( aTemp[ nCount ], "=" ) - if Len( aVar ) == 2 - ::hPosts[ alltrim( TipEncoderUrl_Decode( aVar[ 1 ] ) ) ] := TipEncoderUrl_Decode( aVar[ 2 ] ) - endif - next - endif - endif - else - cTemp := getenv( "QUERY_STRING" ) - if !empty( cTemp ) - aTemp := HB_ATOKENS( cTemp, "&" ) + IF nLen > 0 + FOR nCount := 1 TO nLen + aVar := hb_ATokens( aTemp[ nCount ], "=" ) + IF Len( aVar ) == 2 + ::hPosts[ AllTrim( TipEncoderUrl_Decode( aVar[ 1 ] ) ) ] := TipEncoderUrl_Decode( aVar[ 2 ] ) + ENDIF + NEXT + ENDIF + ENDIF + ELSE + cTemp := GetEnv( "QUERY_STRING" ) + IF ! Empty( cTemp ) + aTemp := hb_ATokens( cTemp, "&" ) nLen := Len( aTemp ) - if nLen > 0 - for nCount := 1 TO nLen - aVar := HB_ATOKENS( aTemp[ nCount ], "=" ) - if Len( aVar ) == 2 - ::hGets[ alltrim( TipEncoderUrl_Decode( aVar[ 1 ] ) ) ] := TipEncoderUrl_Decode( aVar[ 2 ] ) - endif - next - endif - endif - endif + IF nLen > 0 + FOR nCount := 1 TO nLen + aVar := hb_ATokens( aTemp[ nCount ], "=" ) + IF Len( aVar ) == 2 + ::hGets[ AllTrim( TipEncoderUrl_Decode( aVar[ 1 ] ) ) ] := TipEncoderUrl_Decode( aVar[ 2 ] ) + ENDIF + NEXT + ENDIF + ENDIF + ENDIF - cTemp := getenv( "HTTP_COOKIE" ) - if !empty( cTemp ) - aTemp := HB_ATOKENS( cTemp, ";" ) + cTemp := GetEnv( "HTTP_COOKIE" ) + IF ! Empty( cTemp ) + aTemp := hb_ATokens( cTemp, ";" ) nLen := Len( aTemp ) - if nLen > 0 - for nCount := 1 TO nLen - aVar := HB_ATOKENS( aTemp[ nCount ], "=" ) - if Len( aVar ) == 2 - ::hCookies[ alltrim( TipEncoderUrl_Decode( aVar[ 1 ] ) ) ] := TipEncoderUrl_Decode( aVar[ 2 ] ) - endif - next - endif - endif + IF nLen > 0 + FOR nCount := 1 TO nLen + aVar := hb_ATokens( aTemp[ nCount ], "=" ) + IF Len( aVar ) == 2 + ::hCookies[ AllTrim( TipEncoderUrl_Decode( aVar[ 1 ] ) ) ] := TipEncoderUrl_Decode( aVar[ 2 ] ) + ENDIF + NEXT + ENDIF + ENDIF RETURN Self METHOD Header( cValue ) CLASS TIpCgi - if empty( cValue ) + IF Empty( cValue ) ::cCgiHeader += "Content-Type: text/html" + _CRLF - else + ELSE ::cCgiHeader += cValue + _CRLF - endif + ENDIF RETURN Self @@ -210,45 +211,45 @@ METHOD Flush() CLASS TIpCgi LOCAL cSID := ::cSID LOCAL cSession - hb_hEval( ::hCookies, { |k,v| ::cCgiHeader += "Set-Cookie: " + k + "=" + v + ";" + _CRLF } ) + hb_HEval( ::hCookies, { | k, v | ::cCgiHeader += "Set-Cookie: " + k + "=" + v + ";" + _CRLF } ) cStream := ::cCgiHeader + _CRLF + ::cHtmlPage + _CRLF - nLen := len( cStream ) + nLen := Len( cStream ) lRet := ( Fwrite( CGI_OUT, cStream, nLen ) == nLen ) - if ::lDumpHtml - if empty( ::cDumpSavePath ) + IF ::lDumpHtml + IF Empty( ::cDumpSavePath ) + /* TOFIX: *nix specific default. [vszakats] */ ::cDumpSavePath := "/tmp/" - endif - if ( nH := FCreate( ::cDumpSavePath + "dump.html", FC_NORMAL ) ) != -1 - Fwrite( nH, ::cHtmlPage, len( ::cHtmlPage ) ) - endif + ENDIF + IF ( nH := FCreate( ::cDumpSavePath + "dump.html", FC_NORMAL ) ) != F_ERROR + FWrite( nH, ::cHtmlPage ) + ENDIF FClose( nH ) - endif + ENDIF ::cCgiHeader := "" ::cHtmlPage := "" - if !empty( cSID ) + IF ! Empty( cSID ) - cFile := ::cSessionSavePath + "SESSIONID_" + cSID + cFile := ::cSessionSavePath + "SESSIONID_" + cSID - cSession := ::SessionEncode() + cSession := ::SessionEncode() - nFileSize := len( cSession ) + nFileSize := Len( cSession ) - if ( nH := FCreate( cFile, FC_NORMAL ) ) != -1 - if ( FWrite( nH, @cSession, nFileSize ) ) != nFileSize - ::Print( "ERROR: On writing session file : " + cFile + ", File error : " + hb_cStr( FError() ) ) - endif - FClose( nH ) - else - ::Print( "ERROR: On writing session file : " + cFile + ", File error : " + hb_cStr( FError() ) ) - endif - - endif + IF ( nH := FCreate( cFile, FC_NORMAL ) ) != F_ERROR + IF ( FWrite( nH, @cSession, nFileSize ) ) != nFileSize + ::Print( "ERROR: On writing session file : " + cFile + ", File error : " + hb_cStr( FError() ) ) + ENDIF + FClose( nH ) + ELSE + ::Print( "ERROR: On writing session file : " + cFile + ", File error : " + hb_cStr( FError() ) ) + ENDIF + ENDIF RETURN lRet @@ -258,28 +259,28 @@ METHOD DestroySession( cID ) CLASS TIpCgi LOCAL cSID := ::cSID LOCAL lRet - if !empty( cID ) + IF ! Empty( cID ) cSID := cID - endif + ENDIF - if !empty( cSID ) + IF ! Empty( cSID ) - ::hSession := {=>} + ::hSession := { => } cFile := ::cSessionSavePath + "SESSIONID_" + cSID - if !( lRet := ( FErase( cFile ) == 0 ) ) + IF !( lRet := ( FErase( cFile ) == 0 ) ) ::Print( "ERROR: On deleting session file : " + cFile + ", File error : " + hb_cStr( FError() ) ) - else - ::hCookies[ "SESSIONID" ] := cSID + "; expires= " + TIP_DateToGMT( DATE() - 1 ) - ::CreateSID() - cSID := ::cSID - ::hCookies[ "SESSIONID" ] := cSID - endif + ELSE + ::hCookies[ "SESSIONID" ] := cSID + "; expires= " + TIP_DateToGMT( Date() - 1 ) + ::CreateSID() + cSID := ::cSID + ::hCookies[ "SESSIONID" ] := cSID + ENDIF - endif + ENDIF -RETURN lRet + RETURN lRet METHOD ErrHandler( xError ) CLASS TIpCgi @@ -287,22 +288,22 @@ METHOD ErrHandler( xError ) CLASS TIpCgi ::Print( '' ) - ::Print( '' ) + ::Print( '' ) - if ISOBJECT( xError ) + IF ISOBJECT( xError ) ::Print( '' ) ::Print( '' ) - ::Print( '' ) + ::Print( '' ) ::Print( '' ) ELSEIF ISCHARACTER( xError ) ::Print( '' ) - endif + ENDIF - for nCalls := 2 to 6 - if !empty( procname( nCalls ) ) - ::Print( '' ) - endif - next + FOR nCalls := 2 to 6 + IF ! Empty( procname( nCalls ) ) + ::Print( '' ) + ENDIF + NEXT ::Print( '
SCRIPT NAME:' + getenv( 'SCRIPT_NAME' ) + '
SCRIPT NAME:' + GetEnv( "SCRIPT_NAME" ) + '
CRITICAL ERROR:' + xError:Description + '
OPERATION:' + xError:Operation + '
OS ERROR:' + alltrim( str( xError:OsCode ) ) + ' IN ' + xError:SubSystem + '/' + alltrim( str( xError:SubCode ) ) + '
OS ERROR:' + hb_ntos( xError:OsCode ) + ' IN ' + xError:SubSystem + '/' + hb_ntos( xError:SubCode ) + '
FILENAME:' + right( xError:FileName, 40 ) + '
ERROR MESSAGE:' + xError + '
PROC/LINE:' + procname( nCalls ) + "/" + alltrim( str( procline( nCalls ) ) ) + '
PROC/LINE:' + ProcName( nCalls ) + "/" + hb_ntos( ProcLine( nCalls ) ) + '
' ) @@ -367,16 +368,16 @@ METHOD SaveHtmlPage( cFile ) CLASS TIpCgi cStream := ::cHtmlPage + _CRLF - nLen := len( cStream ) + nLen := Len( cStream ) nFile := FCreate( cFile ) - if nFile != 0 + IF nFile != F_ERROR lSuccess := ( FWrite( nFile, cStream, nLen ) == nLen ) FClose( nFile ) - else + ELSE lSuccess := .F. - endif + ENDIF RETURN lSuccess @@ -387,50 +388,51 @@ METHOD StartSession( cSID ) CLASS TIpCgi LOCAL nFileSize LOCAL cBuffer - if empty( cSID ) + IF Empty( cSID ) - if ( nH := hb_HPos( ::hGets, "SESSIONID" ) ) != 0 + IF ( nH := hb_HPos( ::hGets, "SESSIONID" ) ) != 0 cSID := hb_HValueAt( ::hGets, nH ) ELSEIF ( nH := hb_HPos( ::hPosts, "SESSIONID" ) ) != 0 cSID := hb_HValueAt( ::hPosts, nH ) ELSEIF ( nH := hb_HPos( ::hCookies, "SESSIONID" ) ) != 0 cSID := hb_HValueAt( ::hCookies, nH ) - endif + ENDIF - endif + ENDIF - if empty( ::cSessionSavePath ) + IF Empty( ::cSessionSavePath ) + /* TOFIX: *nix specific default. [vszakats] */ ::cSessionSavePath := "/tmp/" - endif + ENDIF - if !empty( cSID ) + IF ! Empty( cSID ) ::cSID := cSID cFile := ::cSessionSavePath + "SESSIONID_" + cSID - if hb_FileExists( cFile ) - if ( nH := FOpen( cFile, FO_READ ) ) != -1 + IF hb_FileExists( cFile ) + IF ( nH := FOpen( cFile, FO_READ ) ) != F_ERROR nFileSize := FSeek( nH, 0, FS_END ) FSeek( nH, 0, FS_SET ) cBuffer := Space( nFileSize ) - if ( FRead( nH, @cBuffer, nFileSize ) ) != nFileSize + IF ( FRead( nH, @cBuffer, nFileSize ) ) != nFileSize ::ErrHandler( "ERROR: On reading session file : " + cFile + ", File error : " + hb_cStr( FError() ) ) - else + ELSE ::SessionDecode( cBuffer ) - endif + ENDIF FClose( nH ) - endif - else + ENDIF + ELSE ::ErrHandler( "ERROR: On opening session file : " + cFile + ", file not exist." ) - endif + ENDIF - else + ELSE ::CreateSID() ::hSession := {=>} - endif + ENDIF ::hCookies[ "SESSIONID" ] := ::cSID @@ -438,13 +440,13 @@ METHOD StartSession( cSID ) CLASS TIpCgi METHOD SessionEncode() CLASS TIpCgi - RETURN HB_Serialize( ::hSession ) + RETURN hb_Serialize( ::hSession ) METHOD SessionDecode( cData ) CLASS TIpCgi - ::hSession := HB_Deserialize( cData ) + ::hSession := hb_Deserialize( cData ) - RETURN Valtype( ::hSession ) == "H" + RETURN hb_isHash( ::hSession ) STATIC FUNCTION HtmlTag( xVal, cKey, cDefault ) @@ -452,20 +454,20 @@ STATIC FUNCTION HtmlTag( xVal, cKey, cDefault ) DEFAULT cDefault TO "" - if !empty( xVal ) .AND. !empty( cKey ) - if hb_hHasKey( xVal, cKey ) - cVal := hb_hGet( xVal, cKey ) - hb_hDel( xVal, cKey ) - endif - endif + IF ! Empty( xVal ) .AND. ! Empty( cKey ) + IF hb_HHasKey( xVal, cKey ) + cVal := hb_HGet( xVal, cKey ) + hb_HDel( xVal, cKey ) + ENDIF + ENDIF - if cVal == "" + IF cVal == "" cVal := cDefault - endif + ENDIF - if !( cVal == "" ) + IF !( cVal == "" ) cVal := "<" + cKey + ">" + cVal + "" - endif + ENDIF RETURN cVal @@ -475,7 +477,7 @@ STATIC FUNCTION HtmlAllTag( hTags, cSep ) DEFAULT cSep TO " " - hb_hEval( hTags, { |k| cVal += HtmlTag( hTags, k ) + cSep } ) + hb_HEval( hTags, { |k| cVal += HtmlTag( hTags, k ) + cSep } ) RETURN cVal @@ -483,23 +485,23 @@ STATIC FUNCTION HtmlOption( xVal, cKey, cPre, cPost, lScan ) LOCAL cVal := "" - if !empty( xVal ) - if empty( cKey ) + IF ! Empty( xVal ) + IF Empty( cKey ) cVal := xVal - ELSEIF hb_hHasKey( xVal, cKey ) - cVal := hb_hGet( xVal, cKey ) - if empty( lScan ) - hb_hDel( xVal, cKey ) - endif + 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 + ENDIF + IF cPost != NIL cVal := cVal + cPost - endif - endif - endif + ENDIF + ENDIF + ENDIF RETURN cVal @@ -507,11 +509,11 @@ STATIC FUNCTION HtmlAllOption( hOptions, cSep ) LOCAL cVal := "" - DEFAULT cSep TO " " + IF ! Empty( hOptions ) + DEFAULT cSep TO " " - if !empty( hOptions ) - hb_hEval( hOptions, { |k| cVal += HtmlOption( hOptions, k,,, .T. ) + cSep } ) - endif + hb_HEval( hOptions, { |k| cVal += HtmlOption( hOptions, k,,, .T. ) + cSep } ) + ENDIF RETURN cVal @@ -521,16 +523,16 @@ STATIC FUNCTION HtmlValue( xVal, cKey, cDefault ) DEFAULT cDefault TO "" - if !empty( xVal ) .AND. !empty( cKey ) - if hb_hHasKey( xVal, cKey ) - cVal := hb_hGet( xVal, cKey ) - hb_hDel( xVal, cKey ) - endif - endif + IF ! Empty( xVal ) .AND. ! Empty( cKey ) + IF hb_HHasKey( xVal, cKey ) + cVal := hb_HGet( xVal, cKey ) + hb_HDel( xVal, cKey ) + ENDIF + ENDIF - if cVal == "" + IF cVal == "" cVal := cDefault - endif + ENDIF RETURN cVal @@ -538,11 +540,11 @@ STATIC FUNCTION HtmlAllValue( hValues, cSep ) LOCAL cVal := "" - DEFAULT cSep TO " " + IF ! Empty( hValues ) + DEFAULT cSep TO " " - if !empty( hValues ) - hb_hEval( hValues, { |k| cVal += HtmlValue( hValues, k ) + cSep } ) - endif + hb_HEval( hValues, { |k| cVal += HtmlValue( hValues, k ) + cSep } ) + ENDIF RETURN cVal @@ -554,36 +556,36 @@ STATIC FUNCTION HtmlScript( xVal, cKey ) DEFAULT cKey TO "script" - if !empty( xVal ) - if ( nPos := hb_HPos( xVal, cKey ) ) != 0 + IF ! Empty( xVal ) + IF ( nPos := hb_HPos( xVal, cKey ) ) != 0 cVal := hb_HValueAt( xVal, nPos ) - if valtype( cVal ) == "H" - if ( nPos := hb_HPos( cVal, "src" ) ) != 0 + IF hb_isHash( cVal ) + IF ( nPos := hb_HPos( cVal, "src" ) ) != 0 cVal := hb_HValueAt( cVal, nPos ) - if ISCHARACTER( cVal ) + IF ISCHARACTER( cVal ) cVal := { cVal } - endif - if ISARRAY( cVal ) + ENDIF + IF ISARRAY( cVal ) cTmp := "" - ascan( cVal, { |cFile| cTmp += '' + _CRLF - endif - endif - endif - hb_hDel( xVal, cKey ) - endif - endif + ENDIF + ENDIF + ENDIF + hb_HDel( xVal, cKey ) + ENDIF + ENDIF RETURN cVal @@ -595,35 +597,35 @@ STATIC FUNCTION HtmlStyle( xVal, cKey ) DEFAULT cKey TO "style" - if !empty( xVal ) - if ( nPos := hb_HPos( xVal, cKey ) ) != 0 + IF ! Empty( xVal ) + IF ( nPos := hb_HPos( xVal, cKey ) ) != 0 cVal := hb_HValueAt( xVal, nPos ) - if valtype( cVal ) == "H" - if ( nPos := hb_HPos( cVal, "src" ) ) != 0 + IF hb_isHash( cVal ) + IF ( nPos := hb_HPos( cVal, "src" ) ) != 0 cVal := hb_HValueAt( cVal, nPos ) - if ISCHARACTER( cVal ) + IF ISCHARACTER( cVal ) cVal := { cVal } - endif - if ISARRAY( cVal ) + ENDIF + IF ISARRAY( cVal ) cTmp := "" - ascan( cVal, { |cFile| cTmp += '' + _CRLF } ) + AScan( cVal, { | cFile | cTmp += '' + _CRLF } ) cVal := cTmp - endif - endif - if ( nPos := hb_HPos( cVal, "var" ) ) != 0 + ENDIF + ENDIF + IF ( nPos := hb_HPos( cVal, "var" ) ) != 0 cVal := hb_HValueAt( cVal, nPos ) - if ISCHARACTER( cVal ) + IF ISCHARACTER( cVal ) cVal := { cVal } - endif - if ISARRAY( cVal ) + ENDIF + IF ISARRAY( cVal ) cTmp := "" ascan( cVal, { |cVar| cTmp += cVar } ) cVal := '' + _CRLF - endif - endif - endif - hb_hDel( xVal, cKey ) - endif - endif + ENDIF + ENDIF + ENDIF + hb_HDel( xVal, cKey ) + ENDIF + ENDIF RETURN cVal diff --git a/harbour/contrib/hbtip/client.prg b/harbour/contrib/hbtip/client.prg index e7f1166899..12bd750452 100644 --- a/harbour/contrib/hbtip/client.prg +++ b/harbour/contrib/hbtip/client.prg @@ -378,7 +378,7 @@ METHOD ReadToFile( cFile, nMode, nSize ) CLASS tIPClient nSent := 0 IF !Empty( ::exGauge ) - HB_ExecFromArray( ::exGauge, { nSent, nSize, Self } ) + hb_ExecFromArray( ::exGauge, { nSent, nSize, Self } ) ENDIF ::nRead := 0 @@ -407,7 +407,7 @@ METHOD ReadToFile( cFile, nMode, nSize ) CLASS tIPClient nSent += Len( cData ) IF ! Empty( ::exGauge ) - HB_ExecFromArray( ::exGauge, { nSent, nSize, Self } ) + hb_ExecFromArray( ::exGauge, { nSent, nSize, Self } ) ENDIF ENDDO @@ -441,7 +441,7 @@ METHOD WriteFromFile( cFile ) CLASS tIPClient // allow initialization of the gauge nSent := 0 IF ! Empty( ::exGauge ) - HB_ExecFromArray( ::exGauge, { nSent, nSize, Self } ) + hb_ExecFromArray( ::exGauge, { nSent, nSize, Self } ) ENDIF ::nStatus := 1 @@ -454,7 +454,7 @@ METHOD WriteFromFile( cFile ) CLASS tIPClient ENDIF nSent += nLen IF ! Empty( ::exGauge ) - HB_ExecFromArray( ::exGauge, {nSent, nSize, Self} ) + hb_ExecFromArray( ::exGauge, {nSent, nSize, Self} ) ENDIF nLen := FRead( nFin, @cData, nBufSize ) ENDDO diff --git a/harbour/contrib/hbtip/credent.prg b/harbour/contrib/hbtip/credent.prg index 18c728e050..516d269dfb 100644 --- a/harbour/contrib/hbtip/credent.prg +++ b/harbour/contrib/hbtip/credent.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 diff --git a/harbour/contrib/hbtip/encb64.prg b/harbour/contrib/hbtip/encb64.prg index e56c23a5f8..98b1fbf0ac 100644 --- a/harbour/contrib/hbtip/encb64.prg +++ b/harbour/contrib/hbtip/encb64.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 @@ -67,4 +66,4 @@ ENDCLASS METHOD New() CLASS TIPEncoderBase64 ::cName := "Base64" ::bHttpExcept := .F. -RETURN Self + RETURN Self diff --git a/harbour/contrib/hbtip/encoder.prg b/harbour/contrib/hbtip/encoder.prg index ccf16a235e..88a4e9735e 100644 --- a/harbour/contrib/hbtip/encoder.prg +++ b/harbour/contrib/hbtip/encoder.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,10 +61,11 @@ #include "hbclass.ch" -#include "fileio.ch" -#include "tip.ch" -#include "common.ch" +#include "common.ch" +#include "fileio.ch" + +#include "tip.ch" FUNCTION TIp_GetEncoder( cModel ) LOCAL oEncoder @@ -95,9 +95,7 @@ FUNCTION TIp_GetEncoder( cModel ) ENDCASE -RETURN oEncoder - - + RETURN oEncoder CREATE CLASS TIPEncoder VAR cName @@ -107,17 +105,15 @@ CREATE CLASS TIPEncoder METHOD Decode( cData ) ENDCLASS - -METHOD New( cModel ) class TIPEncoder +METHOD New( cModel ) CLASS TIPEncoder IF ! ISCHARACTER( cModel ) cModel := "as-is" ENDIF ::cName := cModel -RETURN self + RETURN Self +METHOD Encode( cData ) CLASS TIPEncoder + RETURN cData -METHOD Encode( cData ) class TIPEncoder -RETURN cData - -METHOD Decode( cData ) class TIPEncoder -RETURN cData +METHOD Decode( cData ) CLASS TIPEncoder + RETURN cData diff --git a/harbour/contrib/hbtip/encqp.prg b/harbour/contrib/hbtip/encqp.prg index 97aeb9cf4c..538341cd16 100644 --- a/harbour/contrib/hbtip/encqp.prg +++ b/harbour/contrib/hbtip/encqp.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 @@ -53,13 +52,12 @@ #include "hbclass.ch" - CREATE CLASS TIPEncoderQP FROM TIPEncoder - METHOD New() CONSTRUCTOR + METHOD New() CONSTRUCTOR METHOD Encode( cData ) METHOD Decode( cData ) ENDCLASS METHOD New() CLASS TIPEncoderQP ::cName := "Quoted-Printable" -RETURN Self + RETURN Self diff --git a/harbour/contrib/hbtip/encurl.prg b/harbour/contrib/hbtip/encurl.prg index 4a372f39df..74c3013dff 100644 --- a/harbour/contrib/hbtip/encurl.prg +++ b/harbour/contrib/hbtip/encurl.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 @@ -53,13 +52,12 @@ #include "hbclass.ch" - CREATE CLASS TIPEncoderUrl FROM TIPEncoder - METHOD New() CONSTRUCTOR - METHOD Encode() - METHOD Decode() + METHOD New() CONSTRUCTOR + METHOD Encode( cData ) + METHOD Decode( cData ) ENDCLASS METHOD New() CLASS TIPEncoderURL ::cName := "urlencoded" -RETURN Self + RETURN Self diff --git a/harbour/contrib/hbtip/ftpcln.prg b/harbour/contrib/hbtip/ftpcln.prg index 93ffba0b97..d96a5d6b1e 100644 --- a/harbour/contrib/hbtip/ftpcln.prg +++ b/harbour/contrib/hbtip/ftpcln.prg @@ -4,10 +4,9 @@ /* * xHarbour Project source code: - * TIP Class oriented Internet protocol library + * TIP Class oriented Internet protocol library (FTP) * * Copyright 2003 Giancarlo Niccolai - * * www - http://www.harbour-project.org * * This program is free software; you can redistribute it and/or modify @@ -57,13 +56,11 @@ Added method :MPut() Changed method :downloadFile() to enable display of progress Changed method :uploadFile() to enable display of progress -*/ -/* 2007-06-01, Toninho@fwi + 2007-06-01, Toninho@fwi Added method UserCommand( cCommand, lPasv, lReadPort, lGetReply ) -*/ -/* 2007-07-12, miguelangel@marchuet.net + 2007-07-12, miguelangel@marchuet.net Added method :NoOp() Added method :Rest( nPos ) Changed method :LS( cSpec ) @@ -78,9 +75,8 @@ Added method :SendPort() Cleaned unused variables. -*/ -/* 2007-09-08 21:34 UTC+0100 Patrick Mast + 2007-09-08 21:34 UTC+0100 Patrick Mast * source\tip\ftpcln.prg * Formatting + METHOD StartCleanLogFile() @@ -90,22 +86,21 @@ + DATA cLogFile Holds the filename of the current logfile. ! Fixed logfilename in New(), now its not limited to 9999 log files anymore - ! Fixed MGet() due to changes in HB_aTokens() - ! Fixed listFiles() due to changes in HB_aTokens() + ! Fixed MGet() due to changes in hb_ATokens() + ! Fixed listFiles() due to changes in hb_ATokens() ! listFiles() is still buggy. Needs to be fixed. */ -#include "directry.ch" #include "hbclass.ch" -#include "tip.ch" + #include "common.ch" +#include "directry.ch" +#include "tip.ch" + +/* TOFIX: This won't work in MT programs. [vszakats] */ STATIC s_nPort := 16000 -/** -* Inet service manager: ftp -*/ - CREATE CLASS tIPClientFTP FROM tIPClient VAR nDataPort VAR cDataServer @@ -144,16 +139,14 @@ CREATE CLASS tIPClientFTP FROM tIPClient METHOD ScanLength() METHOD ReadAuxPort() METHOD mget() - // Method bellow contributed by Rafa Carmona + + // Method below contributed by Rafa Carmona METHOD LS( cSpec ) METHOD Rename( cFrom, cTo ) - // new method for file upload - METHOD UpLoadFile( cLocalFile, cRemoteFile ) - // new method to download file - METHOD DownLoadFile( cLocalFile, cRemoteFile ) - // new method to create an directory on ftp server - METHOD MKD( cPath ) + METHOD UpLoadFile( cLocalFile, cRemoteFile ) // new method for file upload + METHOD DownLoadFile( cLocalFile, cRemoteFile ) // new method to download file + METHOD MKD( cPath ) // new method to create an directory on ftp server METHOD RMD( cPath ) METHOD listFiles( cList ) @@ -163,11 +156,11 @@ CREATE CLASS tIPClientFTP FROM tIPClient ENDCLASS -METHOD New( oUrl,lTrace, oCredentials) CLASS tIPClientFTP - LOCAL cFile :="ftp" - LOCAL n := 0 +METHOD New( oUrl, lTrace, oCredentials ) CLASS tIPClientFTP + LOCAL n + + ::super:new( oUrl, lTrace, oCredentials ) - ::super:new( oUrl, lTrace, oCredentials) ::nDefaultPort := 21 ::nConnTimeout := 3000 ::bUsePasv := .T. @@ -175,34 +168,33 @@ METHOD New( oUrl,lTrace, oCredentials) CLASS tIPClientFTP ::nDefaultSndBuffSize := 65536 ::nDefaultRcvBuffSize := 65536 - if ::ltrace - if !hb_FileExists("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) - endif - endif + IF ::lTrace + IF ! hb_FileExists( "ftp.log" ) + ::nHandle := FCreate( "ftp.log" ) + ELSE + n := 0 + DO WHILE hb_FileExists( "ftp" + hb_ntos( n ) + ".log" ) + n++ + ENDDO + ::cLogFile := "ftp" + hb_ntos( n ) + ".log" + ::nHandle := FCreate( ::cLogFile ) + ENDIF + ENDIF // precompilation of regex for better prestations - ::RegBytes := HB_RegexComp( "\(([0-9]+)[ )a-zA-Z]" ) - ::RegPasv := HB_RegexComp( "([0-9]*) *, *([0-9]*) *, *([0-9]*) *, *([0-9]*) *, *([0-9]*) *, *([0-9]*)" ) - -RETURN Self + ::RegBytes := hb_regexComp( "\(([0-9]+)[ )a-zA-Z]" ) + ::RegPasv := hb_regexComp( "([0-9]*) *, *([0-9]*) *, *([0-9]*) *, *([0-9]*) *, *([0-9]*) *, *([0-9]*)" ) + RETURN Self METHOD StartCleanLogFile() CLASS tIPClientFTP - FClose(::nHandle) - ::nHandle := FCreate(::cLogFile) -RETURN NIL - + FClose( ::nHandle ) + ::nHandle := FCreate( ::cLogFile ) + RETURN NIL METHOD Open( cUrl ) CLASS tIPClientFTP - IF HB_IsString( cUrl ) + IF hb_isString( cUrl ) ::oUrl := tUrl():New( cUrl ) ENDIF @@ -214,7 +206,7 @@ METHOD Open( cUrl ) CLASS tIPClientFTP RETURN .F. ENDIF - HB_InetTimeout( ::SocketCon, ::nConnTimeout ) + hb_inetTimeout( ::SocketCon, ::nConnTimeout ) IF ::GetReply() ::InetSendall( ::SocketCon, "USER " + ::oUrl:cUserid + ::cCRLF ) IF ::GetReply() @@ -225,7 +217,7 @@ METHOD Open( cUrl ) CLASS tIPClientFTP ENDIF ENDIF ENDIF -RETURN .F. + RETURN .F. METHOD GetReply() CLASS tIPClientFTP LOCAL nLen @@ -240,9 +232,9 @@ METHOD GetReply() CLASS tIPClientFTP ENDIF // now, if the reply has a "-" as fourth character, we need to proceed... - DO WHILE ! 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, "") + cRep := iif( ISCHARACTER( ::cReply ), ::cReply, "" ) ENDDO // 4 and 5 are error codes @@ -250,66 +242,63 @@ METHOD GetReply() CLASS tIPClientFTP RETURN .F. ENDIF -RETURN .T. + RETURN .T. METHOD Pasv() CLASS tIPClientFTP LOCAL aRep ::InetSendall( ::SocketCon, "PASV" + ::cCRLF ) + IF ! ::GetReply() RETURN .F. ENDIF - aRep := HB_Regex( ::RegPasv, ::cReply ) - IF Empty(aRep) + aRep := hb_regex( ::RegPasv, ::cReply ) + + IF Empty( aRep ) RETURN .F. ENDIF - ::cDataServer := aRep[2] + "." + aRep[3] + "." + aRep[4] + "." + aRep[5] - ::nDataPort := Val(aRep[6]) *256 + Val( aRep[7] ) - -RETURN .T. + ::cDataServer := aRep[ 2 ] + "." + aRep[ 3 ] + "." + aRep[ 4 ] + "." + aRep[ 5 ] + ::nDataPort := Val( aRep[ 6 ] ) * 256 + Val( aRep[ 7 ] ) + RETURN .T. METHOD Close() CLASS tIPClientFTP - HB_InetTimeOut( ::SocketCon, ::nConnTimeout ) - if ::ltrace - fClose(::nHandle) - endif + + hb_inetTimeOut( ::SocketCon, ::nConnTimeout ) + + IF ::lTrace + FClose( ::nHandle ) + ENDIF ::Quit() -RETURN ::super:Close() + RETURN ::super:Close() METHOD Quit() CLASS tIPClientFTP ::InetSendall( ::SocketCon, "QUIT" + ::cCRLF ) -RETURN ::GetReply() - + RETURN ::GetReply() METHOD TypeI() CLASS tIPClientFTP ::InetSendall( ::SocketCon, "TYPE I" + ::cCRLF ) -RETURN ::GetReply() - + RETURN ::GetReply() METHOD TypeA() CLASS tIPClientFTP ::InetSendall( ::SocketCon, "TYPE A" + ::cCRLF ) -RETURN ::GetReply() - + RETURN ::GetReply() METHOD NoOp() CLASS tIPClientFTP ::InetSendall( ::SocketCon, "NOOP" + ::cCRLF ) -RETURN ::GetReply() - + RETURN ::GetReply() METHOD Rest( nPos ) CLASS tIPClientFTP - ::InetSendall( ::SocketCon, "REST " + AllTrim( Str( iif( Empty( nPos ), 0, nPos ) ) ) + ::cCRLF ) -RETURN ::GetReply() - + ::InetSendall( ::SocketCon, "REST " + hb_ntos( iif( Empty( nPos ), 0, nPos ) ) + ::cCRLF ) + RETURN ::GetReply() METHOD CWD( cPath ) CLASS tIPClientFTP ::InetSendall( ::SocketCon, "CWD " + cPath + ::cCRLF ) -RETURN ::GetReply() - + RETURN ::GetReply() METHOD PWD() CLASS tIPClientFTP @@ -317,40 +306,40 @@ METHOD PWD() CLASS tIPClientFTP IF ! ::GetReply() RETURN .F. ENDIF - ::cReply := SubStr( ::cReply, At('"', ::cReply) + 1, ; - Rat('"', ::cReply) - At('"', ::cReply) - 1 ) -RETURN .T. + ::cReply := SubStr( ::cReply, At( '"', ::cReply ) + 1, ; + RAt( '"', ::cReply ) - At( '"', ::cReply ) - 1 ) + RETURN .T. METHOD DELE( cPath ) CLASS tIPClientFTP ::InetSendall( ::SocketCon, "DELE " + cPath + ::cCRLF ) -RETURN ::GetReply() - + RETURN ::GetReply() // scan last reply for an hint of length METHOD ScanLength() CLASS tIPClientFTP - LOCAL aBytes - aBytes := HB_Regex( ::RegBytes, ::cReply ) - IF ! Empty(aBytes) - ::nLength := Val( aBytes[2] ) - ENDIF -RETURN .T. + LOCAL aBytes := hb_regex( ::RegBytes, ::cReply ) + IF ! Empty( aBytes ) + ::nLength := Val( aBytes[ 2 ] ) + ENDIF + + RETURN .T. METHOD TransferStart() CLASS tIPClientFTP LOCAL skt + ::SocketControl := ::SocketCon IF ::bUsePasv - skt := HB_InetConnectIP( ::cDataServer, ::nDataPort ) + skt := hb_inetConnectIP( ::cDataServer, ::nDataPort ) IF skt != NIL .AND. ::InetErrorCode( skt ) == 0 // Get the start message from the control connection IF ! ::GetReply() - HB_InetClose( skt ) + hb_inetClose( skt ) RETURN .F. ENDIF - HB_InetTimeout( skt, ::nConnTimeout ) + hb_inetTimeout( skt, ::nConnTimeout ) /* Set internal socket send buffer to 64k, * this should fix the speed problems some users have reported */ @@ -365,22 +354,23 @@ METHOD TransferStart() CLASS tIPClientFTP ::SocketCon := skt ENDIF ELSE - ::SocketCon := HB_InetAccept( ::SocketPortServer ) + ::SocketCon := hb_inetAccept( ::SocketPortServer ) IF Empty( ::SocketCon ) ::bInitialized := .F. ::SocketCon := ::SocketControl ::GetReply() RETURN .F. ENDIF - HB_InetSetRcvBufSize( ::SocketCon, 65536 ) - HB_InetSetSndBufSize( ::SocketCon, 65536 ) + hb_inetSetRcvBufSize( ::SocketCon, 65536 ) + hb_inetSetSndBufSize( ::SocketCon, 65536 ) ENDIF -RETURN .T. - + RETURN .T. METHOD Commit() CLASS tIPClientFTP - HB_InetClose( ::SocketCon ) + + hb_inetClose( ::SocketCon ) + ::SocketCon := ::SocketControl ::bInitialized := .F. @@ -393,8 +383,7 @@ METHOD Commit() CLASS tIPClientFTP RETURN .F. ENDIF -RETURN .T. - + RETURN .T. METHOD List( cSpec ) CLASS tIPClientFTP LOCAL cStr @@ -420,7 +409,8 @@ METHOD List( cSpec ) CLASS tIPClientFTP ::InetSendAll( ::SocketCon, "LIST" + cSpec + ::cCRLF ) cStr := ::ReadAuxPort() ::bEof := .F. -RETURN cStr + + RETURN cStr METHOD UserCommand( cCommand, lPasv, lReadPort, lGetReply ) CLASS tIPClientFTP @@ -429,22 +419,21 @@ METHOD UserCommand( cCommand, lPasv, lReadPort, lGetReply ) CLASS tIPClientFTP DEFAULT lReadPort TO .T. DEFAULT lGetReply TO .F. - if ::bUsePasv .AND. lPasv .AND. !::Pasv() + IF ::bUsePasv .AND. lPasv .AND. !::Pasv() RETURN .F. - endif + ENDIF ::InetSendAll( ::SocketCon, cCommand ) - if lReadPort + IF lReadPort lReadPort := ::ReadAuxPort() - endif + ENDIF - if lGetReply + IF lGetReply lGetReply := ::GetReply() - endif - -RETURN .T. + ENDIF + RETURN .T. METHOD ReadAuxPort( cLocalFile ) CLASS tIPClientFTP LOCAL cRet @@ -467,7 +456,7 @@ METHOD ReadAuxPort( cLocalFile ) CLASS tIPClientFTP cRet := ::super:Read( 512 ) ENDDO - HB_InetClose( ::SocketCon ) + hb_inetClose( ::SocketCon ) ::SocketCon := ::SocketControl IF ::GetReply() IF nFile > 0 @@ -476,8 +465,7 @@ METHOD ReadAuxPort( cLocalFile ) CLASS tIPClientFTP ENDIF RETURN cList ENDIF -RETURN NIL - + RETURN NIL METHOD Stor( cFile ) CLASS tIPClientFTP @@ -496,36 +484,33 @@ METHOD Stor( cFile ) CLASS tIPClientFTP ::GetReply() ENDIF -RETURN ::TransferStart() - + RETURN ::TransferStart() METHOD Port() CLASS tIPClientFTP - ::SocketPortServer := HB_InetCreate( ::nConnTimeout ) - s_nPort ++ + ::SocketPortServer := hb_inetCreate( ::nConnTimeout ) + s_nPort++ DO WHILE s_nPort < 24000 - HB_InetServer( s_nPort, ::SocketPortServer ) + hb_inetServer( s_nPort, ::SocketPortServer ) IF ::InetErrorCode( ::SocketPortServer ) == 0 RETURN ::SendPort() ENDIF - s_nPort ++ + s_nPort++ ENDDO -RETURN .F. - + RETURN .F. METHOD SendPort() CLASS tIPClientFTP LOCAL cAddr LOCAL cPort, nPort - cAddr := HB_InetGetHosts( NetName() )[1] - cAddr := StrTran( cAddr, ".", "," ) - nPort := HB_InetPort( ::SocketPortServer ) - cPort := "," + AllTrim( Str( Int( nPort / 256 ) ) ) + "," + AllTrim( Str( Int( nPort % 256 ) ) ) + cAddr := StrTran( hb_inetGetHosts( NetName() )[ 1 ], ".", "," ) + nPort := hb_inetPort( ::SocketPortServer ) + cPort := "," + hb_ntos( Int( nPort / 256 ) ) + "," + hb_ntos( Int( nPort % 256 ) ) - ::InetSendall( ::SocketCon, "PORT " + cAddr + cPort + ::cCRLF ) -RETURN ::GetReply() + ::InetSendall( ::SocketCon, "PORT " + cAddr + cPort + ::cCRLF ) + RETURN ::GetReply() METHOD Read( nLen ) CLASS tIPClientFTP LOCAL cRet @@ -533,64 +518,47 @@ METHOD Read( nLen ) CLASS tIPClientFTP IF ! ::bInitialized IF ! Empty( ::oUrl:cPath ) - IF ! ::CWD( ::oUrl:cPath ) - ::bEof := .T. // no data for this transaction RETURN NIL - ENDIF - ENDIF IF Empty( ::oUrl:cFile ) - RETURN ::List() - ENDIF IF ! ::Retr( ::oUrl:cFile ) - ::bEof := .T. // no data for this transaction RETURN NIL - ENDIF // now channel is open ::bInitialized := .T. - ENDIF cRet := ::super:Read( nLen ) IF cRet == NIL - ::Commit() ::bEof := .T. - ENDIF -RETURN cRet + RETURN cRet -* -* FTP transfer wants commit only at end. -* +/* FTP transfer wants commit only at end. */ METHOD Write( cData, nLen ) CLASS tIPClientFTP IF ! ::bInitialized IF Empty( ::oUrl:cFile ) - RETURN -1 - ENDIF IF ! Empty( ::oUrl:cPath ) - IF ! ::CWD( ::oUrl:cPath ) RETURN -1 ENDIF - ENDIF IF ! ::Stor( ::oUrl:cFile ) @@ -601,11 +569,7 @@ METHOD Write( cData, nLen ) CLASS tIPClientFTP ::bInitialized := .T. ENDIF -RETURN ::super:Write( cData, nLen, .F. ) - -/* - * HZ: What's cLocalFile good for? It's unused - */ + RETURN ::super:Write( cData, nLen, .F. ) METHOD Retr( cFile ) CLASS tIPClientFTP @@ -623,18 +587,15 @@ METHOD Retr( cFile ) CLASS tIPClientFTP RETURN .T. ENDIF -RETURN .F. + RETURN .F. -METHOD MGET( cSpec,cLocalPath ) CLASS tIPClientFTP +METHOD MGET( cSpec, cLocalPath ) CLASS tIPClientFTP - LOCAL cStr,cfile,aFiles + LOCAL cStr, cFile + + DEFAULT cSpec TO "" + DEFAULT cLocalPath TO "" - IF cSpec == NIL - cSpec := "" - ENDIF - IF cLocalPath == NIL - cLocalPath:="" - ENDIF IF ::bUsePasv IF ! ::Pasv() //::bUsePasv := .F. @@ -645,48 +606,45 @@ METHOD MGET( cSpec,cLocalPath ) CLASS tIPClientFTP ::InetSendAll( ::SocketCon, "NLST " + cSpec + ::cCRLF ) cStr := ::ReadAuxPort() - IF !empty(cStr) - aFiles:=hb_atokens(strtran(cStr,chr(13),""),chr(10)) - FOR each cFile in aFiles - IF !Empty(cFile) //PM:09-08-2007 Needed because of the new HB_aTokens() - ::downloadfile( cLocalPath+trim(cFile), trim(cFile) ) + IF ! Empty( cStr ) + FOR EACH cFile IN hb_ATokens( StrTran( cStr, Chr( 13 ) ), Chr( 10 ) ) + IF ! Empty( cFile ) //PM:09-08-2007 Needed because of the new hb_ATokens() + ::downloadfile( cLocalPath + RTrim( cFile ), RTrim( cFile ) ) ENDIF NEXT - ENDIF -RETURN cStr + RETURN cStr METHOD MPUT( cFileSpec, cAttr ) CLASS tIPClientFTP - LOCAL cPath,cFile, cExt, aFile, aFiles + LOCAL cPath, cFile, cExt, aFile LOCAL cStr := "" IF ! ISCHARACTER( cFileSpec ) RETURN 0 ENDIF - HB_FNameSplit( cFileSpec, @cPath, @cFile, @cExt ) + hb_FNameSplit( cFileSpec, @cPath, @cFile, @cExt ) - aFiles := Directory( cPath + cFile + cExt, cAttr ) - - FOR each aFile in aFiles - IF ::uploadFile( cPath + aFile[F_NAME], aFile[F_NAME] ) - cStr += HB_InetCrlf() + aFile[F_NAME] + FOR EACH aFile IN Directory( cPath + cFile + cExt, cAttr ) + IF ::uploadFile( cPath + aFile[ F_NAME ], aFile[ F_NAME ] ) + cStr += hb_inetCrlf() + aFile[ F_NAME ] ENDIF NEXT -RETURN SubStr(cStr,3) + + RETURN SubStr( cStr, Len( hb_inetCrlf() ) + 1 ) METHOD UpLoadFile( cLocalFile, cRemoteFile ) CLASS tIPClientFTP - LOCAL cPath := "" - LOCAL cFile := "" - LOCAL cExt := "" + LOCAL cPath + LOCAL cFile + LOCAL cExt - HB_FNameSplit( cLocalFile, @cPath, @cFile,@cExt ) + hb_FNameSplit( cLocalFile, @cPath, @cFile,@cExt ) - DEFAULT cRemoteFile to cFile + cExt + DEFAULT cRemoteFile TO cFile + cExt ::bEof := .F. ::oUrl:cFile := cRemoteFile @@ -717,16 +675,13 @@ METHOD UpLoadFile( cLocalFile, cRemoteFile ) CLASS tIPClientFTP ::bInitialized := .T. ENDIF -RETURN ::WriteFromFile( cLocalFile ) - + RETURN ::WriteFromFile( cLocalFile ) METHOD LS( cSpec ) CLASS tIPClientFTP LOCAL cStr - IF cSpec == NIL - cSpec := "" - ENDIF + DEFAULT cSpec TO "" IF ::bUsePasv .AND. ! ::Pasv() //::bUsePasv := .F. @@ -744,34 +699,30 @@ METHOD LS( cSpec ) CLASS tIPClientFTP cStr := "" ENDIF -RETURN cStr - -/*Rename a traves del ftp */ + RETURN cStr +/* Rename a traves del ftp */ METHOD Rename( cFrom, cTo ) CLASS tIPClientFTP - LOCAL lResult := .F. + LOCAL lResult := .F. - ::InetSendAll( ::SocketCon, "RNFR " + cFrom + ::cCRLF ) + ::InetSendAll( ::SocketCon, "RNFR " + cFrom + ::cCRLF ) - IF ::GetReply() + IF ::GetReply() + ::InetSendAll( ::SocketCon, "RNTO " + cTo + ::cCRLF ) + lResult := ::GetReply() + ENDIF - ::InetSendAll( ::SocketCon, "RNTO " + cTo + ::cCRLF ) - lResult := ::GetReply() - - ENDIF - -RETURN lResult + RETURN lResult METHOD DownLoadFile( cLocalFile, cRemoteFile ) CLASS tIPClientFTP - LOCAL cPath := "" - LOCAL cFile := "" - LOCAL cExt := "" + LOCAL cPath + LOCAL cFile + LOCAL cExt - HB_FNameSplit( cLocalFile, @cPath, @cFile, @cExt ) + hb_FNameSplit( cLocalFile, @cPath, @cFile, @cExt ) - - DEFAULT cRemoteFile to cFile+cExt + DEFAULT cRemoteFile TO cFile + cExt ::bEof := .F. ::oUrl:cFile := cRemoteFile @@ -794,36 +745,36 @@ METHOD DownLoadFile( cLocalFile, cRemoteFile ) CLASS tIPClientFTP // now channel is open ::bInitialized := .T. - ENDIF -RETURN ::ReadToFile( cLocalFile, , ::nLength ) + RETURN ::ReadToFile( cLocalFile, , ::nLength ) // Create a new folder METHOD MKD( cPath ) CLASS tIPClientFTP ::InetSendall( ::SocketCon, "MKD " + cPath + ::cCRLF ) -RETURN ::GetReply() + RETURN ::GetReply() // Delete an existing folder METHOD RMD( cPath ) CLASS tIPClientFTP ::InetSendall( ::SocketCon, "RMD " + cPath + ::cCRLF ) -RETURN ::GetReply() + RETURN ::GetReply() // Return total file size for METHOD fileSize( cFileSpec ) CLASS tIPClientFTP - LOCAL aFiles:=::ListFiles( cFileSpec ), nSize:=0, n - FOR n =1 TO Len(aFiles) - nSize+=Val(aFiles[n][7]) // Should [7] not be [F_SIZE] ? + LOCAL aFile + LOCAL nSize := 0 + FOR EACH aFile IN ::ListFiles( cFileSpec ) + nSize += Val( aFile[ F_SIZE ] ) NEXT -RETURN nSize + RETURN nSize // Parse the :list() string into a Directory() compatible 2-dim array METHOD listFiles( cFileSpec ) CLASS tIPClientFTP - LOCAL aMonth:= { "Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" } + LOCAL aMonth := { "Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" } LOCAL cList, aList, aFile, cEntry, nStart, nEnd LOCAL cYear, cMonth, cDay, cTime @@ -833,70 +784,70 @@ METHOD listFiles( cFileSpec ) CLASS tIPClientFTP RETURN {} ENDIF - aList := HB_ATokens( StrTran( cList, Chr(13),""), Chr(10) ) + aList := hb_ATokens( StrTran( cList, Chr( 13 ) ), Chr( 10 ) ) FOR EACH cEntry IN aList - IF Empty( cEntry ) //PM:09-08-2007 Needed because of the new HB_aTokens() + IF Empty( cEntry ) //PM:09-08-2007 Needed because of the new hb_ATokens() - hb_ADel(aList, cEntry:__enumIndex(), .T.) + hb_ADel( aList, cEntry:__enumIndex(), .T. ) ELSE - aFile := Array( F_LEN+3 ) + aFile := Array( F_LEN + 3 ) nStart := 1 - nEnd := hb_At( Chr(32), cEntry, nStart ) + nEnd := hb_At( " ", cEntry, nStart ) // file permissions (attributes) - aFile[F_ATTR] := SubStr( cEntry, nStart, nEnd-nStart ) - nStart := nEnd + aFile[ F_ATTR ] := SubStr( cEntry, nStart, nEnd - nStart ) + nStart := nEnd // # of links DO WHILE SubStr( cEntry, ++nStart, 1 ) == " " ; ENDDO - nEnd := hb_At( Chr(32), cEntry, nStart ) - aFile[F_LEN+1]:= Val( SubStr( cEntry, nStart, nEnd-nStart ) ) - nStart := nEnd + nEnd := hb_At( " ", cEntry, nStart ) + aFile[ F_LEN + 1 ] := Val( SubStr( cEntry, nStart, nEnd - nStart ) ) + nStart := nEnd // owner name DO WHILE SubStr( cEntry, ++nStart, 1 ) == " " ; ENDDO - nEnd := hb_At( Chr(32), cEntry, nStart ) - aFile[F_LEN+2]:= SubStr( cEntry, nStart, nEnd-nStart ) - nStart := nEnd + nEnd := hb_At( " ", cEntry, nStart ) + aFile[ F_LEN + 2 ] := SubStr( cEntry, nStart, nEnd - nStart ) + nStart := nEnd // group name DO WHILE SubStr( cEntry, ++nStart, 1 ) == " " ; ENDDO - nEnd := hb_At( Chr(32), cEntry, nStart ) - aFile[F_LEN+3]:= SubStr( cEntry, nStart, nEnd-nStart ) - nStart := nEnd + nEnd := hb_At( " ", cEntry, nStart ) + aFile[ F_LEN + 3 ] := SubStr( cEntry, nStart, nEnd - nStart ) + nStart := nEnd // file size DO WHILE SubStr( cEntry, ++nStart, 1 ) == " " ; ENDDO - nEnd := hb_At( Chr(32), cEntry, nStart ) - aFile[F_SIZE] := Val( SubStr( cEntry, nStart, nEnd-nStart ) ) - nStart := nEnd + nEnd := hb_At( " ", cEntry, nStart ) + aFile[ F_SIZE ] := Val( SubStr( cEntry, nStart, nEnd - nStart ) ) + nStart := nEnd // Month DO WHILE SubStr( cEntry, ++nStart, 1 ) == " " ; ENDDO - nEnd := hb_At( Chr(32), cEntry, nStart ) - cMonth := SubStr( cEntry, nStart, nEnd-nStart ) + nEnd := hb_At( " ", cEntry, nStart ) + cMonth := SubStr( cEntry, nStart, nEnd - nStart ) cMonth := PadL( AScan( aMonth, cMonth ), 2, "0" ) nStart := nEnd // Day DO WHILE SubStr( cEntry, ++nStart, 1 ) == " " ; ENDDO - nEnd := hb_At( Chr(32), cEntry, nStart ) - cDay := SubStr( cEntry, nStart, nEnd-nStart ) + nEnd := hb_At( " ", cEntry, nStart ) + cDay := SubStr( cEntry, nStart, nEnd - nStart ) nStart := nEnd // year DO WHILE SubStr( cEntry, ++nStart, 1 ) == " " ; ENDDO - nEnd := hb_At( Chr(32), cEntry, nStart ) - cYear := SubStr( cEntry, nStart, nEnd-nStart ) + nEnd := hb_At( " ", cEntry, nStart ) + cYear := SubStr( cEntry, nStart, nEnd - nStart ) nStart := nEnd IF ":" $ cYear cTime := cYear - cYear := Str( Year(Date()), 4, 0 ) + cYear := Str( Year( Date() ), 4, 0 ) ELSE cTime := "" ENDIF @@ -904,9 +855,9 @@ METHOD listFiles( cFileSpec ) CLASS tIPClientFTP // file name DO WHILE SubStr( cEntry, ++nStart, 1 ) == " " ; ENDDO - aFile[F_NAME] := SubStr( cEntry, nStart ) - aFile[F_DATE] := hb_StoD( cYear+cMonth+cDay ) - aFile[F_TIME] := cTime + aFile[ F_NAME ] := SubStr( cEntry, nStart ) + aFile[ F_DATE ] := hb_SToD( cYear + cMonth + cDay ) + aFile[ F_TIME ] := cTime aList[ cEntry:__enumIndex() ] := aFile @@ -914,4 +865,4 @@ METHOD listFiles( cFileSpec ) CLASS tIPClientFTP NEXT -RETURN aList + RETURN aList diff --git a/harbour/contrib/hbtip/httpcln.prg b/harbour/contrib/hbtip/httpcln.prg index 488eab0aaa..f699b9c035 100644 --- a/harbour/contrib/hbtip/httpcln.prg +++ b/harbour/contrib/hbtip/httpcln.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 @@ -51,8 +50,11 @@ * */ -#include "common.ch" #include "hbclass.ch" + +#include "common.ch" +#include "fileio.ch" + #include "tip.ch" /** @@ -60,51 +62,56 @@ */ CREATE CLASS tIPClientHTTP FROM tIPClient + VAR cMethod VAR nReplyCode VAR cReplyDescr - VAR nVersion INIT 1 - VAR nSubversion INIT 0 + 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 hHeaders INIT { => } + VAR hCookies INIT { => } + VAR hFields INIT { => } + VAR cUserAgent INIT "Mozilla/3.0 compatible" VAR cAuthMode INIT "" VAR cBoundary - VAR aAttachments init {} + VAR aAttachments INIT {} - METHOD New( oUrl,lTrace, oCredentials) + METHOD New( oUrl, lTrace, oCredentials ) METHOD Get( cQuery ) - METHOD Post( cPostData, cQuery ) + METHOD Post( xPostData, cQuery ) METHOD ReadHeaders() METHOD Read( nLen ) METHOD UseBasicAuth() INLINE ::cAuthMode := "Basic" - Method ReadAll() - Method SetCookie - Method GetCookies - Method Boundary - METHOD Attach(cName,cFileName,cType) - Method PostMultiPart - Method WriteAll( cFile ) + METHOD ReadAll() + METHOD SetCookie + METHOD GetCookies + METHOD Boundary + METHOD Attach( cName, cFileName, cType ) + METHOD PostMultiPart( xPostData, cQuery ) + METHOD WriteAll( cFile ) + + HIDDEN: -HIDDEN: METHOD StandardFields() ENDCLASS -METHOD New( oUrl,lTrace, oCredentials) CLASS tIPClientHTTP +METHOD New( oUrl, lTrace, oCredentials ) CLASS tIPClientHTTP + ::super:new( oUrl, lTrace, oCredentials ) + ::nDefaultPort := 80 ::nConnTimeout := 5000 ::bChunked := .F. - hb_hCaseMatch( ::hHeaders, .F. ) -RETURN Self + hb_HCaseMatch( ::hHeaders, .F. ) + RETURN Self METHOD Get( cQuery ) CLASS tIPClientHTTP - IF ! HB_IsString( cQuery ) + + IF ! hb_isString( cQuery ) cQuery := ::oUrl:BuildQuery() ENDIF @@ -114,52 +121,44 @@ METHOD Get( cQuery ) CLASS tIPClientHTTP IF ::InetErrorCode( ::SocketCon ) == 0 RETURN ::ReadHeaders() ENDIF -RETURN .F. + + RETURN .F. -METHOD Post( cPostData, cQuery ) CLASS tIPClientHTTP - LOCAL cData, nI, cTmp,y +METHOD Post( xPostData, cQuery ) CLASS tIPClientHTTP + LOCAL cData, nI, cTmp, y - IF HB_IsHash( cPostData ) + IF hb_isHash( xPostData ) cData := "" - FOR nI := 1 TO Len( cPostData ) - cTmp := hb_HKeyAt( cPostData, nI ) - cTmp := hb_cStr( cTmp ) - cTmp := AllTrim( cTmp ) - cTmp := TipEncoderUrl_Encode( cTmp ) - cData += cTmp +"=" - cTmp := hb_HValueAt( cPostData, nI ) - cTmp := hb_cStr( cTmp ) - cTmp := TipEncoderUrl_Encode( cTmp ) - cData += cTmp + "&" - NEXT - cData := left( cData, len( cData ) - 1 ) - ELSEIF HB_IsArray( cPostData ) - cData := "" - y:=Len(cPostData) + y := Len( xPostData ) FOR nI := 1 TO y - cTmp := cPostData[ nI ,1] - cTmp := hb_cStr( cTmp ) - cTmp := AllTrim( cTmp ) - cTmp := TipEncoderUrl_Encode( cTmp ) - cData += cTmp +"=" - cTmp := cPostData[ nI,2] - cTmp := hb_cStr( cTmp ) - cTmp := TipEncoderUrl_Encode( cTmp ) + cTmp := TipEncoderUrl_Encode( AllTrim( hb_cStr( hb_HKeyAt( xPostData, nI ) ) ) ) + cData += cTmp + "=" + cTmp := TipEncoderUrl_Encode( hb_cStr( hb_HValueAt( xPostData, nI ) ) ) cData += cTmp - IF nI!=y - cData+="&" + IF nI != y + cData += "&" ENDIF NEXT - - ELSEIF HB_IsString( cPostData ) - cData := cPostData + ELSEIF hb_isArray( xPostData ) + cData := "" + y := Len( xPostData ) + FOR nI := 1 TO y + cTmp := TipEncoderUrl_Encode( AllTrim( hb_cStr( xPostData[ nI, 1 ] ) ) ) + cData += cTmp + "=" + cTmp := TipEncoderUrl_Encode( hb_cStr( xPostData[ nI, 2 ] ) ) + cData += cTmp + IF nI != y + cData += "&" + ENDIF + NEXT + ELSEIF hb_isString( xPostData ) + cData := xPostData ELSE - Alert( "TipClientHTTP_PostRequest: Invalid parameters" ) RETURN .F. ENDIF - IF ! HB_IsString( cQuery ) + IF ! hb_isString( cQuery ) cQuery := ::oUrl:BuildQuery() ENDIF @@ -180,10 +179,9 @@ METHOD Post( cPostData, cQuery ) CLASS tIPClientHTTP ::InetSendall( ::SocketCon, cData ) ::bInitialized := .T. RETURN ::ReadHeaders() -/* else - alert("Post HB_InetErrorCode:"+winsockerrorcode(::InetErrorCode( ::SocketCon )))*/ ENDIF -RETURN .F. + + RETURN .F. METHOD StandardFields() CLASS tIPClientHTTP LOCAL iCount @@ -214,11 +212,9 @@ METHOD StandardFields() CLASS tIPClientHTTP ": " + hb_HValueAt( ::hFields, iCount ) + ::cCRLF ) NEXT -RETURN .T. + RETURN .T. - - -METHOD ReadHeaders(lClear) CLASS tIPClientHTTP +METHOD ReadHeaders( lClear ) CLASS tIPClientHTTP LOCAL cLine, nPos, aVersion LOCAL aHead @@ -230,7 +226,7 @@ METHOD ReadHeaders(lClear) CLASS tIPClientHTTP ENDIF // Get Protocol version - aVersion := HB_Regex( "^HTTP/(.)\.(.) ([0-9][0-9][0-9]) +(.*)$", cLine ) + aVersion := hb_regex( "^HTTP/(.)\.(.) ([0-9][0-9][0-9]) +(.*)$", cLine ) ::cReply := cLine IF aVersion == NIL @@ -239,50 +235,49 @@ METHOD ReadHeaders(lClear) CLASS tIPClientHTTP ::nReplyCode := 0 ::cReplyDescr := "" ELSE - ::nVersion := Val(aVersion[2]) - ::nSubversion := Val( aVersion[3] ) - ::nReplyCode := val( aVersion[4] ) - ::cReplyDescr := aVersion[5] + ::nVersion := Val( aVersion[ 2 ] ) + ::nSubversion := Val( aVersion[ 3 ] ) + ::nReplyCode := Val( aVersion[ 4 ] ) + ::cReplyDescr := aVersion[ 5 ] ENDIF ::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. ! Empty( cLine ) - aHead := HB_RegexSplit( ":", cLine,,, 1 ) + aHead := hb_regexSplit( ":", cLine,,, 1 ) IF aHead == NIL .OR. Len( aHead ) != 2 cLine := ::InetRecvLine( ::SocketCon, @nPos, 500 ) LOOP ENDIF - ::hHeaders[ aHead[1] ] := LTrim(aHead[2]) + ::hHeaders[ aHead[ 1 ] ] := LTrim( aHead[ 2 ] ) + DO CASE + // RFC 2068 forces to discard content length on chunked encoding + CASE Lower( aHead[ 1 ] ) == "content-length" .AND. ! ::bChunked + cLine := SubStr( cLine, 16 ) + ::nLength := Val( cLine ) - // RFC 2068 forces to discard content length on chunked encoding - CASE lower( aHead[1] ) == "content-length" .AND. ! ::bChunked - cLine := Substr( cLine, 16 ) - ::nLength := Val( cLine ) - - // as above - CASE lower( aHead[1] ) == "transfer-encoding" - IF At( "chunked", lower( cLine ) ) > 0 - ::bChunked := .T. - ::nLength := -1 - ENDIF - CASE lower( aHead[1] ) == "set-cookie" - ::setCookie(aHead[2]) - + // as above + CASE Lower( aHead[ 1 ] ) == "transfer-encoding" + IF At( "chunked", Lower( cLine ) ) > 0 + ::bChunked := .T. + ::nLength := -1 + ENDIF + CASE Lower( aHead[ 1 ] ) == "set-cookie" + ::setCookie( aHead[ 2 ] ) ENDCASE + cLine := ::InetRecvLine( ::SocketCon, @nPos, 500 ) ENDDO IF ::InetErrorCode( ::SocketCon ) != 0 RETURN .F. ENDIF -RETURN .T. - + RETURN .T. METHOD Read( nLen ) CLASS tIPClientHTTP LOCAL cData, nPos, cLine, aHead @@ -313,7 +308,7 @@ METHOD Read( nLen ) CLASS tIPClientHTTP cLine := ::InetRecvLine( ::SocketCon, @nPos, 1024 ) DO WHILE ! Empty( cLine ) // add Headers to footers - aHead := HB_RegexSplit( ":", cLine,,, 1 ) + aHead := hb_regexSplit( ":", cLine,,, 1 ) IF aHead != NIL ::hHeaders[ aHead[1] ] := LTrim(aHead[2]) ENDIF @@ -329,9 +324,9 @@ METHOD Read( nLen ) CLASS tIPClientHTTP // A normal chunk here // Remove the extensions - nPos := at( ";", cLine ) + nPos := At( ";", cLine ) IF nPos > 0 - cLine := Substr( cLine, 1, nPos - 1 ) + cLine := SubStr( cLine, 1, nPos - 1 ) ENDIF // Convert to length @@ -352,11 +347,11 @@ METHOD Read( nLen ) CLASS tIPClientHTTP ENDIF -RETURN cData + RETURN cData METHOD ReadAll() CLASS tIPClientHTTP - LOCAL cOut:="", cChunk + LOCAL cOut := "", cChunk IF ! ::bInitialized ::bInitialized := .T. IF ! ::Get() @@ -365,227 +360,216 @@ METHOD ReadAll() CLASS tIPClientHTTP ENDIF IF ::bChunked cChunk:=::read() - do while cChunk != NIL - cOut+=cChunk - // ::nLength:=-1 - cChunk:=::read() - enddo - else + DO WHILE cChunk != NIL + cOut += cChunk + // ::nLength := -1 + cChunk := ::read() + ENDDO + ELSE RETURN ::read() - endif + ENDIF RETURN cOut -METHOD setCookie(cLine) CLASS tIPClientHTTP +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 - IF empty(cDefaultPath) - cDefaultPath:="/" + LOCAL cDefaultHost := ::oUrl:cServer, cDefaultPath := ::oUrl:cPath + LOCAL x, y + IF Empty( cDefaultPath ) + cDefaultPath := "/" ENDIF //this function currently ignores expires, secure and other tags that may be in the cookie for now... // ?"Setting COOKIE:",cLine - aParam := HB_RegexSplit( ";", cLine ) - cName:=cValue:="" - cHost:=cDefaultHost - cPath:=cDefaultPath - y:=len(aParam) - FOR x:=1 to y - aElements := HB_RegexSplit( "=", aParam[x], 1) - IF len(aElements) == 2 + aParam := hb_regexSplit( ";", cLine ) + cName := cValue := "" + cHost := cDefaultHost + cPath := cDefaultPath + y := Len( aParam ) + FOR x := 1 to y + aElements := hb_regexSplit( "=", aParam[ x ], 1 ) + IF Len( aElements ) == 2 IF x == 1 - cName:=alltrim(aElements[1]) - cValue:=alltrim(aElements[2]) - else - cElement:=upper(alltrim(aElements[1])) - do case - //case cElement=="EXPIRES" - case cElement=="PATH" - cPath:=alltrim(aElements[2]) - case cElement=="DOMAIN" - cHost:=alltrim(aElements[2]) - endcase + cName := AllTrim( aElements[ 1 ] ) + cValue := AllTrim( aElements[ 2 ] ) + ELSE + cElement := Upper( AllTrim( aElements[ 1 ] ) ) + DO CASE + //CASE cElement == "EXPIRES" + CASE cElement == "PATH" + cPath := AllTrim( aElements[ 2 ] ) + CASE cElement == "DOMAIN" + cHost := AllTrim( aElements[ 2 ] ) + ENDCASE ENDIF ENDIF - next - IF !empty(cName) + NEXT + IF ! Empty( cName ) //cookies are stored in hashes as host.path.name //check if we have a host hash yet - if !HB_HHASKEY(::hCookies,cHost) - ::hCookies[cHost]:={=>} - endif - if !HB_HHASKEY(::hCookies[cHost],cPath) - ::hCookies[cHost][cPath]:={=>} - endif - ::hCookies[cHost][cPath][cName]:=cValue + IF ! hb_HHasKey( ::hCookies, cHost ) + ::hCookies[ cHost ] := { => } + ENDIF + IF ! hb_HHasKey( ::hCookies[ cHost ], cPath ) + ::hCookies[ cHost ][ cPath ] := { => } + 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 +METHOD getcookies( cHost, cPath ) CLASS tIPClientHTTP + LOCAL x, y, aDomKeys := {}, aKeys, z, cKey, aPathKeys, nPath LOCAL a, b, cOut := "", c, d - IF cHost == NIL - cHost:=::oUrl:cServer - ENDIF + + DEFAULT cHost TO ::oUrl:cServer + IF cPath == NIL - cPath:=::oUrl:cPath - IF empty(cPath) - cPath:="/" + cPath := ::oUrl:cPath + IF Empty( cPath ) + cPath := "/" ENDIF ENDIF - IF empty(cHost) + IF Empty( cHost ) RETURN cOut ENDIF //tail matching the domain - aKeys:=hb_hkeys(::hCookies) - y:=len(aKeys) - z:=len(cHost) - cHost:=upper(cHost) + aKeys := hb_Hkeys( ::hCookies ) + y := Len( aKeys ) + z := Len( cHost ) + 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)==".") - aadd(aDomKeys,aKeys[x]) + cKey := Upper( aKeys[ x ] ) + IF Upper( right( cKey, z ) ) == cHost .AND. ( Len( cKey ) == z .OR. SubStr( aKeys[ x ], 0 - z, 1 ) == "." ) + AAdd( aDomKeys, aKeys[ x ] ) ENDIF NEXT //more specific paths should be sent before lesser generic paths. - asort(aDomKeys,,, {|cX,cY| len(cX) > len(cY)} ) - y:=len(aDomKeys) + ASort( aDomKeys,,, {| cX, cY | Len( cX ) > Len( cY ) } ) + y := Len( aDomKeys ) //now that we have the domain matches we have to do path matchine - nPath:=len(cPath) + nPath := Len( cPath ) FOR x := 1 TO y - aKeys:=hb_hkeys(::hCookies[aDomKeys[x]]) - aPathKeys:={} - b:=len(aKeys) - FOR a:= 1 TO b - cKey:=aKeys[a] - z:=len(cKey) - IF cKey=="/".OR.(z<=nPath.AND.substr(cKey,1,nPath)==cKey) - aadd(aPathKeys,aKeys[a]) + aKeys := hb_Hkeys( ::hCookies[ aDomKeys[ x ] ] ) + aPathKeys := {} + b := Len( aKeys ) + FOR a := 1 TO b + cKey := aKeys[ a ] + z := Len( cKey ) + IF cKey == "/" .OR. ( z <= nPath .AND. SubStr( cKey, 1, nPath ) == cKey ) + AAdd( aPathKeys, aKeys[ a ] ) ENDIF NEXT - asort(aPathKeys,,, {|cX,cY| len(cX) > len(cY)} ) - b:=len(aPathKeys) + ASort( aPathKeys,,, {| cX, cY | Len( cX ) > Len( cY ) } ) + b := Len( aPathKeys ) FOR a := 1 TO b - aKeys:=hb_hkeyat(::hCookies[aDomKeys[x]][aPathKeys[a]]) - d:=len(aKeys) + aKeys := hb_Hkeyat( ::hCookies[ aDomKeys[ x ] ] [ aPathKeys[ a ] ] ) + d := Len( aKeys ) FOR c := 1 TO d - IF !empty(cOut) - cOut+="; " + IF ! Empty( cOut ) + cOut += "; " ENDIF - cOut+=aKeys[c]+"="+::hCookies[aDomKeys[x]][aPathKeys[a]][aKeys[c]] + cOut += aKeys[ c ] + "=" + ::hCookies[ aDomKeys[ x ] ][ aPathKeys[ a ] ][ aKeys[ c ] ] NEXT NEXT NEXT -RETURN cOut + RETURN cOut -METHOD Boundary(nType) CLASS tIPClientHTTP +METHOD Boundary( nType ) CLASS tIPClientHTTP /* nType: 0=as found as the separator in the stdin stream - 1=as found as the last one in the stdin stream - 2=as found in the CGI enviroment + 1=as found as the last one in the stdin stream + 2=as found in the CGI enviroment Examples: -----------------------------41184676334 //in the body or stdin stream -----------------------------41184676334-- //last one of the stdin stream ----------------------------41184676334 //in the header or CGI envirnment + ---------------------------41184676334 //in the header or CGI envirnment */ - LOCAL cBound:=::cBoundary + LOCAL cBound := ::cBoundary LOCAL i - IF nType == NIL - nType := 0 - ENDIF - IF empty(cBound) - cBound:=replicate("-",27)+space(11) + DEFAULT nType TO 0 + IF Empty( cBound ) + cBound := Replicate( "-", 27 ) + Space( 11 ) FOR i := 28 TO 38 - cBound := Stuff( cBound, i, 1, str(int(HB_Random(0, 9 )),1,0) ) + cBound := Stuff( cBound, i, 1, Str( Int( hb_Random( 0, 9 ) ), 1, 0 ) ) NEXT - ::cBoundary:=cBound - endif - cBound:=iif(nType<2,"--","")+cBound+iif(nType == 1,"--","") - RETURN(cBound) - -METHOD Attach(cName,cFileName,cType) CLASS tIPClientHTTP - aadd(::aAttachments,{cName,cFileName,cType}) -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 - - IF empty(cPostData) - ELSEIF HB_IsHash( cPostData ) - FOR nI := 1 TO Len( cPostData ) - cTmp := hb_HKeyAt( cPostData, nI ) - cTmp := hb_cStr( cTmp ) - cTmp := AllTrim( cTmp ) - cTmp := TipEncoderUrl_Encode( cTmp ) - cData += cBound+cCrlf+'Content-Disposition: form-data; name="'+cTmp +'"'+cCrlf+cCrLf - cTmp := hb_HValueAt( cPostData, nI ) - cTmp := hb_cStr( cTmp ) - cTmp := AllTrim( cTmp ) - cTmp := TipEncoderUrl_Encode( cTmp ) - cData += cTmp+cCrLf - NEXT - ELSEIF HB_IsArray( cPostData ) - y:=Len(cPostData) - FOR nI := 1 TO y - cTmp := cPostData[ nI ,1] - cTmp := hb_cStr( cTmp ) - cTmp := AllTrim( cTmp ) - cTmp := TipEncoderUrl_Encode( cTmp ) - cData += cBound+cCrlf+'Content-Disposition: form-data; name="'+cTmp +'"'+cCrlf+cCrLf - cTmp := cPostData[ nI,2] - cTmp := hb_cStr( cTmp ) - cTmp := AllTrim( cTmp ) - cTmp := TipEncoderUrl_Encode( cTmp ) - cData += cTmp+cCrLf - NEXT - - ELSEIF HB_IsString( cPostData ) - cData := cPostData + ::cBoundary := cBound ENDIF - FOR each oSub in ::aAttachments - cName:=oSub[1] - cFile:=oSub[2] - cType:=oSub[3] - cTmp:=strtran(cFile,"/","\") - IF ( nPos := rat( "\", cTmp ) ) != 0 - cFilePath := substr( cTmp, 1, nPos ) - ELSEIF ( nPos := rat( ":", cTmp ) ) != 0 - cFilePath := substr( cTmp, 1, nPos ) + cBound := iif( nType < 2, "--", "" ) + cBound + iif( nType == 1, "--", "" ) + RETURN cBound + +METHOD Attach( cName, cFileName, cType ) CLASS tIPClientHTTP + AAdd( ::aAttachments, { cName, cFileName, cType } ) + RETURN NIL + +METHOD PostMultiPart( xPostData, 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 + + IF Empty( xPostData ) + ELSEIF hb_isHash( xPostData ) + y := Len( xPostData ) + FOR nI := 1 TO y + cTmp := TipEncoderUrl_Encode( AllTrim( hb_cStr( hb_HKeyAt( xPostData, nI ) ) ) ) + cData += cBound + cCrlf + 'Content-Disposition: form-data; name="' + cTmp + '"' + cCrlf + cCrLf + cTmp := TipEncoderUrl_Encode( AllTrim( hb_cStr( hb_HValueAt( xPostData, nI ) ) ) ) + cData += cTmp + cCrLf + NEXT + ELSEIF hb_isArray( xPostData ) + y := Len( xPostData ) + FOR nI := 1 TO y + cTmp := TipEncoderUrl_Encode( AllTrim( hb_cStr( xPostData[ nI, 1 ] ) ) ) + cData += cBound + cCrlf + 'Content-Disposition: form-data; name="' + cTmp + '"' + cCrlf + cCrLf + cTmp := TipEncoderUrl_Encode( AllTrim( hb_cStr( xPostData[ nI, 2 ] ) ) ) + cData += cTmp + cCrLf + NEXT + + ELSEIF hb_isString( xPostData ) + cData := xPostData + ENDIF + + FOR EACH oSub IN ::aAttachments + cName := oSub[ 1 ] + cFile := oSub[ 2 ] + cType := oSub[ 3 ] + cTmp := StrTran( cFile, "/", "\" ) + IF ( nPos := RAt( "\", cTmp ) ) != 0 + cFilePath := Left( cTmp, nPos ) + ELSEIF ( nPos := RAt( ":", cTmp ) ) != 0 + cFilePath := Left( cTmp, nPos ) ELSE cFilePath := "" ENDIF - cTmp:=substr(cFile,Len(cFilePath)+1) - IF empty(cType) - cType:="text/html" + 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 + 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) - nbuf:=8192 - nRead:=nBuf - //cBuf:=space(nBuf) - do while nRead == nBuf - //nRead := FRead( nFile,@cBuf,nBuf) - cBuf:=FReadstr( nFile,nBuf) - nRead:=len(cBuf) -/* IF nRead - * * www - http://www.harbour-project.org * * This program is free software; you can redistribute it and/or modify @@ -61,6 +60,7 @@ */ #include "hbclass.ch" + #include "common.ch" CREATE CLASS TipMail @@ -106,7 +106,9 @@ CREATE CLASS TipMail METHOD attachFile( cFileName ) METHOD detachFile( cPath ) METHOD getFileName() -HIDDEN: + + HIDDEN: + VAR cBody VAR lBodyEncoded init .F. VAR oEncoder @@ -118,7 +120,7 @@ ENDCLASS METHOD New( cBody, oEncoder ) CLASS TipMail // Set header fileds to non-sensitive - ::hHeaders := hb_HSetCaseMatch( {=>}, .F. ) + ::hHeaders := hb_HSetCaseMatch( { => }, .F. ) ::aAttachments := {} IF Valtype( oEncoder ) $ "CO" @@ -132,22 +134,19 @@ METHOD New( cBody, oEncoder ) CLASS TipMail ELSE ::cBody := cBody ENDIF - ::hHeaders[ "Content-Length" ] := Ltrim( Str( Len( ::cBody ) ) ) + ::hHeaders[ "Content-Length" ] := hb_ntos( Len( ::cBody ) ) ENDIF -RETURN Self - + RETURN Self METHOD SetEncoder( cEnc ) CLASS TipMail - if HB_IsString( cEnc ) + if hb_isString( cEnc ) ::oEncoder := TIp_GetEncoder( cEnc ) ELSE ::oEncoder := cEnc ENDIF ::hHeaders[ "Content-transfer-encoding" ] := ::oEncoder:cName -RETURN .T. - - + RETURN .T. METHOD SetBody( cBody ) CLASS TipMail IF ::oEncoder != NIL @@ -156,9 +155,8 @@ METHOD SetBody( cBody ) CLASS TipMail ELSE ::cBody := cBody ENDIF - //::hHeaders[ "Content-Length" ] := Ltrim( Str( Len( cBody ) ) ) //GD -not needed -RETURN .T. - + //::hHeaders[ "Content-Length" ] := hb_ntos( Len( cBody ) ) //GD -not needed + RETURN .T. METHOD GetBody() CLASS TipMail IF ::cBody == NIL @@ -166,8 +164,7 @@ METHOD GetBody() CLASS TipMail ELSEIF ::oEncoder != NIL RETURN ::oEncoder:Decode( ::cBody ) ENDIF -RETURN ::cBody - + RETURN ::cBody METHOD GetFieldPart( cPart ) CLASS TipMail LOCAL nPos, cEnc @@ -179,12 +176,11 @@ METHOD GetFieldPart( cPart ) CLASS TipMail cEnc := hb_HValueAt( ::hHeaders, nPos ) nPos := At( ";", cEnc ) IF nPos != 0 - cEnc := Substr( cEnc, 1, nPos - 1) + cEnc := SubStr( cEnc, 1, nPos - 1) ENDIF ENDIF -RETURN cEnc - + RETURN cEnc METHOD GetFieldOption( cPart, cOption ) CLASS TipMail LOCAL nPos, aMatch @@ -196,15 +192,15 @@ METHOD GetFieldOption( cPart, cOption ) CLASS TipMail ELSE cEnc := hb_HValueAt( ::hHeaders, nPos ) // Case insensitive check - aMatch := HB_Regex( ";\s*" + cOption +"\s*=\s*([^;]*)", cEnc, .F. ) + aMatch := hb_regex( ";\s*" + cOption + "\s*=\s*([^;]*)", cEnc, .F. ) IF aMatch != NIL - cEnc := aMatch[2] + cEnc := aMatch[ 2 ] ELSE RETURN "" ENDIF ENDIF -RETURN cEnc + RETURN cEnc METHOD SetFieldPart( cPart, cValue ) CLASS TipMail LOCAL nPos, cEnc @@ -218,12 +214,11 @@ METHOD SetFieldPart( cPart, cValue ) CLASS TipMail IF nPos == 0 ::hHeaders[ cPart ] := cValue ELSE - ::hHeaders[ cPart ] := cValue + Substr( cEnc, nPos ) + ::hHeaders[ cPart ] := cValue + SubStr( cEnc, nPos ) ENDIF ENDIF -RETURN .T. - + RETURN .T. METHOD SetFieldOption( cPart, cOption, cValue ) CLASS TipMail LOCAL nPos, aMatch @@ -234,45 +229,40 @@ METHOD SetFieldOption( cPart, cOption, cValue ) CLASS TipMail Return .F. ELSE cEnc := hb_HValueAt( ::hHeaders, nPos ) - aMatch := HB_Regex( "(.*?;\s*)" + cOption +"\s*=[^;]*(.*)?", cEnc, .F. ) + aMatch := hb_regex( "(.*?;\s*)" + cOption + "\s*=[^;]*(.*)?", cEnc, .F. ) IF Empty( aMatch ) ::hHeaders[ cPart ] := cEnc += "; "+ cOption + '="' + cValue + '"' ELSE - ::hHeaders[ cPart ] := aMatch[2] + cOption + '="' +; - cValue + '"' + aMatch[3] + ::hHeaders[ cPart ] := aMatch[ 2 ] + cOption + '="' +; + cValue + '"' + aMatch[ 3 ] ENDIF ENDIF -RETURN .T. - + 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 + IF At( "multipart/", Lower( ::GetFieldPart( "Content-Type" ) ) ) == 0 ::hHeaders[ "Content-Type" ] := "multipart/mixed" ENDIF AAdd( ::aAttachments, oSubPart ) RETURN .T. - ELSE - Alert( "TipMail:Attach() must be called with another TipMail object" ) ENDIF -RETURN .F. - + RETURN .F. METHOD NextAttachment() CLASS TipMail IF ::nAttachPos > Len( ::aAttachments ) RETURN NIL ELSE - ::nAttachPos ++ + ::nAttachPos++ ENDIF -RETURN ::aAttachments[ ::nAttachPos - 1 ] - + RETURN ::aAttachments[ ::nAttachPos - 1 ] METHOD GetAttachment() CLASS TipMail @@ -280,20 +270,20 @@ METHOD GetAttachment() CLASS TipMail RETURN NIL ENDIF -RETURN ::aAttachments[ ::nAttachPos ] - + RETURN ::aAttachments[ ::nAttachPos ] METHOD ToString() CLASS TipMail LOCAL cBoundary, cElem, i LOCAL cRet := "" + // this is a multipart message; we need a boundary - IF Len( ::aAttachments ) > 0 - ::hHeaders[ "Mime-Version" ] :="1.0" - endif + IF Len( ::aAttachments ) > 0 + ::hHeaders[ "Mime-Version" ] := "1.0" + ENDIF IF Len( ::aAttachments ) > 0 //Reset failing content type - IF At( "multipart/", Lower( ::GetFieldPart("Content-Type")) ) == 0 + IF At( "multipart/", Lower( ::GetFieldPart( "Content-Type" ) ) ) == 0 ::hHeaders[ "Content-Type" ] := "multipart/mixed" ENDIF @@ -336,7 +326,7 @@ METHOD ToString() CLASS TipMail ENDIF FOR i := 1 TO Len( ::hHeaders ) - cElem := Lower(hb_HKeyAt( ::hHeaders, i )) + cElem := Lower( hb_HKeyAt( ::hHeaders, i ) ) IF !( cElem == "return-path" ) .AND.; !( cElem == "delivered-to" ) .AND.; !( cElem == "date" ) .AND.; @@ -354,31 +344,29 @@ METHOD ToString() CLASS TipMail //Body IF ! Empty( ::cBody ) - IF empty(::aAttachments) - //cRet += ::cBody +iif(lAttachment,"", e"\r\n") - cRet += ::cBody + iif(::lBodyEncoded,"", e"\r\n") - else + IF Empty( ::aAttachments ) + //cRet += ::cBody + iif( lAttachment, "", e"\r\n" ) + cRet += ::cBody + iif( ::lBodyEncoded, "", e"\r\n" ) + ELSE //GD - if there are attachements the body of the message has to be treated as an attachment. cRet += "--" + cBoundary + e"\r\n" - cRet+= "Content-Type: text/plain; charset=ISO-8859-1; format=flowed"+ e"\r\n" - cRet+= "Content-Transfer-Encoding: 7bit"+ e"\r\n" - cRet+= "Content-Disposition: inline"+ e"\r\n"+ e"\r\n" - cRet += ::cBody+ e"\r\n" + cRet += "Content-Type: text/plain; charset=ISO-8859-1; format=flowed" + e"\r\n" + cRet += "Content-Transfer-Encoding: 7bit" + e"\r\n" + cRet += "Content-Disposition: inline" + e"\r\n"+ e"\r\n" + cRet += ::cBody + e"\r\n" ENDIF - ENDIF IF ! Empty( ::aAttachments ) - //Eventually go with mime multipart - FOR i := 1 TO Len(::aAttachments ) + // Eventually go with mime multipart + FOR i := 1 TO Len( ::aAttachments ) cRet += "--" + cBoundary + e"\r\n" - cRet += ::aAttachments[i]:ToString() + cRet += ::aAttachments[ i ]:ToString() NEXT cRet += "--" + cBoundary + "--" + e"\r\n" ENDIF -RETURN cRet - + RETURN cRet METHOD FromString( cMail, cBoundary, nPos ) CLASS TipMail LOCAL oSubSection, cSubBoundary @@ -390,7 +378,7 @@ METHOD FromString( cMail, cBoundary, nPos ) CLASS TipMail ENDIF IF Len( ::hHeaders ) > 0 - ::hHeaders := hb_HSetCaseMatch( {=>} , .F. ) + ::hHeaders := hb_HSetCaseMatch( { => }, .F. ) ENDIF IF Len( ::aReceived ) > 0 @@ -398,27 +386,24 @@ METHOD FromString( cMail, cBoundary, nPos ) CLASS TipMail ENDIF // Part 1: parsing header - IF nPos == NIL - nPos := 1 - ENDIF + DEFAULT nPos TO 1 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" ); + 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 + cValue := LTrim( SubStr( cMail, nPos, nLinePos - nPos ) ) + IF Lower( cLastField ) == "received" + ::aReceived[ Len( ::aReceived ) ] += " " + cValue ELSE ::hHeaders[ cLastField ] += " " +cValue ENDIF - ELSE nSplitPos := hb_At( ":", cMail, nPos ) - cLastField := Substr( cMail, nPos, nSplitPos - nPos) - cValue := Ltrim(Substr( cMail, nSplitPos +1, nLinePos - nSplitPos -1)) - IF Lower(cLastField) == "received" + cLastField := SubStr( cMail, nPos, nSplitPos - nPos ) + cValue := LTrim( SubStr( cMail, nSplitPos + 1, nLinePos - nSplitPos - 1 ) ) + IF Lower( cLastField ) == "received" AAdd( ::aReceived, cValue ) ELSE ::hHeaders[ cLastField ] := cValue @@ -443,11 +428,11 @@ METHOD FromString( cMail, cBoundary, nPos ) CLASS TipMail ENDIF // se if we have subparts: - IF At( "multipart/", Lower( ::GetFieldPart("Content-Type")) ) > 0 + IF At( "multipart/", Lower( ::GetFieldPart( "Content-Type" ) ) ) > 0 cSubBoundary := ::GetFieldOption( "Content-Type", "Boundary" ) - //strip " on boundary + // strip " on boundary IF Left( cSubBoundary, 1 ) == '"' - cSubBoundary := Substr( cSubBoundary, 2, Len( cSubBoundary ) - 2) + cSubBoundary := SubStr( cSubBoundary, 2, Len( cSubBoundary ) - 2 ) ENDIF ENDIF @@ -463,23 +448,23 @@ METHOD FromString( cMail, cBoundary, nPos ) CLASS TipMail LOOP ENDIF - //have we met the boundary? - IF cBoundary != NIL .AND. hb_At( "--"+cBoundary, cMail, nPos ) == nPos + // have we met the boundary? + IF cBoundary != NIL .AND. hb_At( "--" + cBoundary, cMail, nPos ) == nPos EXIT ENDIF - //Have we met a section? + // Have we met a section? IF cSubBoundary != NIL .AND.; hb_At( "--" + cSubBoundary, cMail, nPos ) == nPos - //is it the last subsection? - IF hb_At( "--", cMail, nPos + Len(cSubBoundary)+2, nLinePos) > 0 + // is it the last subsection? + IF hb_At( "--", cMail, nPos + Len( cSubBoundary ) + 2, nLinePos ) > 0 EXIT ENDIF // set our body IF nBodyPos > 0 - ::cBody := Substr( cMail, nBodyPos, nPos - nBodyPos ) + ::cBody := SubStr( cMail, nBodyPos, nPos - nBodyPos ) nBodyPos := 0 ENDIF @@ -497,12 +482,12 @@ METHOD FromString( cMail, cBoundary, nPos ) CLASS TipMail // enter in this part of the loop again. ELSE - //nPos := nLinePos + 2 + // nPos := nLinePos + 2 /* 04/05/2004 - Instead of testing every single line of mail until we find next boundary, if there is a boundary we jump to it immediatly, this saves thousands of EOL test and makes splitting of a string fast */ - nPos := iif( ! Empty(cSubBoundary), hb_At("--" + cSubBoundary, cMail, nPos ), iif( ! Empty(cBoundary), hb_At("--" + cBoundary, cMail, nPos ), nLinePos + 2 )) + nPos := iif( ! Empty( cSubBoundary ), hb_At("--" + cSubBoundary, cMail, nPos ), iif( ! Empty( cBoundary ), hb_At( "--" + cBoundary, cMail, nPos ), nLinePos + 2 ) ) ENDIF nLinePos := hb_At( e"\r\n", cMail, nPos ) @@ -510,27 +495,23 @@ METHOD FromString( cMail, cBoundary, nPos ) CLASS TipMail // set our body if needed IF nBodyPos > 0 - ::cBody := Substr( cMail, nBodyPos, nPos - nBodyPos ) + ::cBody := SubStr( cMail, nBodyPos, nPos - nBodyPos ) ENDIF - -RETURN nPos - + RETURN nPos METHOD MakeBoundary() CLASS TipMail - LOCAL cBound := "=_0" + Space(17) + LOCAL cBound := "=_0" + Space( 17 ) LOCAL i FOR i := 4 TO 20 - cBound := Stuff( cBound, i, 1, Chr( HB_Random(0, 25 ) + Asc("A") ) ) + cBound := Stuff( cBound, i, 1, Chr( hb_Random( 0, 25 ) + Asc( "A" ) ) ) NEXT - cBound += "_TIP_" + StrTran(Dtoc( Date() ),"/","") +; - "_" + StrTran(Time(), ":", "" ) - -RETURN cBound - + cBound += "_TIP_" + DToS( Date() ) +; + "_" + StrTran(Time(), ":" ) + RETURN cBound METHOD setHeader( cSubject, cFrom, cTo, cCC, cBCC ) CLASS TipMail LOCAL aTo, aCC, aBCC, i, imax @@ -569,14 +550,14 @@ METHOD setHeader( cSubject, cFrom, cTo, cCC, cBCC ) CLASS TipMail RETURN .F. ENDIF - IF ! ::setFieldPart( "From" , cFrom ) + IF ! ::setFieldPart( "From", cFrom ) RETURN .F. ENDIF - cTo := aTO[1] + cTo := aTO[ 1 ] imax := Len( aTO ) - FOR i:=2 TO imax - cTo += "," + HB_InetCrlf() + Chr(9) + aTo[i] + FOR i := 2 TO imax + cTo += "," + hb_inetCrlf() + Chr( 9 ) + aTo[ i ] NEXT IF ! ::setFieldPart( "To", cTo ) @@ -584,10 +565,10 @@ METHOD setHeader( cSubject, cFrom, cTo, cCC, cBCC ) CLASS TipMail ENDIF IF aCC != NIL - cCC := aCC[1] + cCC := aCC[ 1 ] imax := Len( aCC ) - FOR i:=2 TO imax - cCC += "," + HB_InetCrlf() + Chr(9) + aCC[i] + FOR i := 2 TO imax + cCC += "," + hb_inetCrlf() + Chr( 9 ) + aCC[ i ] NEXT IF ! ::setFieldPart( "Cc", cCC ) @@ -596,10 +577,10 @@ METHOD setHeader( cSubject, cFrom, cTo, cCC, cBCC ) CLASS TipMail ENDIF IF aBCC != NIL - cBCC := aBCC[1] + cBCC := aBCC[ 1 ] imax := Len( aBCC ) - FOR i:=2 TO imax - cBCC += "," + HB_InetCrlf() + Chr(9) + aBCC[i] + FOR i := 2 TO imax + cBCC += "," + hb_inetCrlf() + Chr( 9 ) + aBCC[ i ] NEXT IF ! ::setFieldPart( "Bcc", cBCC ) @@ -607,13 +588,12 @@ METHOD setHeader( cSubject, cFrom, cTo, cCC, cBCC ) CLASS TipMail ENDIF ENDIF -RETURN .T. - + RETURN .T. METHOD attachFile( cFileName ) CLASS TipMail - LOCAL cContent := MemoRead( cFileName ) - LOCAL cMimeType:= TIP_FileMimetype( cFileName ) - LOCAL cDelim := HB_OsPathSeparator() + LOCAL cContent := hb_MemoRead( cFileName ) + LOCAL cMimeType := TIP_FileMimetype( cFileName ) + LOCAL cDelim := hb_osPathSeparator() LOCAL oAttach @@ -622,21 +602,20 @@ METHOD attachFile( cFileName ) CLASS TipMail ENDIF oAttach := TIPMail():new( cContent, "base64" ) - cFileName := SubStr( cFileName, Rat( cFileName, cDelim ) + 1 ) + cFileName := SubStr( cFileName, RAt( cFileName, cDelim ) + 1 ) - oAttach:setFieldPart ( "Content-Type", cMimeType ) + oAttach:setFieldPart( "Content-Type", cMimeType ) oAttach:setFieldOption( "Content-Type", "name", cFileName ) - oAttach:setFieldPart ( "Content-Disposition", "attachment" ) + oAttach:setFieldPart( "Content-Disposition", "attachment" ) oAttach:setFieldOption( "Content-Disposition", "filename", cFileName ) -RETURN ::attach( oAttach ) - + RETURN ::attach( oAttach ) METHOD detachFile( cPath ) CLASS TipMail - LOCAL cContent := ::getBody() + LOCAL cContent := ::getBody() LOCAL cFileName := ::getFileName() - LOCAL cDelim := HB_OsPathSeparator() + LOCAL cDelim := hb_osPathSeparator() LOCAL nFileHandle IF Empty( cFileName ) @@ -644,7 +623,7 @@ METHOD detachFile( cPath ) CLASS TipMail ENDIF IF ISCHARACTER( cPath ) - cFileName := StrTran( cPath + cDelim + cFileName, cDelim+cDelim, cDelim ) + cFileName := StrTran( cPath + cDelim + cFileName, cDelim + cDelim, cDelim ) ENDIF nFileHandle := FCreate( cFileName ) @@ -653,27 +632,22 @@ METHOD detachFile( cPath ) CLASS TipMail ENDIF FWrite( nFileHandle, cContent ) - FClose( nFileHandle ) -RETURN FError() == 0 + RETURN FError() == 0 METHOD getFileName() CLASS TipMail -RETURN StrTran( ::getFieldOption( "Content-Type", "name" ), '"', "" ) - + RETURN StrTran( ::getFieldOption( "Content-Type", "name" ), '"' ) METHOD isMultiPart CLASS TipMail -RETURN "multipart/" $ Lower( ::GetFieldPart("Content-Type") ) - + RETURN "multipart/" $ Lower( ::GetFieldPart("Content-Type") ) METHOD getMultiParts( aParts ) CLASS TipMail LOCAL oSubPart, lReset := .F. ::resetAttachment() - IF aParts == NIL - aParts := {} - ENDIF + DEFAULT aParts TO {} DO WHILE ( oSubPart := ::nextAttachment() ) != NIL lReset := .T. @@ -686,4 +660,5 @@ METHOD getMultiParts( aParts ) CLASS TipMail IF lReset ::resetAttachment() ENDIF -RETURN aParts + + RETURN aParts diff --git a/harbour/contrib/hbtip/popcln.prg b/harbour/contrib/hbtip/popcln.prg index f5a410d3e8..5005b88537 100644 --- a/harbour/contrib/hbtip/popcln.prg +++ b/harbour/contrib/hbtip/popcln.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 @@ -86,26 +85,26 @@ ENDCLASS METHOD New( oUrl, lTrace, oCredentials ) CLASS tIPClientPOP - LOCAL cFile :="pop3" - LOCAL n := 0 + LOCAL n + ::super:New( oUrl, lTrace, oCredentials ) ::nDefaultPort := 110 ::nConnTimeout := 10000 - if ::ltrace - if !hb_FileExists("pop3.log") - ::nHandle := FCreate("pop3.log") - else - while hb_FileExists(cFile+hb_NToS(n)+".log") - n++ - enddo - ::nHandle := FCreate(cFile+hb_NToS(n)+".log") - endif - endif - -RETURN Self + IF ::lTrace + IF ! hb_FileExists( "pop3.log" ) + ::nHandle := FCreate( "pop3.log" ) + ELSE + n := 0 + DO WHILE hb_FileExists( "pop3" + hb_ntos( n ) + ".log" ) + n++ + ENDDO + ::nHandle := FCreate( "pop3" + hb_ntos( n ) + ".log" ) + ENDIF + ENDIF + RETURN Self METHOD Open( cUrl ) CLASS tIPClientPOP IF ! ::super:Open( cUrl ) @@ -116,7 +115,7 @@ METHOD Open( cUrl ) CLASS tIPClientPOP RETURN .F. ENDIF - HB_InetTimeout( ::SocketCon, ::nConnTimeout ) + hb_inetTimeout( ::SocketCon, ::nConnTimeout ) IF ::GetOk() ::InetSendall( ::SocketCon, "USER " + ::oUrl:cUserid + ::cCRLF ) IF ::GetOK() @@ -127,44 +126,41 @@ METHOD Open( cUrl ) CLASS tIPClientPOP ENDIF ENDIF ENDIF -RETURN .F. - + RETURN .F. 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. !( Left( ::cReply, 1 ) == "+" ) RETURN .F. ENDIF -RETURN .T. - + RETURN .T. METHOD Noop() CLASS tIPClientPOP ::InetSendall( ::SocketCon, "NOOP" + ::cCRLF ) -RETURN ::GetOk() - + RETURN ::GetOk() METHOD Close() CLASS tIPClientPOP - HB_InetTimeOut( ::SocketCon, ::nConnTimeout ) - if ::ltrace - fClose(::nHandle) - endif + + hb_inetTimeOut( ::SocketCon, ::nConnTimeout ) + + IF ::lTrace + FClose( ::nHandle ) + ENDIF ::Quit() -RETURN ::super:Close() + RETURN ::super:Close() METHOD Quit() CLASS tIPClientPOP ::InetSendall( ::SocketCon, "QUIT" + ::cCRLF ) -RETURN ::GetOk() - + RETURN ::GetOk() METHOD Stat() CLASS tIPClientPOP LOCAL nRead ::InetSendall( ::SocketCon, "STAT" + ::cCRLF ) -RETURN ::InetRecvLine( ::SocketCon, @nRead, 128) - + RETURN ::InetRecvLine( ::SocketCon, @nRead, 128) METHOD Read( nLen ) CLASS tIPClientPOP /** Set what to read for */ @@ -172,23 +168,21 @@ METHOD Read( nLen ) CLASS tIPClientPOP RETURN ::List() ENDIF - IF Val (::oUrl:cFile ) < 0 - IF ::Delete( - Val (::oUrl:cFile ) ) + IF Val( ::oUrl:cFile ) < 0 + IF ::Delete( - Val( ::oUrl:cFile ) ) RETURN ::Quit() ELSE RETURN .F. ENDIF ENDIF -RETURN ::Retrieve( Val (::oUrl:cFile ), nLen ) - - + RETURN ::Retrieve( Val( ::oUrl:cFile ), nLen ) METHOD Top( nMsgId ) CLASS tIPClientPOP LOCAL nPos LOCAL cStr, cRet - ::InetSendall( ::SocketCon, "TOP " + Str( nMsgId ) + " 0 " + ::cCRLF ) + ::InetSendall( ::SocketCon, "TOP " + hb_ntos( nMsgId ) + " 0 " + ::cCRLF ) IF ! ::GetOk() RETURN NIL ENDIF @@ -201,16 +195,13 @@ METHOD Top( nMsgId ) CLASS tIPClientPOP ELSE ::bEof := .T. ENDIF - ENDDO IF ::InetErrorCode( ::SocketCon ) != 0 RETURN NIL ENDIF -RETURN cRet - - + RETURN cRet METHOD List() CLASS tIPClientPOP LOCAL nPos @@ -236,9 +227,7 @@ METHOD List() CLASS tIPClientPOP RETURN NIL ENDIF -RETURN cRet - - + RETURN cRet METHOD UIDL( nMsgId ) CLASS tIPClientPOP @@ -246,7 +235,7 @@ METHOD UIDL( nMsgId ) CLASS tIPClientPOP LOCAL cStr, cRet IF ! Empty( nMsgId ) - ::InetSendall( ::SocketCon, "UIDL " + Str( nMsgId ) + ::cCRLF ) + ::InetSendall( ::SocketCon, "UIDL " + hb_ntos( nMsgId ) + ::cCRLF ) ELSE ::InetSendall( ::SocketCon, "UIDL" + ::cCRLF ) ENDIF @@ -256,12 +245,9 @@ METHOD UIDL( nMsgId ) CLASS tIPClientPOP ENDIF IF ! Empty( nMsgId ) - // +OK Space(1) nMsg Space(1) UID - RETURN SubStr(::cReply, Rat(Space(1), ::cReply) + 1) - + RETURN SubStr( ::cReply, RAt( Space( 1 ), ::cReply ) + 1 ) ELSE - cRet := "" DO WHILE !( cStr == "." ) .AND. ::InetErrorCode( ::SocketCon ) == 0 cStr := ::InetRecvLine( ::SocketCon, @nPos, 256 ) @@ -270,18 +256,14 @@ METHOD UIDL( nMsgId ) CLASS tIPClientPOP ELSE ::bEof := .T. ENDIF - ENDDO - ENDIF IF ::InetErrorCode( ::SocketCon ) != 0 RETURN NIL ENDIF -RETURN cRet - - + RETURN cRet METHOD Retrieve( nId, nLen ) CLASS tIPClientPOP @@ -290,7 +272,7 @@ METHOD Retrieve( nId, nLen ) CLASS tIPClientPOP LOCAL cEOM := ::cCRLF + "." + ::cCRLF // End Of Mail IF ! ::bInitialized - ::InetSendall( ::SocketCon, "RETR "+ Str( nId ) + ::cCRLF ) + ::InetSendall( ::SocketCon, "RETR " + hb_ntos( nId ) + ::cCRLF ) IF ! ::GetOk() ::bEof := .T. RETURN NIL @@ -306,7 +288,7 @@ METHOD Retrieve( nId, nLen ) CLASS tIPClientPOP */ DO WHILE ::InetErrorCode( ::SocketCon ) == 0 .AND. ! ::bEof - cBuffer := Space(1024) + cBuffer := Space( 1024 ) nRead := ::InetRecv( ::SocketCon, @cBuffer, 1024 ) @@ -324,12 +306,9 @@ METHOD Retrieve( nId, nLen ) CLASS tIPClientPOP ELSEIF ! Empty( nLen ) .AND. nLen < Len( cRet ) EXIT - ELSE nRetLen += nRead - ENDIF - ENDDO IF ::InetErrorCode( ::SocketCon ) != 0 @@ -337,25 +316,21 @@ METHOD Retrieve( nId, nLen ) CLASS tIPClientPOP ENDIF // Remove byte-stuffed termination octet(s) if any -RETURN StrTran( cRet, ::cCRLF + "..", ::cCRLF + "." ) - - + RETURN StrTran( cRet, ::cCRLF + "..", ::cCRLF + "." ) METHOD Delete( nId ) CLASS tIPClientPOP - ::InetSendall( ::SocketCon, "DELE " + AllTrim( Str( nId ) ) + ::cCRLF ) -RETURN ::GetOk() - - + ::InetSendall( ::SocketCon, "DELE " + hb_ntos( nId ) + ::cCRLF ) + RETURN ::GetOk() METHOD countMail CLASS TIpClientPop LOCAL aMails IF ::isOpen ::reset() - aMails := HB_ATokens( StrTran( ::list(), Chr(13),""), Chr(10) ) + aMails := hb_ATokens( StrTran( ::list(), Chr( 13 ) ), Chr( 10 ) ) RETURN Len( aMails ) ENDIF -RETURN -1 + RETURN -1 METHOD retrieveAll( lDelete ) LOCAL aMails, i, imax, cMail @@ -371,16 +346,16 @@ METHOD retrieveAll( lDelete ) imax := ::countMail() aMails := Array( imax ) - FOR i:=1 TO imax + FOR i := 1 TO imax ::reset() cMail := ::retrieve( i ) - aMails[i] := TIpMail():new() - aMails[i]:fromString( cMail ) + aMails[ i ] := TIpMail():new() + aMails[ i ]:fromString( cMail ) IF lDelete ::reset() - ::delete(i) + ::delete( i ) ENDIF NEXT -RETURN aMails + RETURN aMails diff --git a/harbour/contrib/hbtip/sendmail.prg b/harbour/contrib/hbtip/sendmail.prg index 119bafc1ce..173e4fec42 100644 --- a/harbour/contrib/hbtip/sendmail.prg +++ b/harbour/contrib/hbtip/sendmail.prg @@ -4,11 +4,9 @@ /* * xHarbour Project source code: - * HB_SendMail() - * ( This version of HB_SendMail() started from Luiz's original work on SendMail() ) + * hb_SendMail() (This version of hb_SendMail() started from Luiz's original work on SendMail()) * * Copyright 2007 Luiz Rafael Culik Guimaraes & Patrick Mast - * * www - http://www.xharbour.org * * This program is free software; you can redistribute it and/or modify @@ -54,9 +52,9 @@ #include "common.ch" -#translate ( LIKE ) => ( HB_REGEXLIKE( (), () ) ) +#translate ( LIKE ) => ( hb_regexLike( (), () ) ) -FUNCTION HB_SendMail( cServer, nPort, cFrom, aTo, aCC, aBCC, cBody, cSubject, aFiles, cUser, cPass, cPopServer, nPriority, lRead, lTrace, lPopAuth, lNoAuth, nTimeOut, cReplyTo ) +FUNCTION hb_SendMail( cServer, nPort, cFrom, aTo, aCC, aBCC, cBody, cSubject, aFiles, cUser, cPass, cPopServer, nPriority, lRead, lTrace, lPopAuth, lNoAuth, nTimeOut, cReplyTo ) /* cServer -> Required. IP or domain name of the mail server nPort -> Optional. Port used my email server @@ -132,10 +130,10 @@ FUNCTION HB_SendMail( cServer, nPort, cFrom, aTo, aCC, aBCC, cBody, cSubject, aF cUser := StrTran( cUser, "@", "&at;" ) - IF !( (".htm" $ Lower( cBody ) .OR. ".html" $ Lower( cBody ) ) .AND. hb_FileExists(cBody) ) + IF !( ( ".htm" $ Lower( cBody ) .OR. ".html" $ Lower( cBody ) ) .AND. hb_FileExists( cBody ) ) - IF !( Right( cBody, 2 ) == HB_OSNewLine() ) - cBody += HB_OsNewLine() + IF !( Right( cBody, 2 ) == hb_osNewLine() ) + cBody += hb_osNewLine() ENDIF ENDIF @@ -145,7 +143,7 @@ FUNCTION HB_SendMail( cServer, nPort, cFrom, aTo, aCC, aBCC, cBody, cSubject, aF IF Len( aTo ) > 1 FOR EACH cTo IN aTo IF cTo:__enumIndex() != 1 - IF !Empty( cTo ) + IF ! Empty( cTo ) cTmp += cTo + "," ENDIF ENDIF @@ -165,35 +163,35 @@ FUNCTION HB_SendMail( cServer, nPort, cFrom, aTo, aCC, aBCC, cBody, cSubject, aF IF ISARRAY( aCC ) IF Len( aCC ) > 0 FOR EACH cTmp IN aCC - IF !Empty( cTmp ) + IF ! Empty( cTmp ) cCC += cTmp + "," ENDIF NEXT cCC := SubStr( cCC, 1, Len( cCC ) - 1 ) ENDIF - ELSEIF ISCHARACTER(aCC) + ELSEIF ISCHARACTER( aCC ) cCC := AllTrim( aCC ) ENDIF // BCC (Blind Carbon Copy) - IF ISARRAY(aBCC) - IF Len(aBCC) > 0 + IF ISARRAY( aBCC ) + IF Len( aBCC ) > 0 FOR EACH cTmp IN aBCC - IF !Empty( cTmp ) + IF ! Empty( cTmp ) cBCC += cTmp + "," ENDIF NEXT cBCC := SubStr( cBCC, 1, Len( cBCC ) - 1 ) ENDIF - ELSEIF ISCHARACTER(aBCC) + ELSEIF ISCHARACTER( aBCC ) cBCC := AllTrim( aBCC ) ENDIF IF cPopServer != NIL .AND. lPopAuth BEGIN SEQUENCE oUrl1 := tUrl():New( "pop://" + cUser + ":" + cPass + "@" + cPopServer + "/" ) - oUrl1:cUserid := Strtran( cUser, "&at;", "@" ) + oUrl1:cUserid := StrTran( cUser, "&at;", "@" ) opop:= tIPClientPOP():New( oUrl1, lTrace ) IF oPop:Open() oPop:Close() @@ -204,7 +202,7 @@ FUNCTION HB_SendMail( cServer, nPort, cFrom, aTo, aCC, aBCC, cBody, cSubject, aF ENDIF - IF !lReturn + IF ! lReturn RETURN .F. ENDIF @@ -214,18 +212,18 @@ FUNCTION HB_SendMail( cServer, nPort, cFrom, aTo, aCC, aBCC, cBody, cSubject, aF lReturn := .F. END SEQUENCE - IF !lReturn + IF ! lReturn RETURN .F. ENDIF oUrl:nPort := nPort - oUrl:cUserid := Strtran( cUser, "&at;", "@" ) + oUrl:cUserid := StrTran( cUser, "&at;", "@" ) oMail := tipMail():new() oAttach := tipMail():new() oAttach:SetEncoder( "7-bit" ) - IF (".htm" $ Lower( cBody ) .OR. ".html" $ Lower( cBody ) ) .AND. hb_FileExists(cBody) + IF ( ".htm" $ Lower( cBody ) .OR. ".html" $ Lower( cBody ) ) .AND. hb_FileExists( cBody ) cMimeText := "text/html ; charset=ISO-8859-1" oAttach:hHeaders[ "Content-Type" ] := cMimeText cBodyTemp := cBody @@ -237,34 +235,34 @@ FUNCTION HB_SendMail( cServer, nPort, cFrom, aTo, aCC, aBCC, cBody, cSubject, aF oAttach:SetBody( cBody ) oMail:Attach( oAttach ) - oUrl:cFile := cTo + iif( Empty(cCC), "", "," + cCC ) + iif( Empty(cBCC), "", "," + cBCC) + oUrl:cFile := cTo + iif( Empty( cCC ), "", "," + cCC ) + iif( Empty( cBCC ), "", "," + cBCC ) oMail:hHeaders[ "Date" ] := tip_Timestamp() oMail:hHeaders[ "From" ] := cFrom - IF !Empty(cCC) + IF ! Empty( cCC ) oMail:hHeaders[ "Cc" ] := cCC ENDIF - IF !Empty(cBCC) + IF ! Empty( cBCC ) oMail:hHeaders[ "Bcc" ] := cBCC ENDIF - IF !Empty(cReplyTo) + IF ! Empty( cReplyTo ) oMail:hHeaders[ "Reply-To" ] := cReplyTo ENDIF BEGIN SEQUENCE - oInmail := tIPClientSMTP():New( oUrl, lTrace) + oInmail := tIPClientSMTP():New( oUrl, lTrace ) RECOVER lReturn := .F. END SEQUENCE - IF !lReturn + IF ! lReturn RETURN .F. ENDIF - oInmail:nConnTimeout:= nTimeOut + oInmail:nConnTimeout := nTimeOut - IF !lNoAuth + IF ! lNoAuth IF oInMail:OpenSecure() @@ -280,14 +278,14 @@ FUNCTION HB_SendMail( cServer, nPort, cFrom, aTo, aCC, aBCC, cBody, cSubject, aF ENDDO IF lAuthLogin - IF !oInMail:Auth( cUser, cPass ) + IF ! oInMail:Auth( cUser, cPass ) lConnect := .F. ELSE lConnectPlain := .T. ENDIF ENDIF - IF lAuthPlain .AND. !lConnect + IF lAuthPlain .AND. ! lConnect IF !oInMail:AuthPlain( cUser, cPass ) lConnect := .F. ENDIF @@ -304,22 +302,21 @@ FUNCTION HB_SendMail( cServer, nPort, cFrom, aTo, aCC, aBCC, cBody, cSubject, aF lConnect := .F. ENDIF - IF !lConnect + IF ! lConnect - if !lNoAuth + IF ! lNoAuth oInMail:Close() - endif + ENDIF BEGIN SEQUENCE - oInmail := tIPClientsmtp():New( oUrl, lTrace) + oInmail := tIPClientsmtp():New( oUrl, lTrace ) RECOVER lReturn := .F. END SEQUENCE - oInmail:nConnTimeout:=nTimeOut + oInmail:nConnTimeout := nTimeOut - - IF !oInMail:Open() + IF ! oInMail:Open() oInmail:Close() RETURN .F. ENDIF @@ -334,17 +331,18 @@ FUNCTION HB_SendMail( cServer, nPort, cFrom, aTo, aCC, aBCC, cBody, cSubject, aF ENDIF oInMail:oUrl:cUserid := cFrom + oMail:hHeaders[ "To" ] := cTo oMail:hHeaders[ "Subject" ] := cSubject - FOR EACH aThisFile IN AFiles + FOR EACH aThisFile IN aFiles IF ISCHARACTER( aThisFile ) cFile := aThisFile - cData := Memoread( cFile ) + chr( 13 ) + chr( 10 ) + cData := Memoread( cFile ) + Chr( 13 ) + Chr( 10 ) ELSEIF ISARRAY( aThisFile ) .AND. Len( aThisFile ) >= 2 cFile := aThisFile[ 1 ] - cData := aThisFile[ 2 ] + chr( 13 ) + chr( 10 ) + cData := aThisFile[ 2 ] + Chr( 13 ) + Chr( 10 ) ELSE lReturn := .F. EXIT @@ -352,7 +350,7 @@ FUNCTION HB_SendMail( cServer, nPort, cFrom, aTo, aCC, aBCC, cBody, cSubject, aF oAttach := TipMail():New() - HB_FNameSplit( cFile,, @cFname, @cFext ) + hb_FNameSplit( cFile,, @cFname, @cFext ) cFile := Lower( cFile ) IF ( cFile LIKE ".+\.(vbd|asn|asz|asd|pqi|tsp|exe|sml|ofml)" ) .OR. ; @@ -386,10 +384,10 @@ FUNCTION HB_SendMail( cServer, nPort, cFrom, aTo, aCC, aBCC, cBody, cSubject, aF oAttach:SetEncoder( "7-bit" ) ENDIF - cMimeText := HB_SetMimeType( cFile, cFname, cFext ) + cMimeText := hb_SetMimeType( cFile, cFname, cFext ) // Some EMAIL readers use Content-Type to check for filename - IF ".html" $ lower( cFext) .OR. ".htm" $ lower( cFext ) + IF ".html" $ Lower( cFext ) .OR. ".htm" $ Lower( cFext ) cMimeText += "; charset=ISO-8859-1" ENDIF @@ -413,198 +411,198 @@ FUNCTION HB_SendMail( cServer, nPort, cFrom, aTo, aCC, aBCC, cBody, cSubject, aF oInMail:Commit() oInMail:Close() -RETURN lReturn - + RETURN lReturn //-------------------------------------------------------------// -FUNCTION HB_SetMimeType( cFile, cFname, cFext ) +FUNCTION hb_SetMimeType( cFile, cFname, cFext ) cFile := Lower( cFile ) - IF ( cFile LIKE ".+\.vbd" ); RETURN "application/activexdocument="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.(asn|asz|asd)" ); RETURN "application/astound="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.pqi" ); RETURN "application/cprplayer=" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.tsp" ); RETURN "application/dsptype="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.exe" ); RETURN "application/exe="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.(sml|ofml)" ); RETURN "application/fml="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.pfr" ); RETURN "application/font-tdpfr=" +cFname + cFext - ELSEIF ( cFile LIKE ".+\.frl" ); RETURN "application/freeloader=" +cFname + cFext - ELSEIF ( cFile LIKE ".+\.spl" ); RETURN "application/futuresplash =" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.gz" ); RETURN "application/gzip =" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.stk" ); RETURN "application/hstu =" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.ips" ); RETURN "application/ips="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.ptlk" ); RETURN "application/listenup =" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.hqx" ); RETURN "application/mac-binhex40 =" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.mbd" ); RETURN "application/mbedlet="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.mfp" ); RETURN "application/mirage=" +cFname + cFext - ELSEIF ( cFile LIKE ".+\.(pot|pps|ppt|ppz)" ); RETURN "application/mspowerpoint =" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.doc" ); RETURN "application/msword=" +cFname + cFext - ELSEIF ( cFile LIKE ".+\.n2p" ); RETURN "application/n2p="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.(bin|class|lha|lzh|lzx|dbf)" ); RETURN "application/octet-stream =" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.oda" ); RETURN "application/oda="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.axs" ); RETURN "application/olescript=" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.zpa" ); RETURN "application/pcphoto="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.pdf" ); RETURN "application/pdf="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.(ai|eps|ps)" ); RETURN "application/postscript=" +cFname + cFext - ELSEIF ( cFile LIKE ".+\.shw" ); RETURN "application/presentations=" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.qrt" ); RETURN "application/quest=" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.rtc" ); RETURN "application/rtc="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.rtf" ); RETURN "application/rtf="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.smp" ); RETURN "application/studiom="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.dst" ); RETURN "application/tajima=" +cFname + cFext - ELSEIF ( cFile LIKE ".+\.talk" ); RETURN "application/talker=" +cFname + cFext - ELSEIF ( cFile LIKE ".+\.tbk" ); RETURN "application/toolbook =" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.vmd" ); RETURN "application/vocaltec-media-desc="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.vmf" ); RETURN "application/vocaltec-media-file="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.wri" ); RETURN "application/write=" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.wid" ); RETURN "application/x-DemoShield =" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.rrf" ); RETURN "application/x-InstallFromTheWeb="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.wis" ); RETURN "application/x-InstallShield="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.ins" ); RETURN "application/x-NET-Install=" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.tmv" ); RETURN "application/x-Parable-Thing="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.arj" ); RETURN "application/x-arj=" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.asp" ); RETURN "application/x-asap=" +cFname + cFext - ELSEIF ( cFile LIKE ".+\.aab" ); RETURN "application/x-authorware-bin =" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.(aam|aas)" ); RETURN "application/x-authorware-map =" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.bcpio" ); RETURN "application/x-bcpio="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.vcd" ); RETURN "application/x-cdlink =" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.chat" ); RETURN "application/x-chat=" +cFname + cFext - ELSEIF ( cFile LIKE ".+\.cnc" ); RETURN "application/x-cnc=" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.(coda|page)" ); RETURN "application/x-coda=" +cFname + cFext - ELSEIF ( cFile LIKE ".+\.z" ); RETURN "application/x-compress=" +cFname + cFext - ELSEIF ( cFile LIKE ".+\.con" ); RETURN "application/x-connector="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.cpio" ); RETURN "application/x-cpio=" +cFname + cFext - ELSEIF ( cFile LIKE ".+\.pqf" ); RETURN "application/x-cprplayer="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.csh" ); RETURN "application/x-csh=" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.(cu|csm)" ); RETURN "application/x-cu-seeme=" +cFname + cFext - ELSEIF ( cFile LIKE ".+\.(dcr|dir|dxr|swa)" ); RETURN "application/x-director=" +cFname + cFext - ELSEIF ( cFile LIKE ".+\.dvi" ); RETURN "application/x-dvi=" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.evy" ); RETURN "application/x-envoy="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.ebk" ); RETURN "application/x-expandedbook=" +cFname + cFext - ELSEIF ( cFile LIKE ".+\.gtar" ); RETURN "application/x-gtar=" +cFname + cFext - ELSEIF ( cFile LIKE ".+\.hdf" ); RETURN "application/x-hdf=" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.map" ); RETURN "application/x-httpd-imap =" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.phtml" ); RETURN "application/x-httpd-php="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.php3" ); RETURN "application/x-httpd-php3 =" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.ica" ); RETURN "application/x-ica=" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.ipx" ); RETURN "application/x-ipix=" +cFname + cFext - ELSEIF ( cFile LIKE ".+\.ips" ); RETURN "application/x-ipscript=" +cFname + cFext - ELSEIF ( cFile LIKE ".+\.js" ); RETURN "application/x-javascript =" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.latex" ); RETURN "application/x-latex="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.bin" ); RETURN "application/x-macbinary="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.mif" ); RETURN "application/x-mif=" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.(mpl|mpire)" ); RETURN "application/x-mpire="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.adr" ); RETURN "application/x-msaddr =" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.wlt" ); RETURN "application/x-mswallet=" +cFname + cFext - ELSEIF ( cFile LIKE ".+\.(nc|cdf)" ); RETURN "application/x-netcdf =" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.npx" ); RETURN "application/x-netfpx =" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.nsc" ); RETURN "application/x-nschat =" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.pgp" ); RETURN "application/x-pgp-plugin =" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.css" ); RETURN "application/x-pointplus="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.sh" ); RETURN "application/x-sh =" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.shar" ); RETURN "application/x-shar=" +cFname + cFext - ELSEIF ( cFile LIKE ".+\.swf" ); RETURN "application/x-shockwave-flash=" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.spr" ); RETURN "application/x-sprite =" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.sprite" ); RETURN "application/x-sprite =" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.sit" ); RETURN "application/x-stuffit=" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.sca" ); RETURN "application/x-supercard="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.sv4cpio" ); RETURN "application/x-sv4cpio=" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.sv4crc" ); RETURN "application/x-sv4crc =" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.tar" ); RETURN "application/x-tar=" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.tcl" ); RETURN "application/x-tcl=" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.tex" ); RETURN "application/x-tex=" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.(texinfo|texi)" ); RETURN "application/x-texinfo=" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.tlk" ); RETURN "application/x-tlk=" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.(t|tr|roff)" ); RETURN "application/x-troff="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.man" ); RETURN "application/x-troff-man="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.me" ); RETURN "application/x-troff-me=" +cFname + cFext - ELSEIF ( cFile LIKE ".+\.ms" ); RETURN "application/x-troff-ms=" +cFname + cFext - ELSEIF ( cFile LIKE ".+\.alt" ); RETURN "application/x-up-alert=" +cFname + cFext - ELSEIF ( cFile LIKE ".+\.che" ); RETURN "application/x-up-cacheop =" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.ustar" ); RETURN "application/x-ustar="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.src" ); RETURN "application/x-wais-source=" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.xls" ); RETURN "application/xls="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.xlt" ); RETURN "application/xlt="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.zip" ); RETURN "application/zip="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.(au|snd)" ); RETURN "audio/basic="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.es" ); RETURN "audio/echospeech =" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.(gsm|gsd)" ); RETURN "audio/gsm=" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.rmf" ); RETURN "audio/rmf=" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.tsi" ); RETURN "audio/tsplayer=" +cFname + cFext - ELSEIF ( cFile LIKE ".+\.vox" ); RETURN "audio/voxware=" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.wtx" ); RETURN "audio/wtx=" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.(aif|aiff|aifc)" ); RETURN "audio/x-aiff =" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.(cht|dus)" ); RETURN "audio/x-dspeech="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.(mid|midi)" ); RETURN "audio/x-midi =" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.mp3" ); RETURN "audio/x-mpeg =" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.mp2" ); RETURN "audio/x-mpeg =" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.m3u" ); RETURN "audio/x-mpegurl="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.(ram|ra)" ); RETURN "audio/x-pn-realaudio =" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.rpm" ); RETURN "audio/x-pn-realaudio-plugin="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.stream" ); RETURN "audio/x-qt-stream=" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.rmf" ); RETURN "audio/x-rmf="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.(vqf|vql)" ); RETURN "audio/x-twinvq=" +cFname + cFext - ELSEIF ( cFile LIKE ".+\.vqe" ); RETURN "audio/x-twinvq-plugin=" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.wav" ); RETURN "audio/x-wav="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.wtx" ); RETURN "audio/x-wtx="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.mol" ); RETURN "chemical/x-mdl-molfile=" +cFname + cFext - ELSEIF ( cFile LIKE ".+\.pdb" ); RETURN "chemical/x-pdb=" +cFname + cFext - ELSEIF ( cFile LIKE ".+\.dwf" ); RETURN "drawing/x-dwf=" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.ivr" ); RETURN "i-world/i-vrml=" +cFname + cFext - ELSEIF ( cFile LIKE ".+\.cod" ); RETURN "image/cis-cod=" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.cpi" ); RETURN "image/cpi=" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.fif" ); RETURN "image/fif=" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.gif" ); RETURN "image/gif=" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.ief" ); RETURN "image/ief=" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.(jpeg|jpg|jpe)" ); RETURN "image/jpeg=" +cFname + cFext - ELSEIF ( cFile LIKE ".+\.rip" ); RETURN "image/rip=" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.svh" ); RETURN "image/svh=" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.(tiff|tif)" ); RETURN "image/tiff=" +cFname + cFext - ELSEIF ( cFile LIKE ".+\.mcf" ); RETURN "image/vasa=" +cFname + cFext - ELSEIF ( cFile LIKE ".+\.(svf|dwg|dxf)" ); RETURN "image/vnd=" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.wi" ); RETURN "image/wavelet=" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.ras" ); RETURN "image/x-cmu-raster=" +cFname + cFext - ELSEIF ( cFile LIKE ".+\.etf" ); RETURN "image/x-etf="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.fpx" ); RETURN "image/x-fpx="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.(fh5|fh4|fhc)" ); RETURN "image/x-freehand =" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.dsf" ); RETURN "image/x-mgx-dsf="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.pnm" ); RETURN "image/x-portable-anymap="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.pbm" ); RETURN "image/x-portable-bitmap="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.pgm" ); RETURN "image/x-portable-graymap =" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.ppm" ); RETURN "image/x-portable-pixmap="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.rgb" ); RETURN "image/x-rgb="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.xbm" ); RETURN "image/x-xbitmap="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.xpm" ); RETURN "image/x-xpixmap="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.xwd" ); RETURN "image/x-xwindowdump="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.dig" ); RETURN "multipart/mixed="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.push" ); RETURN "multipart/x-mixed-replace=" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.(wan|waf)" ); RETURN "plugin/wanimate="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.ccs" ); RETURN "text/ccs =" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.(htm|html)" ); RETURN "text/html=" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.pgr" ); RETURN "text/parsnegar-document="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.txt" ); RETURN "text/plain=" +cFname + cFext - ELSEIF ( cFile LIKE ".+\.rtx" ); RETURN "text/richtext=" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.tsv" ); RETURN "text/tab-separated-values=" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.hdml" ); RETURN "text/x-hdml="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.etx" ); RETURN "text/x-setext=" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.(talk|spc)" ); RETURN "text/x-speech=" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.afl" ); RETURN "video/animaflex="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.(mpeg|mpg|mpe)" ); RETURN "video/mpeg=" +cFname + cFext - ELSEIF ( cFile LIKE ".+\.(qt|mov)" ); RETURN "video/quicktime="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.(viv|vivo)" ); RETURN "video/vnd.vivo=" +cFname + cFext - ELSEIF ( cFile LIKE ".+\.(asf|asx)" ); RETURN "video/x-ms-asf=" +cFname + cFext - ELSEIF ( cFile LIKE ".+\.avi" ); RETURN "video/x-msvideo="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.movie" ); RETURN "video/x-sgi-movie=" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.(vgm|vgx|xdr)" ); RETURN "video/x-videogram=" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.vgp" ); RETURN "video/x-videogram-plugin =" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.vts" ); RETURN "workbook/formulaone="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.vtts" ); RETURN "workbook/formulaone="+cFname + cFext - ELSEIF ( cFile LIKE ".+\.(3dmf|3dm|qd3d|qd3)" ); RETURN "x-world/x-3dmf=" +cFname + cFext - ELSEIF ( cFile LIKE ".+\.svr" ); RETURN "x-world/x-svr=" + cFname + cFext - ELSEIF ( cFile LIKE ".+\.(wrl|wrz)" ); RETURN "x-world/x-vrml=" +cFname + cFext - ELSEIF ( cFile LIKE ".+\.vrt" ); RETURN "x-world/x-vrt=" + cFname + cFext - ENDIF + DO CASE + CASE ( cFile LIKE ".+\.vbd" ); RETURN "application/activexdocument="+cFname + cFext + CASE ( cFile LIKE ".+\.(asn|asz|asd)" ); RETURN "application/astound="+cFname + cFext + CASE ( cFile LIKE ".+\.pqi" ); RETURN "application/cprplayer=" + cFname + cFext + CASE ( cFile LIKE ".+\.tsp" ); RETURN "application/dsptype="+cFname + cFext + CASE ( cFile LIKE ".+\.exe" ); RETURN "application/exe="+cFname + cFext + CASE ( cFile LIKE ".+\.(sml|ofml)" ); RETURN "application/fml="+cFname + cFext + CASE ( cFile LIKE ".+\.pfr" ); RETURN "application/font-tdpfr=" +cFname + cFext + CASE ( cFile LIKE ".+\.frl" ); RETURN "application/freeloader=" +cFname + cFext + CASE ( cFile LIKE ".+\.spl" ); RETURN "application/futuresplash =" + cFname + cFext + CASE ( cFile LIKE ".+\.gz" ); RETURN "application/gzip =" + cFname + cFext + CASE ( cFile LIKE ".+\.stk" ); RETURN "application/hstu =" + cFname + cFext + CASE ( cFile LIKE ".+\.ips" ); RETURN "application/ips="+cFname + cFext + CASE ( cFile LIKE ".+\.ptlk" ); RETURN "application/listenup =" + cFname + cFext + CASE ( cFile LIKE ".+\.hqx" ); RETURN "application/mac-binhex40 =" + cFname + cFext + CASE ( cFile LIKE ".+\.mbd" ); RETURN "application/mbedlet="+cFname + cFext + CASE ( cFile LIKE ".+\.mfp" ); RETURN "application/mirage=" +cFname + cFext + CASE ( cFile LIKE ".+\.(pot|pps|ppt|ppz)" ); RETURN "application/mspowerpoint =" + cFname + cFext + CASE ( cFile LIKE ".+\.doc" ); RETURN "application/msword=" +cFname + cFext + CASE ( cFile LIKE ".+\.n2p" ); RETURN "application/n2p="+cFname + cFext + CASE ( cFile LIKE ".+\.(bin|class|lha|lzh|lzx|dbf)" ); RETURN "application/octet-stream =" + cFname + cFext + CASE ( cFile LIKE ".+\.oda" ); RETURN "application/oda="+cFname + cFext + CASE ( cFile LIKE ".+\.axs" ); RETURN "application/olescript=" + cFname + cFext + CASE ( cFile LIKE ".+\.zpa" ); RETURN "application/pcphoto="+cFname + cFext + CASE ( cFile LIKE ".+\.pdf" ); RETURN "application/pdf="+cFname + cFext + CASE ( cFile LIKE ".+\.(ai|eps|ps)" ); RETURN "application/postscript=" +cFname + cFext + CASE ( cFile LIKE ".+\.shw" ); RETURN "application/presentations=" + cFname + cFext + CASE ( cFile LIKE ".+\.qrt" ); RETURN "application/quest=" + cFname + cFext + CASE ( cFile LIKE ".+\.rtc" ); RETURN "application/rtc="+cFname + cFext + CASE ( cFile LIKE ".+\.rtf" ); RETURN "application/rtf="+cFname + cFext + CASE ( cFile LIKE ".+\.smp" ); RETURN "application/studiom="+cFname + cFext + CASE ( cFile LIKE ".+\.dst" ); RETURN "application/tajima=" +cFname + cFext + CASE ( cFile LIKE ".+\.talk" ); RETURN "application/talker=" +cFname + cFext + CASE ( cFile LIKE ".+\.tbk" ); RETURN "application/toolbook =" + cFname + cFext + CASE ( cFile LIKE ".+\.vmd" ); RETURN "application/vocaltec-media-desc="+cFname + cFext + CASE ( cFile LIKE ".+\.vmf" ); RETURN "application/vocaltec-media-file="+cFname + cFext + CASE ( cFile LIKE ".+\.wri" ); RETURN "application/write=" + cFname + cFext + CASE ( cFile LIKE ".+\.wid" ); RETURN "application/x-DemoShield =" + cFname + cFext + CASE ( cFile LIKE ".+\.rrf" ); RETURN "application/x-InstallFromTheWeb="+cFname + cFext + CASE ( cFile LIKE ".+\.wis" ); RETURN "application/x-InstallShield="+cFname + cFext + CASE ( cFile LIKE ".+\.ins" ); RETURN "application/x-NET-Install=" + cFname + cFext + CASE ( cFile LIKE ".+\.tmv" ); RETURN "application/x-Parable-Thing="+cFname + cFext + CASE ( cFile LIKE ".+\.arj" ); RETURN "application/x-arj=" + cFname + cFext + CASE ( cFile LIKE ".+\.asp" ); RETURN "application/x-asap=" +cFname + cFext + CASE ( cFile LIKE ".+\.aab" ); RETURN "application/x-authorware-bin =" + cFname + cFext + CASE ( cFile LIKE ".+\.(aam|aas)" ); RETURN "application/x-authorware-map =" + cFname + cFext + CASE ( cFile LIKE ".+\.bcpio" ); RETURN "application/x-bcpio="+cFname + cFext + CASE ( cFile LIKE ".+\.vcd" ); RETURN "application/x-cdlink =" + cFname + cFext + CASE ( cFile LIKE ".+\.chat" ); RETURN "application/x-chat=" +cFname + cFext + CASE ( cFile LIKE ".+\.cnc" ); RETURN "application/x-cnc=" + cFname + cFext + CASE ( cFile LIKE ".+\.(coda|page)" ); RETURN "application/x-coda=" +cFname + cFext + CASE ( cFile LIKE ".+\.z" ); RETURN "application/x-compress=" +cFname + cFext + CASE ( cFile LIKE ".+\.con" ); RETURN "application/x-connector="+cFname + cFext + CASE ( cFile LIKE ".+\.cpio" ); RETURN "application/x-cpio=" +cFname + cFext + CASE ( cFile LIKE ".+\.pqf" ); RETURN "application/x-cprplayer="+cFname + cFext + CASE ( cFile LIKE ".+\.csh" ); RETURN "application/x-csh=" + cFname + cFext + CASE ( cFile LIKE ".+\.(cu|csm)" ); RETURN "application/x-cu-seeme=" +cFname + cFext + CASE ( cFile LIKE ".+\.(dcr|dir|dxr|swa)" ); RETURN "application/x-director=" +cFname + cFext + CASE ( cFile LIKE ".+\.dvi" ); RETURN "application/x-dvi=" + cFname + cFext + CASE ( cFile LIKE ".+\.evy" ); RETURN "application/x-envoy="+cFname + cFext + CASE ( cFile LIKE ".+\.ebk" ); RETURN "application/x-expandedbook=" +cFname + cFext + CASE ( cFile LIKE ".+\.gtar" ); RETURN "application/x-gtar=" +cFname + cFext + CASE ( cFile LIKE ".+\.hdf" ); RETURN "application/x-hdf=" + cFname + cFext + CASE ( cFile LIKE ".+\.map" ); RETURN "application/x-httpd-imap =" + cFname + cFext + CASE ( cFile LIKE ".+\.phtml" ); RETURN "application/x-httpd-php="+cFname + cFext + CASE ( cFile LIKE ".+\.php3" ); RETURN "application/x-httpd-php3 =" + cFname + cFext + CASE ( cFile LIKE ".+\.ica" ); RETURN "application/x-ica=" + cFname + cFext + CASE ( cFile LIKE ".+\.ipx" ); RETURN "application/x-ipix=" +cFname + cFext + CASE ( cFile LIKE ".+\.ips" ); RETURN "application/x-ipscript=" +cFname + cFext + CASE ( cFile LIKE ".+\.js" ); RETURN "application/x-javascript =" + cFname + cFext + CASE ( cFile LIKE ".+\.latex" ); RETURN "application/x-latex="+cFname + cFext + CASE ( cFile LIKE ".+\.bin" ); RETURN "application/x-macbinary="+cFname + cFext + CASE ( cFile LIKE ".+\.mif" ); RETURN "application/x-mif=" + cFname + cFext + CASE ( cFile LIKE ".+\.(mpl|mpire)" ); RETURN "application/x-mpire="+cFname + cFext + CASE ( cFile LIKE ".+\.adr" ); RETURN "application/x-msaddr =" + cFname + cFext + CASE ( cFile LIKE ".+\.wlt" ); RETURN "application/x-mswallet=" +cFname + cFext + CASE ( cFile LIKE ".+\.(nc|cdf)" ); RETURN "application/x-netcdf =" + cFname + cFext + CASE ( cFile LIKE ".+\.npx" ); RETURN "application/x-netfpx =" + cFname + cFext + CASE ( cFile LIKE ".+\.nsc" ); RETURN "application/x-nschat =" + cFname + cFext + CASE ( cFile LIKE ".+\.pgp" ); RETURN "application/x-pgp-plugin =" + cFname + cFext + CASE ( cFile LIKE ".+\.css" ); RETURN "application/x-pointplus="+cFname + cFext + CASE ( cFile LIKE ".+\.sh" ); RETURN "application/x-sh =" + cFname + cFext + CASE ( cFile LIKE ".+\.shar" ); RETURN "application/x-shar=" +cFname + cFext + CASE ( cFile LIKE ".+\.swf" ); RETURN "application/x-shockwave-flash=" + cFname + cFext + CASE ( cFile LIKE ".+\.spr" ); RETURN "application/x-sprite =" + cFname + cFext + CASE ( cFile LIKE ".+\.sprite" ); RETURN "application/x-sprite =" + cFname + cFext + CASE ( cFile LIKE ".+\.sit" ); RETURN "application/x-stuffit=" + cFname + cFext + CASE ( cFile LIKE ".+\.sca" ); RETURN "application/x-supercard="+cFname + cFext + CASE ( cFile LIKE ".+\.sv4cpio" ); RETURN "application/x-sv4cpio=" + cFname + cFext + CASE ( cFile LIKE ".+\.sv4crc" ); RETURN "application/x-sv4crc =" + cFname + cFext + CASE ( cFile LIKE ".+\.tar" ); RETURN "application/x-tar=" + cFname + cFext + CASE ( cFile LIKE ".+\.tcl" ); RETURN "application/x-tcl=" + cFname + cFext + CASE ( cFile LIKE ".+\.tex" ); RETURN "application/x-tex=" + cFname + cFext + CASE ( cFile LIKE ".+\.(texinfo|texi)" ); RETURN "application/x-texinfo=" + cFname + cFext + CASE ( cFile LIKE ".+\.tlk" ); RETURN "application/x-tlk=" + cFname + cFext + CASE ( cFile LIKE ".+\.(t|tr|roff)" ); RETURN "application/x-troff="+cFname + cFext + CASE ( cFile LIKE ".+\.man" ); RETURN "application/x-troff-man="+cFname + cFext + CASE ( cFile LIKE ".+\.me" ); RETURN "application/x-troff-me=" +cFname + cFext + CASE ( cFile LIKE ".+\.ms" ); RETURN "application/x-troff-ms=" +cFname + cFext + CASE ( cFile LIKE ".+\.alt" ); RETURN "application/x-up-alert=" +cFname + cFext + CASE ( cFile LIKE ".+\.che" ); RETURN "application/x-up-cacheop =" + cFname + cFext + CASE ( cFile LIKE ".+\.ustar" ); RETURN "application/x-ustar="+cFname + cFext + CASE ( cFile LIKE ".+\.src" ); RETURN "application/x-wais-source=" + cFname + cFext + CASE ( cFile LIKE ".+\.xls" ); RETURN "application/xls="+cFname + cFext + CASE ( cFile LIKE ".+\.xlt" ); RETURN "application/xlt="+cFname + cFext + CASE ( cFile LIKE ".+\.zip" ); RETURN "application/zip="+cFname + cFext + CASE ( cFile LIKE ".+\.(au|snd)" ); RETURN "audio/basic="+cFname + cFext + CASE ( cFile LIKE ".+\.es" ); RETURN "audio/echospeech =" + cFname + cFext + CASE ( cFile LIKE ".+\.(gsm|gsd)" ); RETURN "audio/gsm=" + cFname + cFext + CASE ( cFile LIKE ".+\.rmf" ); RETURN "audio/rmf=" + cFname + cFext + CASE ( cFile LIKE ".+\.tsi" ); RETURN "audio/tsplayer=" +cFname + cFext + CASE ( cFile LIKE ".+\.vox" ); RETURN "audio/voxware=" + cFname + cFext + CASE ( cFile LIKE ".+\.wtx" ); RETURN "audio/wtx=" + cFname + cFext + CASE ( cFile LIKE ".+\.(aif|aiff|aifc)" ); RETURN "audio/x-aiff =" + cFname + cFext + CASE ( cFile LIKE ".+\.(cht|dus)" ); RETURN "audio/x-dspeech="+cFname + cFext + CASE ( cFile LIKE ".+\.(mid|midi)" ); RETURN "audio/x-midi =" + cFname + cFext + CASE ( cFile LIKE ".+\.mp3" ); RETURN "audio/x-mpeg =" + cFname + cFext + CASE ( cFile LIKE ".+\.mp2" ); RETURN "audio/x-mpeg =" + cFname + cFext + CASE ( cFile LIKE ".+\.m3u" ); RETURN "audio/x-mpegurl="+cFname + cFext + CASE ( cFile LIKE ".+\.(ram|ra)" ); RETURN "audio/x-pn-realaudio =" + cFname + cFext + CASE ( cFile LIKE ".+\.rpm" ); RETURN "audio/x-pn-realaudio-plugin="+cFname + cFext + CASE ( cFile LIKE ".+\.stream" ); RETURN "audio/x-qt-stream=" + cFname + cFext + CASE ( cFile LIKE ".+\.rmf" ); RETURN "audio/x-rmf="+cFname + cFext + CASE ( cFile LIKE ".+\.(vqf|vql)" ); RETURN "audio/x-twinvq=" +cFname + cFext + CASE ( cFile LIKE ".+\.vqe" ); RETURN "audio/x-twinvq-plugin=" + cFname + cFext + CASE ( cFile LIKE ".+\.wav" ); RETURN "audio/x-wav="+cFname + cFext + CASE ( cFile LIKE ".+\.wtx" ); RETURN "audio/x-wtx="+cFname + cFext + CASE ( cFile LIKE ".+\.mol" ); RETURN "chemical/x-mdl-molfile=" +cFname + cFext + CASE ( cFile LIKE ".+\.pdb" ); RETURN "chemical/x-pdb=" +cFname + cFext + CASE ( cFile LIKE ".+\.dwf" ); RETURN "drawing/x-dwf=" + cFname + cFext + CASE ( cFile LIKE ".+\.ivr" ); RETURN "i-world/i-vrml=" +cFname + cFext + CASE ( cFile LIKE ".+\.cod" ); RETURN "image/cis-cod=" + cFname + cFext + CASE ( cFile LIKE ".+\.cpi" ); RETURN "image/cpi=" + cFname + cFext + CASE ( cFile LIKE ".+\.fif" ); RETURN "image/fif=" + cFname + cFext + CASE ( cFile LIKE ".+\.gif" ); RETURN "image/gif=" + cFname + cFext + CASE ( cFile LIKE ".+\.ief" ); RETURN "image/ief=" + cFname + cFext + CASE ( cFile LIKE ".+\.(jpeg|jpg|jpe)" ); RETURN "image/jpeg=" +cFname + cFext + CASE ( cFile LIKE ".+\.rip" ); RETURN "image/rip=" + cFname + cFext + CASE ( cFile LIKE ".+\.svh" ); RETURN "image/svh=" + cFname + cFext + CASE ( cFile LIKE ".+\.(tiff|tif)" ); RETURN "image/tiff=" +cFname + cFext + CASE ( cFile LIKE ".+\.mcf" ); RETURN "image/vasa=" +cFname + cFext + CASE ( cFile LIKE ".+\.(svf|dwg|dxf)" ); RETURN "image/vnd=" + cFname + cFext + CASE ( cFile LIKE ".+\.wi" ); RETURN "image/wavelet=" + cFname + cFext + CASE ( cFile LIKE ".+\.ras" ); RETURN "image/x-cmu-raster=" +cFname + cFext + CASE ( cFile LIKE ".+\.etf" ); RETURN "image/x-etf="+cFname + cFext + CASE ( cFile LIKE ".+\.fpx" ); RETURN "image/x-fpx="+cFname + cFext + CASE ( cFile LIKE ".+\.(fh5|fh4|fhc)" ); RETURN "image/x-freehand =" + cFname + cFext + CASE ( cFile LIKE ".+\.dsf" ); RETURN "image/x-mgx-dsf="+cFname + cFext + CASE ( cFile LIKE ".+\.pnm" ); RETURN "image/x-portable-anymap="+cFname + cFext + CASE ( cFile LIKE ".+\.pbm" ); RETURN "image/x-portable-bitmap="+cFname + cFext + CASE ( cFile LIKE ".+\.pgm" ); RETURN "image/x-portable-graymap =" + cFname + cFext + CASE ( cFile LIKE ".+\.ppm" ); RETURN "image/x-portable-pixmap="+cFname + cFext + CASE ( cFile LIKE ".+\.rgb" ); RETURN "image/x-rgb="+cFname + cFext + CASE ( cFile LIKE ".+\.xbm" ); RETURN "image/x-xbitmap="+cFname + cFext + CASE ( cFile LIKE ".+\.xpm" ); RETURN "image/x-xpixmap="+cFname + cFext + CASE ( cFile LIKE ".+\.xwd" ); RETURN "image/x-xwindowdump="+cFname + cFext + CASE ( cFile LIKE ".+\.dig" ); RETURN "multipart/mixed="+cFname + cFext + CASE ( cFile LIKE ".+\.push" ); RETURN "multipart/x-mixed-replace=" + cFname + cFext + CASE ( cFile LIKE ".+\.(wan|waf)" ); RETURN "plugin/wanimate="+cFname + cFext + CASE ( cFile LIKE ".+\.ccs" ); RETURN "text/ccs =" + cFname + cFext + CASE ( cFile LIKE ".+\.(htm|html)" ); RETURN "text/html=" + cFname + cFext + CASE ( cFile LIKE ".+\.pgr" ); RETURN "text/parsnegar-document="+cFname + cFext + CASE ( cFile LIKE ".+\.txt" ); RETURN "text/plain=" +cFname + cFext + CASE ( cFile LIKE ".+\.rtx" ); RETURN "text/richtext=" + cFname + cFext + CASE ( cFile LIKE ".+\.tsv" ); RETURN "text/tab-separated-values=" + cFname + cFext + CASE ( cFile LIKE ".+\.hdml" ); RETURN "text/x-hdml="+cFname + cFext + CASE ( cFile LIKE ".+\.etx" ); RETURN "text/x-setext=" + cFname + cFext + CASE ( cFile LIKE ".+\.(talk|spc)" ); RETURN "text/x-speech=" + cFname + cFext + CASE ( cFile LIKE ".+\.afl" ); RETURN "video/animaflex="+cFname + cFext + CASE ( cFile LIKE ".+\.(mpeg|mpg|mpe)" ); RETURN "video/mpeg=" +cFname + cFext + CASE ( cFile LIKE ".+\.(qt|mov)" ); RETURN "video/quicktime="+cFname + cFext + CASE ( cFile LIKE ".+\.(viv|vivo)" ); RETURN "video/vnd.vivo=" +cFname + cFext + CASE ( cFile LIKE ".+\.(asf|asx)" ); RETURN "video/x-ms-asf=" +cFname + cFext + CASE ( cFile LIKE ".+\.avi" ); RETURN "video/x-msvideo="+cFname + cFext + CASE ( cFile LIKE ".+\.movie" ); RETURN "video/x-sgi-movie=" + cFname + cFext + CASE ( cFile LIKE ".+\.(vgm|vgx|xdr)" ); RETURN "video/x-videogram=" + cFname + cFext + CASE ( cFile LIKE ".+\.vgp" ); RETURN "video/x-videogram-plugin =" + cFname + cFext + CASE ( cFile LIKE ".+\.vts" ); RETURN "workbook/formulaone="+cFname + cFext + CASE ( cFile LIKE ".+\.vtts" ); RETURN "workbook/formulaone="+cFname + cFext + CASE ( cFile LIKE ".+\.(3dmf|3dm|qd3d|qd3)" ); RETURN "x-world/x-3dmf=" +cFname + cFext + CASE ( cFile LIKE ".+\.svr" ); RETURN "x-world/x-svr=" + cFname + cFext + CASE ( cFile LIKE ".+\.(wrl|wrz)" ); RETURN "x-world/x-vrml=" +cFname + cFext + CASE ( cFile LIKE ".+\.vrt" ); RETURN "x-world/x-vrt=" + cFname + cFext + ENDCASE -RETURN "text/plain;filename=" + cFname + cFext + RETURN "text/plain;filename=" + cFname + cFext diff --git a/harbour/contrib/hbtip/sessid.prg b/harbour/contrib/hbtip/sessid.prg index 7cb526f741..d15409bf94 100644 --- a/harbour/contrib/hbtip/sessid.prg +++ b/harbour/contrib/hbtip/sessid.prg @@ -12,7 +12,6 @@ * TIP Class oriented Internet protocol library * * Copyright 2003 Giancarlo Niccolai - * * www - http://www.harbour-project.org * * CGI Session Manager Class @@ -84,7 +83,7 @@ FUNCTION TIP_GENERATESID( cCRCKey ) /* Let's generate the sequence */ cSID := Space( nLenSID ) for n := 1 TO nLenSID - nRand := HB_RandomInt( 1, nLenKeys ) + nRand := hb_RandomInt( 1, nLenKeys ) cSID := Stuff( cSID, n, 1, SubStr( cBaseKeys, nRand, 1 ) ) nKey += nRand next diff --git a/harbour/contrib/hbtip/smtpcln.prg b/harbour/contrib/hbtip/smtpcln.prg index 9b1ec6e0ec..24dabbb9dc 100644 --- a/harbour/contrib/hbtip/smtpcln.prg +++ b/harbour/contrib/hbtip/smtpcln.prg @@ -57,14 +57,10 @@ #include "hbclass.ch" #include "tip.ch" -/** -* Inet service manager: smtp -*/ - CREATE CLASS tIPClientSMTP FROM tIPClient METHOD New( oUrl, lTrace, oCredentials ) - METHOD Open() + METHOD Open( cUrl ) METHOD Close() METHOD Write( cData, nLen, bCommit ) METHOD Mail( cFrom ) @@ -73,14 +69,13 @@ CREATE CLASS tIPClientSMTP FROM tIPClient METHOD Commit() METHOD Quit() METHOD GetOK() + METHOD SendMail( oTIpMail ) /* 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 sendMail + METHOD OpenSecure( cUrl ) + METHOD Auth( cUser, cPass ) // Auth by login method + METHOD AuthPlain( cUser, cPass ) // Auth by plain method + METHOD ServerSuportSecure( lAuthPlain, lAuthLogin ) HIDDEN: @@ -102,10 +97,10 @@ METHOD New( oUrl, lTrace, oCredentials ) CLASS tIPClientSMTP ::nHandle := FCreate( "sendmail.log" ) ELSE n := 1 - DO WHILE hb_FileExists( "sendmail" + hb_NToS( n ) + ".log" ) + DO WHILE hb_FileExists( "sendmail" + hb_ntos( n ) + ".log" ) n++ ENDDO - ::nHandle := FCreate( "sendmail" + hb_NToS( n ) + ".log" ) + ::nHandle := FCreate( "sendmail" + hb_ntos( n ) + ".log" ) ENDIF ENDIF @@ -117,29 +112,37 @@ METHOD Open( cUrl ) CLASS tIPClientSMTP RETURN .F. ENDIF - HB_InetTimeout( ::SocketCon, ::nConnTimeout ) - IF ! Empty( ::oUrl:cUserid ) - ::InetSendall( ::SocketCon, "HELO " + ::oUrl:cUserid + ::cCRLF ) - ELSE - ::InetSendall( ::SocketCon, "HELO tipClientSMTP" + ::cCRLF ) + hb_inetTimeout( ::SocketCon, ::nConnTimeout ) + + ::InetSendall( ::SocketCon, "HELO " + iif( Empty( ::oUrl:cUserid ), "tipClientSMTP", ::oUrl:cUserid ) + ::cCRLF ) + + RETURN ::GetOk() + +METHOD OpenSecure( cUrl ) CLASS tIPClientSMTP + + IF ! ::super:Open( cUrl ) + RETURN .F. ENDIF + hb_inetTimeout( ::SocketCon, ::nConnTimeout ) + + ::InetSendall( ::SocketCon, "EHLO " + iif( Empty( ::oUrl:cUserid ), "tipClientSMTP", ::oUrl:cUserid ) + ::cCRLF ) + RETURN ::GetOk() METHOD GetOk() CLASS tIPClientSMTP - LOCAL nLen - ::cReply := ::InetRecvLine( ::SocketCon, @nLen, 512 ) - IF ::InetErrorCode( ::SocketCon ) != 0 .OR. SubStr( ::cReply, 1, 1 ) == "5" + ::cReply := ::InetRecvLine( ::SocketCon,, 512 ) + IF ::InetErrorCode( ::SocketCon ) != 0 .OR. Left( ::cReply, 1 ) == "5" RETURN .F. ENDIF RETURN .T. METHOD Close() CLASS tIPClientSMTP - HB_InetTimeOut( ::SocketCon, ::nConnTimeout ) + hb_inetTimeOut( ::SocketCon, ::nConnTimeout ) IF ::ltrace - FClose(::nHandle) + FClose( ::nHandle ) ENDIF ::Quit() RETURN ::super:Close() @@ -154,7 +157,7 @@ METHOD Quit() CLASS tIPClientSMTP RETURN ::GetOk() METHOD Mail( cFrom ) CLASS tIPClientSMTP - ::InetSendall( ::SocketCon, "MAIL FROM: <" + cFrom +">" + ::cCRLF ) + ::InetSendall( ::SocketCon, "MAIL FROM: <" + cFrom + ">" + ::cCRLF ) RETURN ::GetOk() METHOD Rcpt( cTo ) CLASS tIPClientSMTP @@ -169,61 +172,30 @@ METHOD Data( cData ) CLASS tIPClientSMTP ::InetSendall(::SocketCon, cData + ::cCRLF + "." + ::cCRLF ) RETURN ::GetOk() -METHOD OpenSecure( cUrl ) CLASS tIPClientSMTP +METHOD Auth( cUser, cPass ) CLASS tIPClientSMTP - LOCAL cUser - - IF ! ::super:Open( cUrl ) - RETURN .F. - ENDIF - - HB_InetTimeout( ::SocketCon, ::nConnTimeout ) - - cUser := ::oUrl:cUserid - - IF ! Empty ( ::oUrl:cUserid ) - ::InetSendall( ::SocketCon, "EHLO " + cUser + ::cCRLF ) - ELSE - ::InetSendall( ::SocketCon, "EHLO tipClientSMTP" + ::cCRLF ) - ENDIF - - RETURN ::getOk() - -METHOD AUTH( cUser, cPass ) CLASS tIPClientSMTP - - LOCAL cEncodedUser - LOCAL cEncodedPAss - - cUser := StrTran( cUser, "&at;", "@" ) - - cEncodedUser := AllTrim( HB_BASE64( cUser ) ) - cEncodedPAss := AllTrim( HB_BASE64( cPass ) ) - - ::InetSendall( ::SocketCon, "AUTH LOGIN" + ::ccrlf ) + ::InetSendall( ::SocketCon, "AUTH LOGIN" + ::cCRLF ) IF ::GetOk() - ::InetSendall( ::SocketCon, cEncodedUser + ::cCrlf ) - IF ::Getok() - ::InetSendall( ::SocketCon, cEncodedPass + ::cCrlf ) + ::InetSendall( ::SocketCon, hb_BASE64( StrTran( cUser, "&at;", "@" ) ) + ::cCRLF ) + IF ::GetOk() + ::InetSendall( ::SocketCon, hb_BASE64( cPass ) + ::cCRLF ) ENDIF ENDIF RETURN ::isAuth := ::GetOk() -METHOD AuthPlain( cUser, cPass) CLASS tIPClientSMTP +METHOD AuthPlain( cUser, cPass ) CLASS tIPClientSMTP - ::InetSendall( ::SocketCon, "AUTH PLAIN" +; - HB_BASE64( BUILDUSERPASSSTRING( cUser, cPass ) ) +; - ::cCrlf ) + ::InetSendall( ::SocketCon, "AUTH PLAIN" + hb_BASE64( Chr( 0 ) + cUser + Chr( 0 ) + cPass ) + ::cCRLF ) RETURN ::isAuth := ::GetOk() METHOD Write( cData, nLen, bCommit ) CLASS tIPClientSMTP - LOCAL aTo - LOCAL cRecpt + LOCAL cRcpt IF ! ::bInitialized - //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 @@ -231,10 +203,9 @@ METHOD Write( cData, nLen, bCommit ) CLASS tIPClientSMTP IF ! ::Mail( ::oUrl:cUserid ) RETURN -1 ENDIF - aTo := HB_RegexSplit( ",", ::oUrl:cFile ) - FOR EACH cRecpt IN Ato - IF ! ::Rcpt( cRecpt ) + FOR EACH cRcpt IN hb_regexSplit( ",", ::oUrl:cFile ) + IF ! ::Rcpt( cRcpt ) RETURN -1 ENDIF NEXT @@ -250,11 +221,12 @@ METHOD Write( cData, nLen, bCommit ) CLASS tIPClientSMTP RETURN ::nLastWrite -METHOD ServerSuportSecure( /* @ */ lAuthp, /* @ */ lAuthl ) CLASS tIPClientSMTP - LOCAL lAuthLogin := .F. - LOCAL lAuthPlain := .F. +METHOD ServerSuportSecure( /* @ */ lAuthPlain, /* @ */ lAuthLogin ) CLASS tIPClientSMTP - IF ::OPENSECURE() + lAuthLogin := .F. + lAuthPlain := .F. + + IF ::OpenSecure() DO WHILE .T. ::GetOk() IF ::cReply == NIL @@ -265,45 +237,34 @@ METHOD ServerSuportSecure( /* @ */ lAuthp, /* @ */ lAuthl ) CLASS tIPClientSMTP lAuthPlain := .T. ENDIF ENDDO - ::CLOSE() + ::Close() ENDIF - lAuthp := lAuthPlain - lAuthl := lAuthLogin - RETURN lAuthLogin .OR. lAuthPlain -METHOD sendMail( oTIpMail ) CLASS TIpClientSmtp - LOCAL cFrom +METHOD SendMail( oTIpMail ) CLASS TIpClientSmtp LOCAL cTo - LOCAL aTo IF ! ::isOpen RETURN .F. ENDIF IF ! ::isAuth - ::auth( ::oUrl:cUserId, ::oUrl:cPassWord ) + ::Auth( ::oUrl:cUserId, ::oUrl:cPassWord ) IF ! ::isAuth RETURN .F. ENDIF ENDIF - cFrom := oTIpMail:getFieldPart( "From" ) + ::mail( oTIpMail:getFieldPart( "From" ) ) + cTo := oTIpMail:getFieldPart( "To" ) + cTo := StrTran( cTo, hb_inetCRLF() ) + cTo := StrTran( cTo, Chr( 9 ) ) + cTo := StrTran( cTo, Chr( 32 ) ) - cTo := StrTran( cTo, HB_InetCRLF(), "" ) - cTo := StrTran( cTo, Chr( 9 ), "" ) - cTo := StrTran( cTo, Chr( 32 ), "" ) - - aTo := HB_RegExSplit( ",", cTo ) - - ::mail( cFrom ) - FOR EACH cTo IN aTo + FOR EACH cTo IN hb_regexSplit( ",", cTo ) ::rcpt( cTo ) NEXT 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 65311e5882..4950378784 100644 --- a/harbour/contrib/hbtip/thtml.prg +++ b/harbour/contrib/hbtip/thtml.prg @@ -73,9 +73,9 @@ #xtrans P_SEEK( , ) => (:p_end:=:p_pos, :p_pos:=hb_At(,:p_str,:p_end+1)) #xtrans P_SEEKI( , ) => (:p_end:=:p_pos, :p_pos:=hb_AtI(,:p_str,:p_end+1)) -#xtrans P_PEEK( , ) => (:p_end:=:p_pos,PStrCompi( :p_str, :p_pos, )) -#xtrans P_NEXT( ) => (:p_end:=:p_pos, substr(:p_str,++:p_pos,1)) -#xtrans P_PREV( ) => (:p_end:=:p_pos, substr(:p_str,--:p_pos,1)) +#xtrans P_PEEK( , ) => (:p_end:=:p_pos, PStrCompi( :p_str, :p_pos, )) +#xtrans P_NEXT( ) => (:p_end:=:p_pos, SubStr(:p_str,++:p_pos,1)) +#xtrans P_PREV( ) => (:p_end:=:p_pos, SubStr(:p_str,--:p_pos,1)) // Directives for a light weight stack #define S_DATA 1 // array holding data elements @@ -85,8 +85,8 @@ #xtrans S_STACK() => S_STACK(64) #xtrans S_STACK( ) => {Array(),0,,Max(32,Int(/2))} -#xtrans S_GROW( ) => (IIF(++\[S_NUM]>\[S_SIZE],ASize(\[S_DATA],(\[S_SIZE]+=\[S_STEP])),)) -#xtrans S_SHRINK( ) => (IIF(\[S_NUM]>0 .AND. --\[S_NUM]\<\[S_SIZE]-\[S_STEP],ASize(\[S_DATA],\[S_SIZE]-=\[S_STEP]),)) +#xtrans S_GROW( ) => (iif(++\[S_NUM]>\[S_SIZE],ASize(\[S_DATA],(\[S_SIZE]+=\[S_STEP])),)) +#xtrans S_SHRINK( ) => (iif(\[S_NUM]>0 .AND. --\[S_NUM]\<\[S_SIZE]-\[S_STEP],ASize(\[S_DATA],\[S_SIZE]-=\[S_STEP]),)) #xtrans S_COMPRESS( ) => (ASize(\[S_DATA],\[S_SIZE]:=\[S_NUM])) #xtrans S_PUSH(,) => (S_GROW(),\[S_DATA,\[S_NUM]]:=) #xtrans S_POP(,@) => (:=\[S_DATA,\[S_NUM]],\[S_DATA,\[S_NUM]]:=NIL,S_SHRINK()) @@ -94,14 +94,14 @@ #xtrans S_TOP() => (\[S_DATA,\[S_NUM]]) -STATIC saHtmlAttr // data for HTML attributes -STATIC shTagTypes // data for HTML tags -STATIC saHtmlAnsiEntities // HTML character entities (ANSI character set) -STATIC slInit := .F. // initilization flag for HTML data +STATIC s_aHtmlAttr // data for HTML attributes +STATIC s_hTagTypes // data for HTML tags +STATIC s_aHtmlAnsiEntities // HTML character entities (ANSI character set) +STATIC s_lInit := .F. // initilization flag for HTML data * #define _DEBUG_ #ifdef _DEBUG_ - #xtrans HIDDEN: => EXPORTED: // debugger can't see HIDDEN iVars + #xtranslate HIDDEN: => EXPORTED: // debugger can't see HIDDEN iVars #endif /* @@ -136,12 +136,12 @@ ENDCLASS METHOD new( cHtmlString ) CLASS THtmlDocument LOCAL cEmptyHtmlDoc, oNode, oSubNode, oErrNode, aHead, aBody, nMode := 0 - cEmptyHtmlDoc := '' + hb_OSNewLine() +; - '' + hb_OSNewLine() +; - ' ' + hb_OSNewLine() +; - ' ' + hb_OSNewLine() +; - ' ' + hb_OSNewLine() +; - ' ' + hb_OSNewLine() +; + cEmptyHtmlDoc := '' + hb_osNewLine() +; + '' + hb_osNewLine() +; + ' ' + hb_osNewLine() +; + ' ' + hb_osNewLine() +; + ' ' + hb_osNewLine() +; + ' ' + hb_osNewLine() +; '' IF ! ISCHARACTER( cHtmlString ) @@ -155,7 +155,7 @@ METHOD new( cHtmlString ) CLASS THtmlDocument ENDIF ENDIF - ::root:document := self + ::root:document := Self ::head := ::getNode( "head" ) ::body := ::getNode( "body" ) @@ -174,7 +174,7 @@ METHOD new( cHtmlString ) CLASS THtmlDocument NEXT ::root := THtmlNode():new( cEmptyHtmlDoc ) - ::root:document := self + ::root:document := Self ::changed := .T. ::head := ::getNode( "head" ) ::body := ::getNode( "body" ) @@ -223,13 +223,12 @@ METHOD new( cHtmlString ) CLASS THtmlDocument ENDIF NEXT ENDIF -RETURN self + RETURN Self // Builds a HTML formatted string METHOD toString() CLASS THtmlDocument -RETURN ::root:toString() - + RETURN ::root:toString() // reads HTML file and parses it into tree of objects METHOD readFile( cFileName ) CLASS THtmlDocument @@ -238,8 +237,8 @@ METHOD readFile( cFileName ) CLASS THtmlDocument ENDIF ::changed := .T. ::new( Memoread( cFileName ) ) -RETURN .T. + RETURN .T. // writes the entire tree of HTML objects into a file METHOD writeFile( cFileName ) CLASS THtmlDocument @@ -250,11 +249,11 @@ METHOD writeFile( cFileName ) CLASS THtmlDocument RETURN .F. ENDIF - FWrite( nFileHandle, cHtml, Len(cHtml) ) + FWrite( nFileHandle, cHtml ) FClose( nFileHandle ) ::changed := .F. -RETURN FError() == 0 + RETURN FError() == 0 // builds a one dimensional array of all nodes contained in the HTML document METHOD collect() CLASS THtmlDocument @@ -262,8 +261,7 @@ METHOD collect() CLASS THtmlDocument ::nodes := ::root:collect() ::changed := .F. ENDIF -RETURN ::nodes - + RETURN ::nodes // returns the first tag matching the passed tag name METHOD getNode( cTagName ) CLASS THtmlDocument @@ -278,8 +276,8 @@ METHOD getNode( cTagName ) CLASS THtmlDocument RETURN oNode ENDIF NEXT -RETURN NIL + RETURN NIL // returns all tags matching the passed tag name METHOD getNodes( cTagName ) CLASS THtmlDocument @@ -296,20 +294,18 @@ METHOD getNodes( cTagName ) CLASS THtmlDocument NEXT S_COMPRESS( stack ) -RETURN stack[S_DATA] + RETURN stack[ S_DATA ] // finds the first HTML tag matching the search criteria METHOD findFirst( cName, cAttrib, cValue, cData ) CLASS THtmlDocument - ::oIterator := THtmlIteratorScan():New( self ) -RETURN ::oIterator:Find( cName, cAttrib, cValue, cData ) - + ::oIterator := THtmlIteratorScan():New( Self ) + RETURN ::oIterator:Find( cName, cAttrib, cValue, cData ) // finds the first HTML tag matching the RegEx search criteria METHOD findFirstRegex( cName, cAttrib, cValue, cData ) CLASS THtmlDocument - ::oIterator := THtmlIteratorRegex():New( self ) -RETURN ::oIterator:Find( cName, cAttrib, cValue, cData ) - + ::oIterator := THtmlIteratorRegex():New( Self ) + RETURN ::oIterator:Find( cName, cAttrib, cValue, cData ) /* * Abstract super class for THtmlIteratorScan and THtmlIteratorScanRegEx @@ -317,7 +313,7 @@ RETURN ::oIterator:Find( cName, cAttrib, cValue, cData ) * (Adopted from TXMLIterator -> source\rtl\txml.prg) */ CREATE CLASS THtmlIterator MODULE FRIENDLY - METHOD New( oNodeTop ) CONSTRUCTOR + METHOD New( oNodeTop ) CONSTRUCTOR METHOD Next() METHOD Rewind() METHOD Find( cName, cAttribute, cValue, cData ) @@ -326,7 +322,8 @@ CREATE CLASS THtmlIterator MODULE FRIENDLY METHOD SetContext() METHOD Clone() -HIDDEN: + HIDDEN: + VAR cName VAR cAttribute VAR cValue @@ -352,14 +349,12 @@ METHOD New( oHtml ) CLASS THtmlIterator ::oTop := ::oNode ::nCurrent := 1 ::nLast := Len( ::aNodes ) -RETURN Self - + RETURN Self METHOD rewind CLASS THtmlIterator ::oNode := ::oTop ::nCurrent := 0 -RETURN self - + RETURN Self METHOD Clone() CLASS THtmlIterator LOCAL oRet @@ -373,16 +368,15 @@ METHOD Clone() CLASS THtmlIterator oRet:nLast := Len( ::aNodes ) oRet:aNodes := ::aNodes -RETURN oRet - + RETURN oRet METHOD SetContext() CLASS THtmlIterator ::oTop := ::oNode ::aNodes := ::oNode:collect() ::nCurrent := 0 ::nLast := Len( ::aNodes ) -RETURN Self + RETURN Self METHOD Find( cName, cAttribute, cValue, cData ) CLASS THtmlIterator ::cName := cName @@ -398,14 +392,14 @@ METHOD Find( cName, cAttribute, cValue, cData ) CLASS THtmlIterator IF ::MatchCriteria( ::oNode ) RETURN ::oNode ENDIF -RETURN ::Next() + RETURN ::Next() METHOD Next() CLASS THtmlIterator LOCAL oFound, lExit := .F. DO WHILE ! lExit - BEGIN SEQUENCE WITH {|oErr| Break( oErr )} + BEGIN SEQUENCE WITH {|oErr| Break( oErr ) } oFound := ::aNodes[ ++::nCurrent ] IF ::MatchCriteria( oFound ) ::oNode := oFound @@ -417,12 +411,10 @@ METHOD Next() CLASS THtmlIterator ::nCurrent := 0 END SEQUENCE ENDDO -RETURN oFound - + RETURN oFound METHOD MatchCriteria() CLASS THtmlIterator -RETURN .T. - + RETURN .T. /******************************************** Iterator scan class @@ -430,18 +422,20 @@ RETURN .T. CLASS THtmlIteratorScan FROM THtmlIterator MODULE FRIENDLY METHOD New( oNodeTop ) CONSTRUCTOR -HIDDEN: + + HIDDEN: + METHOD MatchCriteria( oFound ) ENDCLASS METHOD New( oNodeTop ) CLASS THtmlIteratorScan ::Super:New( oNodeTop ) -RETURN Self + 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 @@ -451,20 +445,20 @@ METHOD MatchCriteria( oFound ) CLASS THtmlIteratorScan IF ::cValue != NIL xData := oFound:getAttributes() - IF hb_HScan( xData, {| xKey, cValue | HB_SYMBOL_UNUSED(xKey), Lower(::cValue) == Lower(cValue) }) == 0 + IF hb_HScan( xData, {| xKey, cValue | HB_SYMBOL_UNUSED( xKey ), Lower( ::cValue ) == Lower( cValue ) } ) == 0 RETURN .F. ENDIF ENDIF IF ::cData != NIL - xData := oFound:getText(" ") + xData := oFound:getText( " " ) /* NOTE: != changed to !( == ) */ - IF Empty(xData) .OR. !( Alltrim(::cData) == Alltrim(xData) ) + IF Empty( xData ) .OR. !( AllTrim( ::cData ) == AllTrim( xData ) ) RETURN .F. ENDIF ENDIF -RETURN .T. + RETURN .T. /******************************************** Iterator regex class @@ -476,43 +470,43 @@ HIDDEN: METHOD MatchCriteria( oFound ) ENDCLASS - METHOD New( oNodeTop ) CLASS THtmlIteratorRegex ::Super:New( oNodeTop ) -RETURN Self - + RETURN Self METHOD MatchCriteria( oFound ) CLASS THtmlIteratorRegex LOCAL xData - IF ::cName != NIL .AND. ! 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. ; - hb_hScan( oFound:getAttributes(), {|cKey| hb_regexLike( lower(::cAttribute), cKey ) } ) == 0 + hb_HScan( oFound:getAttributes(), {| cKey | hb_regexLike( Lower( ::cAttribute ), cKey ) } ) == 0 RETURN .F. ENDIF IF ::cValue != NIL .AND.; - hb_hScan( oFound:getAttributes(), {|xKey, cValue| HB_SYMBOL_UNUSED(xKey), hb_regexLike( ::cValue, cValue ) } ) == 0 + 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. ! hb_regexHas( Alltrim(::cData), Alltrim(xData) ) + xData := oFound:getText( " " ) + IF Empty( xData ) .OR. ! hb_regexHas( AllTrim( ::cData ), AllTrim( xData ) ) RETURN .F. ENDIF ENDIF -RETURN .T. + RETURN .T. /* * Class representing a HTML node tree. * It parses a HTML formatted string */ CREATE CLASS THtmlNode MODULE FRIENDLY + HIDDEN: + VAR root VAR _document VAR parent @@ -533,7 +527,7 @@ CREATE CLASS THtmlNode MODULE FRIENDLY VAR htmlTagType READONLY VAR htmlAttributes READONLY - METHOD new( oParent, cTagName, cAttrib, cContent ) + METHOD New( oParent, cTagName, cAttrib, cContent ) METHOD isType( nCM_TYPE ) ACCESS isEmpty() @@ -557,10 +551,10 @@ CREATE CLASS THtmlNode MODULE FRIENDLY ACCESS nextNode() ACCESS prevNode() - ACCESS siblingNodes() INLINE IIf( ::parent==NIL, NIL, ::parent:htmlContent ) - ACCESS childNodes() INLINE IIf( ::isNode(), ::htmlContent, NIL ) + ACCESS siblingNodes() INLINE iif( ::parent == NIL, NIL, ::parent:htmlContent ) + ACCESS childNodes() INLINE iif( ::isNode(), ::htmlContent, NIL ) ACCESS parentNode() INLINE ::parent - ACCESS document() INLINE IIf( ::root==NIL, NIL, ::root:_document ) + ACCESS document() INLINE iif( ::root == NIL, NIL, ::root:_document ) METHOD toString( nIndent ) METHOD attrToString() @@ -580,10 +574,10 @@ CREATE CLASS THtmlNode MODULE FRIENDLY METHOD isAttribute() ACCESS text INLINE ::_getTextNode() - ASSIGN text(x) INLINE ::_setTextNode(x) + ASSIGN text(x) INLINE ::_setTextNode( x ) ACCESS attr INLINE ::getAttributes() - ASSIGN attr(x) INLINE ::setAttributes(x) + ASSIGN attr(x) INLINE ::setAttributes( x ) METHOD pushNode OPERATOR + METHOD popNode OPERATOR - @@ -597,16 +591,16 @@ ENDCLASS METHOD new( oParent, cTagName, cAttrib, cContent ) CLASS THtmlNode - IF ! slInit - THtmlInit(.T.) + IF ! s_lInit + THtmlInit( .T. ) ENDIF IF ISCHARACTER( oParent ) // a HTML string is passed -> build new tree of objects - IF Chr(9) $ oParent - oParent := StrTran( oParent, Chr(9), Chr(32) ) + IF Chr( 9 ) $ oParent + oParent := StrTran( oParent, Chr( 9 ), Chr( 32 ) ) ENDIF - ::root := self + ::root := Self ::htmlTagName := "_root_" ::htmlTagType := THtmlTagType( "_root_" ) ::htmlContent := {} @@ -619,7 +613,7 @@ METHOD new( oParent, cTagName, cAttrib, cContent ) CLASS THtmlNode IF Right( cAttrib, 1 ) == "/" cAttrib := Stuff( cAttrib, Len( cAttrib ), 1, " " ) ::htmlEndTagName := "/" - ::htmlAttributes := Trim( cAttrib ) + ::htmlAttributes := RTrim( cAttrib ) ELSE ::htmlAttributes := cAttrib ENDIF @@ -628,55 +622,47 @@ METHOD new( oParent, cTagName, cAttrib, cContent ) CLASS THtmlNode ENDIF ::htmlTagName := cTagName ::htmlTagType := THtmlTagType( cTagName ) - ::htmlContent := IIF( cContent == NIL, {}, cContent ) + ::htmlContent := iif( cContent == NIL, {}, cContent ) ELSE - RETURN ::error( "Parameter error", ::className(), ":new()", EG_ARG, HB_AParams() ) + RETURN ::error( "Parameter error", ::className(), ":new()", EG_ARG, hb_AParams() ) ENDIF -RETURN self - + RETURN Self METHOD isType( nType ) CLASS THtmlNode LOCAL lRet - BEGIN SEQUENCE WITH {|oErr| Break( oErr )} - lRet := hb_bitAnd( ::htmlTagType[2], nType ) > 0 + BEGIN SEQUENCE WITH {|oErr| Break( oErr ) } + lRet := hb_bitAnd( ::htmlTagType[ 2 ], nType ) > 0 RECOVER lRet := .F. END SEQUENCE -RETURN lRet - + RETURN lRet // checks if this is a node that is always empty and never has HTML text, e.g. ,, METHOD isEmpty CLASS THtmlNode -RETURN hb_bitAnd( ::htmlTagType[2], CM_EMPTY ) > 0 - + RETURN hb_bitAnd( ::htmlTagType[ 2 ], CM_EMPTY ) > 0 // checks if this is a node that may occur inline, eg. , METHOD isInline CLASS THtmlNode -RETURN hb_bitAnd( ::htmlTagType[2], CM_INLINE ) > 0 - + RETURN hb_bitAnd( ::htmlTagType[ 2 ], CM_INLINE ) > 0 // checks if this is a node that may appear without a closing tag, eg.

,, METHOD isOptional CLASS THtmlNode -RETURN hb_bitAnd( ::htmlTagType[2], CM_OPT ) > 0 - + RETURN hb_bitAnd( ::htmlTagType[ 2 ], CM_OPT ) > 0 // checks if this is a node (leafs contain no further nodes, e.g.
,

,_text_) METHOD isNode CLASS THtmlNode -RETURN ISARRAY( ::htmlContent ) .AND. Len( ::htmlContent ) > 0 - + RETURN ISARRAY( ::htmlContent ) .AND. Len( ::htmlContent ) > 0 // checks if this is a block node that must be closed with an ending tag: eg:
,
    METHOD isBlock CLASS THtmlNode -RETURN hb_bitAnd( ::htmlTagType[2], CM_BLOCK ) > 0 - + RETURN hb_bitAnd( ::htmlTagType[ 2 ], CM_BLOCK ) > 0 // checks if this is a node whose text line formatting must be preserved: 
    ,