diff --git a/ChangeLog.txt b/ChangeLog.txt index 077b1d68aa..6ca297f995 100644 --- a/ChangeLog.txt +++ b/ChangeLog.txt @@ -10,6 +10,19 @@ * Change, ! Fix, % Optimization, + Addition, - Removal, ; Comment */ +2015-03-10 18:06 UTC+0100 Przemyslaw Czerpak (druzus/at/poczta.onet.pl) + * contrib/hbtip/cgi.prg + * contrib/hbtip/client.prg + * contrib/hbtip/encb64.prg + * contrib/hbtip/encoder.prg + * contrib/hbtip/encqp.prg + * contrib/hbtip/mail.prg + * contrib/hbtip/sendmail.prg + * synced manually with Viktor's branch (not all things). + + * doc/xhb-diff.txt + ! fixed few typos + 2015-03-09 19:16 UTC+0100 Przemyslaw Czerpak (druzus/at/poczta.onet.pl) * contrib/hbtip/smtpcli.prg ! consume whole EHLO output after STARTTLS diff --git a/contrib/hbtip/cgi.prg b/contrib/hbtip/cgi.prg index 36e2bdac00..44e912d6be 100644 --- a/contrib/hbtip/cgi.prg +++ b/contrib/hbtip/cgi.prg @@ -60,10 +60,7 @@ #include "fileio.ch" -#define CGI_IN 0 -#define CGI_OUT 1 #define _CRLF Chr( 13 ) + Chr( 10 ) -#define _BR "
" CREATE CLASS TIPCgi @@ -104,83 +101,63 @@ ENDCLASS METHOD New() CLASS TIPCgi - LOCAL aTemp LOCAL aVar - LOCAL lPost - LOCAL nCount LOCAL nLen LOCAL nRead LOCAL cTemp + LOCAL item ::bSavedErrHandler := ErrorBlock( {| e | ::ErrHandler( e ) } ) ::cCgiHeader := "" ::cHtmlPage := "" - lPost := ( "POST" $ Upper( GetEnv( "REQUEST_METHOD" ) ) ) - IF lPost + IF "POST" $ Upper( GetEnv( "REQUEST_METHOD" ) ) nLen := Val( GetEnv( "CONTENT_LENGTH" ) ) cTemp := Space( nLen ) - IF ( ( nRead := FRead( CGI_IN, @cTemp, nLen ) ) != nLen ) + IF ( nRead := FRead( hb_GetStdIn(), @cTemp, nLen ) ) != nLen ::ErrHandler( "post error read " + hb_ntos( nRead ) + " instead of " + hb_ntos( nLen ) ) ELSE ::HTTP_RAW_POST_DATA := cTemp - 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( tip_URLDecode( aVar[ 1 ] ) ) ] := tip_URLDecode( 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( tip_URLDecode( aVar[ 1 ] ) ) ] := tip_URLDecode( aVar[ 2 ] ) - ENDIF - NEXT - ENDIF - ENDIF - ENDIF - - 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( tip_URLDecode( aVar[ 1 ] ) ) ] := tip_URLDecode( aVar[ 2 ] ) + FOR EACH item IN hb_ATokens( cTemp, "&" ) + IF Len( aVar := hb_ATokens( item, "=" ) ) == 2 + ::hPosts[ AllTrim( tip_URLDecode( aVar[ 1 ] ) ) ] := tip_URLDecode( aVar[ 2 ] ) ENDIF NEXT ENDIF + ELSEIF ! Empty( cTemp := GetEnv( "QUERY_STRING" ) ) + FOR EACH item IN hb_ATokens( cTemp, "&" ) + IF Len( aVar := hb_ATokens( item, "=" ) ) == 2 + ::hGets[ AllTrim( tip_URLDecode( aVar[ 1 ] ) ) ] := tip_URLDecode( aVar[ 2 ] ) + ENDIF + NEXT + ENDIF + + IF ! Empty( cTemp := GetEnv( "HTTP_COOKIE" ) ) + FOR EACH item IN hb_ATokens( cTemp, ";" ) + IF Len( aVar := hb_ATokens( item, "=" ) ) == 2 + ::hCookies[ AllTrim( tip_URLDecode( aVar[ 1 ] ) ) ] := tip_URLDecode( aVar[ 2 ] ) + ENDIF + NEXT ENDIF RETURN Self METHOD Header( cValue ) CLASS TIPCgi - IF Empty( cValue ) - ::cCgiHeader += "Content-Type: text/html" + _CRLF - ELSE + IF HB_ISSTRING( cValue ) .AND. ! Empty( cValue ) ::cCgiHeader += cValue + _CRLF + ELSE + ::cCgiHeader += "Content-Type: text/html" + _CRLF ENDIF RETURN Self METHOD Redirect( cUrl ) CLASS TIPCgi - ::cCgiHeader += "Location: " + cUrl + _CRLF + IF HB_ISSTRING( cUrl ) .AND. ! Empty( cUrl ) + ::cCgiHeader += "Location: " + cUrl + _CRLF + ENDIF RETURN Self @@ -192,62 +169,43 @@ METHOD Flush() CLASS TIPCgi LOCAL nH LOCAL cFile - LOCAL cSID := ::cSID LOCAL cSession hb_HEval( ::hCookies, {| k, v | ::cCgiHeader += "Set-Cookie: " + k + "=" + v + ";" + _CRLF } ) cStream := ::cCgiHeader + _CRLF + ::cHtmlPage + _CRLF - lRet := ( FWrite( CGI_OUT, cStream ) == hb_BLen( cStream ) ) + lRet := ( FWrite( hb_GetStdOut(), cStream ) == hb_BLen( cStream ) ) IF ::lDumpHtml IF Empty( ::cDumpSavePath ) ::cDumpSavePath := hb_DirTemp() ENDIF - IF ( nH := FCreate( ::cDumpSavePath + "dump.html", FC_NORMAL ) ) != F_ERROR - FWrite( nH, ::cHtmlPage ) - ENDIF - FClose( nH ) + hb_MemoWrit( ::cDumpSavePath + "dump.html", ::cHtmlPage ) ENDIF ::cCgiHeader := "" ::cHtmlPage := "" - IF ! Empty( cSID ) + IF ! Empty( ::cSID ) - cFile := ::cSessionSavePath + "SESSIONID_" + cSID + cFile := ::cSessionSavePath + "SESSIONID_" + ::cSID - IF ( nH := FCreate( cFile, FC_NORMAL ) ) != F_ERROR + IF ( nH := FCreate( cFile ) ) != F_ERROR cSession := ::SessionEncode() IF FWrite( nH, cSession ) != hb_BLen( cSession ) - ::Write( "ERROR: On writing session file : " + cFile + ", File error : " + hb_CStr( FError() ) ) + ::Write( "ERROR: On writing session file: " + cFile + ", File error: " + hb_CStr( FError() ) ) ENDIF FClose( nH ) ELSE - ::Write( "ERROR: On writing session file : " + cFile + ", File error : " + hb_CStr( FError() ) ) + ::Write( "ERROR: On writing session file: " + cFile + ", File error: " + hb_CStr( FError() ) ) ENDIF ENDIF RETURN lRet METHOD SaveHtmlPage( cFile ) CLASS TIPCgi - - LOCAL nFile - LOCAL lSuccess - LOCAL cStream - - nFile := FCreate( cFile ) - - IF nFile != F_ERROR - cStream := ::cHtmlPage + _CRLF - lSuccess := ( FWrite( nFile, cStream ) == hb_BLen( cStream ) ) - FClose( nFile ) - ELSE - lSuccess := .F. - ENDIF - - RETURN lSuccess + RETURN hb_MemoWrit( cFile, ::cHtmlPage + _CRLF ) METHOD StartSession( cSID ) CLASS TIPCgi @@ -256,16 +214,12 @@ METHOD StartSession( cSID ) CLASS TIPCgi LOCAL nFileSize LOCAL cBuffer - IF Empty( cSID ) - - IF ( nH := hb_HPos( ::hGets, "SESSIONID" ) ) != 0 - cSID := hb_HValueAt( ::hGets, nH ) - ELSEIF ( nH := hb_HPos( ::hPosts, "SESSIONID" ) ) != 0 - cSID := hb_HValueAt( ::hPosts, nH ) - ELSEIF ( nH := hb_HPos( ::hCookies, "SESSIONID" ) ) != 0 - cSID := hb_HValueAt( ::hCookies, nH ) - ENDIF - + IF ! HB_ISSTRING( cSID ) .OR. Empty( cSID ) + DO CASE + CASE hb_HGetRef( ::hGets, "SESSIONID", @cSID ) + CASE hb_HGetRef( ::hPosts, "SESSIONID", @cSID ) + CASE hb_HGetRef( ::hCookies, "SESSIONID", @cSID ) + ENDCASE ENDIF IF Empty( ::cSessionSavePath ) @@ -279,26 +233,23 @@ METHOD StartSession( cSID ) CLASS TIPCgi cFile := ::cSessionSavePath + "SESSIONID_" + cSID IF hb_FileExists( cFile ) - IF ( nH := FOpen( cFile, FO_READ ) ) != F_ERROR + IF ( nH := FOpen( cFile ) ) != F_ERROR nFileSize := FSeek( nH, 0, FS_END ) FSeek( nH, 0, FS_SET ) cBuffer := Space( nFileSize ) - IF ( FRead( nH, @cBuffer, nFileSize ) ) != nFileSize - ::ErrHandler( "ERROR: On reading session file : " + cFile + ", File error : " + hb_CStr( FError() ) ) + IF FRead( nH, @cBuffer, nFileSize ) != nFileSize + ::ErrHandler( "ERROR: On reading session file: " + cFile + ", File error: " + hb_CStr( FError() ) ) ELSE ::SessionDecode( cBuffer ) ENDIF FClose( nH ) ENDIF ELSE - ::ErrHandler( "ERROR: On opening session file : " + cFile + ", file not exist." ) + ::ErrHandler( "ERROR: On opening session file: " + cFile + ", file not exist." ) ENDIF - ELSE - ::CreateSID() ::hSession := { => } - ENDIF ::hCookies[ "SESSIONID" ] := ::cSID @@ -306,23 +257,21 @@ METHOD StartSession( cSID ) CLASS TIPCgi RETURN Self METHOD SessionEncode() CLASS TIPCgi - RETURN hb_Serialize( ::hSession ) METHOD SessionDecode( cData ) CLASS TIPCgi - - ::hSession := hb_Deserialize( cData ) - - RETURN HB_ISHASH( ::hSession ) + RETURN HB_ISHASH( ::hSession := hb_Deserialize( cData ) ) METHOD DestroySession( cID ) CLASS TIPCgi LOCAL cFile - LOCAL cSID := ::cSID - LOCAL lRet + LOCAL cSID + LOCAL lOk - IF ! Empty( cID ) + IF HB_ISSTRING( cID ) .AND. ! Empty( cID ) cSID := cID + ELSE + cSID := ::cSID ENDIF IF ! Empty( cSID ) @@ -331,41 +280,39 @@ METHOD DestroySession( cID ) CLASS TIPCgi cFile := ::cSessionSavePath + "SESSIONID_" + cSID - IF !( lRet := ( FErase( cFile ) == 0 ) ) - ::Write( "ERROR: On deleting session file : " + cFile + ", File error : " + hb_CStr( FError() ) ) - ELSE + IF ( lOk := ( FErase( cFile ) != F_ERROR ) ) ::hCookies[ "SESSIONID" ] := cSID + "; expires= " + tip_DateToGMT( Date() - 1 ) ::CreateSID() - cSID := ::cSID - ::hCookies[ "SESSIONID" ] := cSID + ::hCookies[ "SESSIONID" ] := ::cSID + ELSE + ::Write( "ERROR: On deleting session file: " + cFile + ", File error: " + hb_CStr( FError() ) ) ENDIF - ENDIF - RETURN lRet + RETURN lOk METHOD ErrHandler( xError ) CLASS TIPCgi LOCAL nCalls - LOCAL cErrMsg := "" - cErrMsg += '' + LOCAL cErrMsg := ; + '
' + ; + "" - cErrMsg += "" - - IF HB_ISOBJECT( xError ) - cErrMsg += "" - cErrMsg += "" - cErrMsg += "" - cErrMsg += "" - ELSEIF HB_ISSTRING( xError ) + DO CASE + CASE HB_ISOBJECT( xError ) + cErrMsg += ; + "" + ; + "" + ; + "" + ; + "" + CASE HB_ISSTRING( xError ) cErrMsg += "" - ENDIF + ENDCASE - nCalls := 1 - DO WHILE ! Empty( ProcName( nCalls ) ) + nCalls := 0 + DO WHILE ! Empty( ProcName( ++nCalls ) ) cErrMsg += "" - nCalls++ ENDDO cErrMsg += "
SCRIPT NAME:" + GetEnv( "SCRIPT_NAME" ) + "
SCRIPT NAME:" + GetEnv( "SCRIPT_NAME" ) + "
CRITICAL ERROR:" + xError:Description + "
OPERATION:" + xError:Operation + "
OS ERROR:" + hb_ntos( xError:OsCode ) + " IN " + xError:SubSystem + "/" + hb_ntos( xError:SubCode ) + "
FILENAME:" + Right( xError:FileName, 40 ) + "
CRITICAL ERROR:" + xError:Description + "
OPERATION:" + xError:Operation + "
OS ERROR:" + hb_ntos( xError:OsCode ) + " IN " + xError:SubSystem + "/" + hb_ntos( xError:SubCode ) + "
FILENAME:" + Right( xError:FileName, 40 ) + "
ERROR MESSAGE:" + tip_HtmlSpecialChars( xError ) + "
PROC/LINE:" + ProcName( nCalls ) + "/" + hb_ntos( ProcLine( nCalls ) ) + "
" @@ -389,19 +336,15 @@ METHOD Write( cString ) CLASS TIPCgi METHOD StartHtml( hOptions ) CLASS TIPCgi ::cHtmlPage += ; - '" + _CRLF + ; - '' + _CRLF + ; - '' + ; - "" + ; + "" + _CRLF + ; + "" + ; + '' + ; HtmlTag( hOptions, "title", "title" ) + ; HtmlScript( hOptions ) + ; HtmlStyle( hOptions ) + ; HtmlLinkRel( hOptions ) + ; "" + ; - "" + "" RETURN Self @@ -413,57 +356,43 @@ METHOD EndHtml() CLASS TIPCgi STATIC FUNCTION HtmlTag( xVal, cKey, cDefault ) - LOCAL cVal := "" + LOCAL cVal - hb_default( @cDefault, "" ) - - IF ! Empty( xVal ) .AND. ! Empty( cKey ) - IF hb_HHasKey( xVal, cKey ) - cVal := xVal[ cKey ] - hb_HDel( xVal, cKey ) - ENDIF + IF HB_ISHASH( xVal ) .AND. ! Empty( cKey ) .AND. cKey $ xVal + cVal := xVal[ cKey ] + hb_HDel( xVal, cKey ) + ELSE + cVal := "" ENDIF IF cVal == "" - cVal := cDefault + cVal := hb_defaultValue( cDefault, "" ) ENDIF - IF !( cVal == "" ) - cVal := "<" + cKey + ">" + cVal + "" + IF cVal == "" + RETURN cVal ENDIF - RETURN cVal - -/* -STATIC FUNCTION HtmlAllTag( hTags, cSep ) - - LOCAL cVal := "" - - hb_default( @cSep, " " ) - - hb_HEval( hTags, {| k | cVal += HtmlTag( hTags, k ) + cSep } ) - - RETURN cVal -*/ + RETURN "<" + cKey + ">" + cVal + "" STATIC FUNCTION HtmlOption( xVal, cKey, cPre, cPost, lScan ) LOCAL cVal := "" - IF ! Empty( xVal ) + IF HB_ISHASH( xVal ) IF Empty( cKey ) cVal := xVal - ELSEIF hb_HHasKey( xVal, cKey ) + ELSEIF cKey $ xVal cVal := xVal[ cKey ] - IF Empty( lScan ) + IF hb_defaultValue( lScan, .F. ) hb_HDel( xVal, cKey ) ENDIF - cVal := cKey + '="' + cVal + '"' - IF cPre != NIL + cVal := cKey + "=" + '"' + cVal + '"' + IF HB_ISSTRING( cPre ) cVal := cPre + cVal ENDIF - IF cPost != NIL - cVal := cVal + cPost + IF HB_ISSTRING( cPost ) + cVal += cPost ENDIF ENDIF ENDIF @@ -474,7 +403,7 @@ STATIC FUNCTION HtmlAllOption( hOptions, cSep ) LOCAL cVal := "" - IF ! Empty( hOptions ) + IF HB_ISHASH( hOptions ) hb_default( @cSep, " " ) hb_HEval( hOptions, {| k | cVal += HtmlOption( hOptions, k,,, .T. ) + cSep } ) @@ -482,153 +411,97 @@ STATIC FUNCTION HtmlAllOption( hOptions, cSep ) RETURN cVal -/* -STATIC FUNCTION HtmlValue( xVal, cKey, cDefault ) - - LOCAL cVal := "" - - hb_default( @cDefault, "" ) - - IF ! Empty( xVal ) .AND. ! Empty( cKey ) - IF hb_HHasKey( xVal, cKey ) - cVal := xVal[ cKey ] - hb_HDel( xVal, cKey ) - ENDIF - ENDIF - - IF cVal == "" - cVal := cDefault - ENDIF - - RETURN cVal - -STATIC FUNCTION HtmlAllValue( hValues, cSep ) - - LOCAL cVal := "" - - IF ! Empty( hValues ) - hb_default( @cSep, " " ) - - hb_HEval( hValues, {| k | cVal += HtmlValue( hValues, k ) + cSep } ) - ENDIF - - RETURN cVal -*/ - STATIC FUNCTION HtmlScript( hVal, cKey ) - LOCAL hTmp LOCAL cRet := "" + + LOCAL hTmp LOCAL cVal - LOCAL nPos LOCAL cTmp hb_default( @cKey, "script" ) - IF ! Empty( hVal ) - IF ( nPos := hb_HPos( hVal, cKey ) ) != 0 - hTmp := hb_HValueAt( hVal, nPos ) - IF HB_ISHASH( hTmp ) - IF ( nPos := hb_HPos( hTmp, "src" ) ) != 0 - cVal := hb_HValueAt( hTmp, nPos ) - IF HB_ISSTRING( cVal ) - cVal := { cVal } - ENDIF - IF HB_ISARRAY( cVal ) - cTmp := "" - AScan( cVal, {| cFile | cTmp += '' + _CRLF } ) - cRet += cTmp - ENDIF - ENDIF - IF ( nPos := hb_HPos( hTmp, "var" ) ) != 0 - cVal := hb_HValueAt( hTmp, nPos ) - IF HB_ISSTRING( cVal ) - cVal := { cVal } - ENDIF - IF HB_ISARRAY( cVal ) - cTmp := "" - AScan( cVal, {| cVar | cTmp += cVar } ) - cRet += '" + _CRLF - ENDIF - ENDIF + IF hb_HGetRef( hVal, cKey, @hTmp ) + IF hb_HGetRef( hTmp, "src", @cVal ) + IF HB_ISSTRING( cVal ) + cVal := { cVal } + ENDIF + IF HB_ISARRAY( cVal ) + cTmp := "" + AScan( cVal, {| cFile | cTmp += '' + _CRLF } ) + cRet += cTmp ENDIF - hb_HDel( hVal, cKey ) ENDIF + IF hb_HGetRef( hTmp, "var", @cVal ) + IF HB_ISSTRING( cVal ) + cVal := { cVal } + ENDIF + IF HB_ISARRAY( cVal ) + cTmp := "" + AScan( cVal, {| cVar | cTmp += cVar } ) + cRet += '" + _CRLF + ENDIF + ENDIF + hb_HDel( hVal, cKey ) ENDIF RETURN cRet STATIC FUNCTION HtmlStyle( hVal, cKey ) - LOCAL hTmp LOCAL cRet := "" + + LOCAL hTmp LOCAL cVal - LOCAL nPos LOCAL cTmp hb_default( @cKey, "style" ) - IF ! Empty( hVal ) - IF ( nPos := hb_HPos( hVal, cKey ) ) != 0 - hTmp := hb_HValueAt( hVal, nPos ) - IF HB_ISHASH( hTmp ) - IF ( nPos := hb_HPos( hTmp, "src" ) ) != 0 - cVal := hb_HValueAt( hTmp, nPos ) - IF HB_ISSTRING( cVal ) - cVal := { cVal } - ENDIF - IF HB_ISARRAY( cVal ) - cTmp := "" - AScan( cVal, {| cFile | cTmp += '' + _CRLF } ) - cRet += cTmp - ENDIF - ENDIF - IF ( nPos := hb_HPos( hTmp, "var" ) ) != 0 - cVal := hb_HValueAt( hTmp, nPos ) - IF HB_ISSTRING( cVal ) - cVal := { cVal } - ENDIF - IF HB_ISARRAY( cVal ) - cTmp := "" - AScan( cVal, {| cVar | cTmp += cVar } ) - cRet += '" + _CRLF - ENDIF - ENDIF + IF hb_HGetRef( hVal, cKey, @hTmp ) + IF hb_HGetRef( hTmp, "src", @cVal ) + IF HB_ISSTRING( cVal ) + cVal := { cVal } + ENDIF + IF HB_ISARRAY( cVal ) + cTmp := "" + AScan( cVal, {| cFile | cTmp += '' + _CRLF } ) + cRet += cTmp ENDIF - hb_HDel( hVal, cKey ) ENDIF + IF hb_HGetRef( hTmp, "var", @cVal ) + IF HB_ISSTRING( cVal ) + cVal := { cVal } + ENDIF + IF HB_ISARRAY( cVal ) + cTmp := "" + AScan( cVal, {| cVar | cTmp += cVar } ) + cRet += '" + _CRLF + ENDIF + ENDIF + hb_HDel( hVal, cKey ) ENDIF RETURN cRet STATIC FUNCTION HtmlLinkRel( hVal, cKey ) - LOCAL hTmp LOCAL cRet := "" + + LOCAL hTmp LOCAL cVal - LOCAL nPos - LOCAL cTmp hb_default( @cKey, "link" ) - IF ! Empty( hVal ) - IF ( nPos := hb_HPos( hVal, cKey ) ) != 0 - hTmp := hb_HValueAt( hVal, nPos ) - IF HB_ISHASH( hTmp ) - IF ( nPos := hb_HPos( hTmp, "rel" ) ) != 0 - cVal := hb_HValueAt( hTmp, nPos ) - IF HB_ISSTRING( cVal ) - cVal := { cVal, cVal } - ENDIF - IF HB_ISARRAY( cVal ) - cTmp := "" - AScan( cVal, {| aVal | cTmp += '' + _CRLF } ) - cRet += cTmp - ENDIF - ENDIF + IF hb_HGetRef( hVal, cKey, @hTmp ) + IF hb_HGetRef( hTmp, "rel", @cVal ) + IF HB_ISSTRING( cVal ) + cVal := { cVal, cVal } + ENDIF + IF HB_ISARRAY( cVal ) + AScan( cVal, {| aVal | cRet += '' + _CRLF } ) ENDIF - hb_HDel( hVal, cKey ) ENDIF + hb_HDel( hVal, cKey ) ENDIF RETURN cRet diff --git a/contrib/hbtip/client.prg b/contrib/hbtip/client.prg index d87e60c20a..c08ed3349f 100644 --- a/contrib/hbtip/client.prg +++ b/contrib/hbtip/client.prg @@ -75,7 +75,7 @@ #include "fileio.ch" #if defined( _SSL_DEBUG_TEMP ) -# include "simpleio.ch" + #include "simpleio.ch" #endif #include "hbssl.ch" @@ -85,9 +85,7 @@ #define RCV_BUF_SIZE Int( ::InetRcvBufSize( ::SocketCon ) / 2 ) #define SND_BUF_SIZE Int( ::InetSndBufSize( ::SocketCon ) / 2 ) -/** -* Inet Client class -*/ +/* Inet Client class */ CREATE CLASS TIPClient CLASS VAR bInitSocks INIT .F. @@ -142,14 +140,12 @@ CREATE CLASS TIPClient METHOD Read( nLen ) METHOD ReadToFile( cFile, nMode, nSize ) - METHOD Write( cData, nLen, bCommit ) + METHOD Write( cData, nLen, lCommit ) METHOD Commit() METHOD WriteFromFile( cFile ) METHOD Reset() METHOD Close() - /* METHOD Data( cData ) */ // commented: calls undeclared METHOD :getOk - METHOD SetProxy( cProxyHost, nProxyPort, cProxyUser, cProxyPassword ) METHOD lastErrorCode() INLINE ::nLastError @@ -166,8 +162,8 @@ CREATE CLASS TIPClient VAR nLastError INIT 0 - METHOD OpenProxy( cServer, nPort, cProxy, nProxyPort, cResp, cUserName, cPassWord, cUserAgent ) - METHOD ReadHTTPProxyResponse( sResponse ) + METHOD OpenProxy( cServer, nPort, cProxy, nProxyPort, cResp, cUserName, cPassword, cUserAgent ) + METHOD ReadHTTPProxyResponse( cResponse ) /* Methods to log data if needed */ METHOD inetRecv( SocketCon, cStr1, len ) @@ -187,12 +183,9 @@ METHOD New( oUrl, xTrace, oCredentials ) CLASS TIPClient LOCAL oErr LOCAL oLog + LOCAL lSSL - LOCAL aProtoAccepted := { "ftp", "http", "pop", "smtp" } - LOCAL aProtoAcceptedSSL := iif( ::lHasSSL, { "ftps", "https", "pop3s", "pops", "smtps" }, {} ) - - IF HB_ISSTRING( xTrace ) .OR. ; - ( HB_ISLOGICAL( xTrace ) .AND. xTrace ) + IF HB_ISSTRING( xTrace ) .OR. hb_defaultValue( xTrace, .F. ) oLog := TIPLog():New( iif( HB_ISSTRING( xTrace ), xTrace, NIL ) ) ::bTrace := {| cMsg | iif( PCount() > 0, oLog:Add( cMsg ), oLog:Close() ) } ELSEIF HB_ISEVALITEM( xTrace ) @@ -203,9 +196,23 @@ METHOD New( oUrl, xTrace, oCredentials ) CLASS TIPClient oUrl := TUrl():New( oUrl ) ENDIF - IF AScan( aProtoAccepted , {| tmp | tmp == oURL:cProto } ) == 0 .AND. ; - AScan( aProtoAcceptedSSL, {| tmp | tmp == oURL:cProto } ) == 0 - + SWITCH oURL:cProto + CASE "ftp" + CASE "http" + CASE "pop" + CASE "smtp" + lSSL := .F. + EXIT + CASE "ftps" + CASE "https" + CASE "pop3s" + CASE "pops" + CASE "smtps" + IF ::lHasSSL + lSSL := .T. + EXIT + ENDIF + OTHERWISE oErr := ErrorNew() oErr:Args := { Self, oURL:cProto } oErr:CanDefault := .F. @@ -218,61 +225,47 @@ METHOD New( oUrl, xTrace, oCredentials ) CLASS TIPClient oErr:SubCode := 1081 oErr:SubSystem := "BASE" Eval( ErrorBlock(), oErr ) - ENDIF + ENDSWITCH IF ! ::bInitSocks hb_inetInit() IF ::lHasSSL SSL_init() - RAND_seed( Time() + hb_UserName() + DToS( Date() ) + hb_DirBase() + NetName() ) + RAND_seed( hb_randStr( 20 ) + hb_UserName() + hb_TToS( hb_DateTime() ) + NetName() ) ENDIF ::bInitSocks := .T. ENDIF - IF ::lHasSSL - IF oURL:cProto == "ftps" .OR. ; - oURL:cProto == "https" .OR. ; - oURL:cProto == "pop3s" .OR. oURL:cProto == "pops" .OR. ; - oURL:cProto == "smtps" - ::EnableSSL( .T. ) - ENDIF + IF ::lHasSSL .AND. lSSL + ::EnableSSL( .T. ) ENDIF ::oUrl := oUrl ::oCredentials := oCredentials - RETURN self + RETURN Self METHOD Open( cUrl ) CLASS TIPClient LOCAL nPort - LOCAL cResp IF HB_ISSTRING( cUrl ) ::oUrl := TUrl():New( cUrl ) ENDIF - IF ::oUrl:nPort == -1 - nPort := ::nDefaultPort - ELSE - nPort := ::oUrl:nPort - ENDIF + nPort := iif( ::oUrl:nPort == -1, ::nDefaultPort, ::oUrl:nPort ) ::SocketCon := hb_inetCreate() ::InetTimeOut( ::SocketCon ) - IF ! Empty( ::cProxyHost ) - cResp := "" - IF ! ::OpenProxy( ::oUrl:cServer, nPort, ::cProxyHost, ::nProxyPort, @cResp, ::cProxyUser, ::cProxyPassword, "Mozilla/3.0 compatible" ) - RETURN .F. - ENDIF - ELSE + IF Empty( ::cProxyHost ) ::inetConnect( ::oUrl:cServer, nPort, ::SocketCon ) - IF ::inetErrorCode( ::SocketCon ) != 0 RETURN .F. ENDIF + ELSEIF ! ::OpenProxy( ::oUrl:cServer, nPort, ::cProxyHost, ::nProxyPort,, ::cProxyUser, ::cProxyPassword, "Mozilla/3.0 compatible" ) + RETURN .F. ENDIF ::isOpen := .T. @@ -306,7 +299,7 @@ METHOD EnableSSL( lEnable ) CLASS TIPClient RETURN lSuccess -METHOD OpenProxy( cServer, nPort, cProxy, nProxyPort, cResp, cUserName, cPassWord, cUserAgent ) CLASS TIPClient +METHOD OpenProxy( cServer, nPort, cProxy, nProxyPort, cResp, cUserName, cPassword, cUserAgent ) CLASS TIPClient LOCAL cRequest LOCAL lRet := .F. @@ -315,51 +308,43 @@ METHOD OpenProxy( cServer, nPort, cProxy, nProxyPort, cResp, cUserName, cPassWor ::inetConnect( cProxy, nProxyPort, ::SocketCon ) IF ( tmp := ::inetErrorCode( ::SocketCon ) ) == 0 - cRequest := "CONNECT " + cServer + ":" + hb_ntos( nPort ) + " HTTP/1.1" + Chr( 13 ) + Chr( 10 ) - IF ! Empty( cUserAgent ) - cRequest += "User-agent: " + cUserAgent + Chr( 13 ) + Chr( 10 ) + cRequest := ; + "CONNECT " + cServer + ":" + hb_ntos( nPort ) + " HTTP/1.1" + Chr( 13 ) + Chr( 10 ) + ; + "Proxy-Connection: Keep-Alive" + Chr( 13 ) + Chr( 10 ) + IF HB_ISSTRING( cUserAgent ) .AND. ! Empty( cUserAgent ) + cRequest += "User-Agent: " + cUserAgent + Chr( 13 ) + Chr( 10 ) ENDIF - IF ! Empty( cUserName ) - cRequest += "Proxy-authorization: Basic " + hb_base64Encode( cUserName + ":" + cPassWord ) + Chr( 13 ) + Chr( 10 ) + IF HB_ISSTRING( cUserName ) .AND. ! Empty( cUserName ) + cRequest += "Proxy-Authorization: Basic " + hb_base64Encode( cUserName + ":" + hb_defaultValue( cPassword, "" ) ) + Chr( 13 ) + Chr( 10 ) ENDIF cRequest += Chr( 13 ) + Chr( 10 ) ::inetSendAll( ::SocketCon, cRequest ) cResp := "" - IF ::ReadHTTPProxyResponse( @cResp ) - tmp := At( " ", cResp ) - IF tmp > 0 .AND. Val( SubStr( cResp, tmp + 1 ) ) == 200 - lRet := .T. - ENDIF - ENDIF - IF ! lRet + IF ::ReadHTTPProxyResponse( @cResp ) .AND. ; + ( tmp := At( " ", cResp ) ) > 0 .AND. ; + Val( SubStr( cResp, tmp + 1 ) ) == 200 + lRet := .T. + ELSE ::close() ENDIF ELSE cResp := hb_ntos( tmp ) - lRet := .F. ENDIF RETURN lRet -METHOD ReadHTTPProxyResponse( /* @ */ sResponse ) CLASS TIPClient +METHOD ReadHTTPProxyResponse( /* @ */ cResponse ) CLASS TIPClient - LOCAL bMoreDataToRead := .T. - LOCAL nLength, nData - LOCAL szResponse + LOCAL cBuffer - DO WHILE bMoreDataToRead - - szResponse := Space( 1 ) - nData := ::inetRecv( ::SocketCon, @szResponse, Len( szResponse ) ) - IF nData == 0 + DO WHILE .T. + cBuffer := Space( 1 ) + IF ::inetRecv( ::SocketCon, @cBuffer, hb_BLen( cBuffer ) ) <= 0 RETURN .F. ENDIF - sResponse += szResponse - - nLength := Len( sResponse ) - IF nLength >= 4 - bMoreDataToRead := !( SubStr( sResponse, nLength - 3, 1 ) == Chr( 13 ) .AND. SubStr( sResponse, nLength - 2, 1 ) == Chr( 10 ) .AND. ; - SubStr( sResponse, nLength - 1, 1 ) == Chr( 13 ) .AND. SubStr( sResponse, nLength, 1 ) == Chr( 10 ) ) + cResponse += cBuffer + IF hb_BRight( cResponse, 4 ) == e"\r\n\r\n" + EXIT ENDIF ENDDO @@ -367,13 +352,14 @@ METHOD ReadHTTPProxyResponse( /* @ */ sResponse ) CLASS TIPClient METHOD Close() CLASS TIPClient - LOCAL nRet := -1 - - IF ! Empty( ::SocketCon ) + LOCAL nRet + IF Empty( ::SocketCon ) + nRet := -1 + ELSE nRet := hb_inetClose( ::SocketCon ) - IF ::lHasSSL .AND. ::lSSL + IF ::lSSL .AND. ::lHasSSL SSL_shutdown( ::ssl ) ::ssl := NIL ::ssl_ctx := NIL @@ -409,31 +395,27 @@ METHOD Read( nLen ) CLASS TIPClient RETURN NIL ENDIF - IF Empty( nLen ) .OR. nLen < 0 .OR. ( ::nLength > 0 .AND. nLen > ::nLength - ::nRead ) + IF ! HB_ISNUMERIC( nLen ) .OR. nLen <= 0 .OR. ( ::nLength > 0 .AND. nLen > ::nLength - ::nRead ) nLen := ::nLength - ::nRead ENDIF - IF Empty( nLen ) .OR. nLen < 0 + IF nLen <= 0 // read till end of stream cStr1 := Space( RCV_BUF_SIZE ) cStr0 := "" - ::nLastRead := ::inetRecv( ::SocketCon, @cStr1, RCV_BUF_SIZE ) - DO WHILE ::nLastRead > 0 + DO WHILE ( ::nLastRead := ::inetRecv( ::SocketCon, @cStr1, RCV_BUF_SIZE ) ) > 0 ::nRead += ::nLastRead - cStr0 += Left( cStr1, ::nLastRead ) - ::nLastRead := ::inetRecv( ::SocketCon, @cStr1, RCV_BUF_SIZE ) + cStr0 += hb_BLeft( cStr1, ::nLastRead ) ENDDO ::bEof := .T. ELSE // read an amount of data cStr0 := Space( nLen ) - IF ::lSSL - IF ::lHasSSL - /* Getting around implementing the hack used in non-SSL branch for now. - IMO the proper fix would have been done to hb_inetRecvAll(). [vszakats] */ - ::nLastRead := ::inetRecvAll( ::SocketCon, @cStr0, nLen ) - ENDIF + IF ::lSSL .AND. ::lHasSSL + /* Getting around implementing the hack used in non-SSL branch for now. + IMO the proper fix would have been done to hb_inetRecvAll(). [vszakats] */ + ::nLastRead := ::inetRecvAll( ::SocketCon, @cStr0, nLen ) ELSE // S.R. if len of file is less than RCV_BUF_SIZE hb_inetRecvAll return 0 // ::nLastRead := ::InetRecvAll( ::SocketCon, @cStr0, nLen ) @@ -444,8 +426,10 @@ METHOD Read( nLen ) CLASS TIPClient IF ::nLastRead != nLen ::bEof := .T. - cStr0 := Left( cStr0, ::nLastRead ) - // S.R. RETURN NIL + cStr0 := hb_BLeft( cStr0, ::nLastRead ) +#if 0 + RETURN NIL +#endif ENDIF IF ::nRead == ::nLength @@ -455,49 +439,53 @@ METHOD Read( nLen ) CLASS TIPClient RETURN cStr0 -METHOD ReadToFile( cFile, nMode, nSize ) CLASS TIPClient +METHOD ReadToFile( /* @ */ cFile, nMode, nSize ) CLASS TIPClient - LOCAL nFout + LOCAL nFOut LOCAL cData - LOCAL nSent + LOCAL nSent := 0 - hb_default( @nMode, FC_NORMAL ) + LOCAL lToMemory := hb_PIsByRef( 1 ) - nSent := 0 + hb_default( @nSize, 0 ) - IF ! Empty( ::exGauge ) - hb_ExecFromArray( ::exGauge, { nSent, nSize, Self } ) + IF lToMemory + cFile := "" + ENDIF + + IF HB_ISEVALITEM( ::exGauge ) + Eval( ::exGauge, nSent, nSize, Self ) ENDIF ::nRead := 0 ::nStatus := 1 DO WHILE ::inetErrorCode( ::SocketCon ) == 0 .AND. ! ::bEof - cData := ::Read( RCV_BUF_SIZE ) - IF cData == NIL - IF nFout != NIL - FClose( nFout ) + IF ( cData := ::Read( RCV_BUF_SIZE ) ) == NIL + IF nFOut != NIL + FClose( nFOut ) ENDIF RETURN ::inetErrorCode( ::SocketCon ) == 0 ENDIF - IF nFout == NIL - nFout := FCreate( cFile, nMode ) - IF nFout == F_ERROR + IF ! lToMemory .AND. nFOut == NIL + IF ( nFOut := FCreate( cFile, nMode ) ) == F_ERROR ::nStatus := 0 RETURN .F. ENDIF ENDIF - IF FWrite( nFout, cData ) != hb_BLen( cData ) - FClose( nFout ) + IF lToMemory + cFile += cData + ELSEIF FWrite( nFOut, cData ) != hb_BLen( cData ) + FClose( nFOut ) RETURN .F. ENDIF - nSent += Len( cData ) - IF ! Empty( ::exGauge ) - hb_ExecFromArray( ::exGauge, { nSent, nSize, Self } ) - ENDIF + nSent += hb_BLen( cData ) + IF HB_ISEVALITEM( ::exGauge ) + Eval( ::exGauge, nSent, nSize, Self ) + ENDIF ENDDO IF nSent > 0 @@ -505,50 +493,47 @@ METHOD ReadToFile( cFile, nMode, nSize ) CLASS TIPClient ENDIF ::nStatus := 2 - FClose( nFout ) - IF ::inetErrorCode( ::SocketCon ) != 0 - RETURN .F. + IF nFOut != NIL + FClose( nFOut ) ENDIF - RETURN .T. + RETURN ::inetErrorCode( ::SocketCon ) == 0 METHOD WriteFromFile( cFile ) CLASS TIPClient - LOCAL nFin + LOCAL nFIn LOCAL cData LOCAL nLen LOCAL nSize, nSent, nBufSize ::nWrite := 0 ::nStatus := 0 - nFin := FOpen( cFile, FO_READ ) - IF nFin == F_ERROR + IF ( nFIn := FOpen( cFile ) ) == F_ERROR RETURN .F. ENDIF - nSize := FSeek( nFin, 0, FS_END ) - FSeek( nFin, 0 ) + nSize := FSeek( nFIn, 0, FS_END ) + FSeek( nFIn, 0 ) nBufSize := SND_BUF_SIZE // allow initialization of the gauge nSent := 0 - IF ! Empty( ::exGauge ) - hb_ExecFromArray( ::exGauge, { nSent, nSize, Self } ) + + IF HB_ISEVALITEM( ::exGauge ) + Eval( ::exGauge, nSent, nSize, Self ) ENDIF ::nStatus := 1 cData := Space( nBufSize ) - nLen := FRead( nFin, @cData, nBufSize ) - DO WHILE nLen > 0 + DO WHILE ( nLen := FRead( nFIn, @cData, nBufSize ) ) > 0 IF ::Write( @cData, nLen ) != nLen - FClose( nFin ) + FClose( nFIn ) RETURN .F. ENDIF nSent += nLen - IF ! Empty( ::exGauge ) - hb_ExecFromArray( ::exGauge, { nSent, nSize, Self } ) + IF HB_ISEVALITEM( ::exGauge ) + Eval( ::exGauge, nSent, nSize, Self ) ENDIF - nLen := FRead( nFin, @cData, nBufSize ) ENDDO // it may happen that the file has length 0 @@ -557,32 +542,19 @@ METHOD WriteFromFile( cFile ) CLASS TIPClient ENDIF ::nStatus := 2 - FClose( nFin ) + FClose( nFIn ) RETURN .T. -#if 0 +METHOD Write( cData, nLen, lCommit ) CLASS TIPClient -/* HZ: METHOD :getOk() is not declared in TIPClient */ -METHOD Data( cData ) CLASS TIPClient - ::InetSendall( ::SocketCon, "DATA" + ::cCRLF ) - IF ! ::GetOk() - RETURN .F. - ENDIF - ::InetSendall(::SocketCon, cData + ::cCRLF + "." + ::cCRLF ) - RETURN ::GetOk() - -#endif - -METHOD Write( cData, nLen, bCommit ) CLASS TIPClient - - IF Empty( nLen ) - nLen := Len( cData ) + IF ! HB_ISNUMERIC( nLen ) .OR. nLen <= 0 + nLen := hb_BLen( cData ) ENDIF ::nLastWrite := ::inetSendAll( ::SocketCon, cData, nLen ) - IF ! Empty( bCommit ) .AND. bCommit + IF hb_defaultValue( lCommit, .F. ) ::Commit() ENDIF @@ -594,8 +566,8 @@ METHOD inetSendAll( SocketCon, cData, nLen ) CLASS TIPClient LOCAL nRet - IF Empty( nLen ) - nLen := Len( cData ) + IF ! HB_ISNUMERIC( nLen ) .OR. nLen <= 0 + nLen := hb_BLen( cData ) ENDIF IF ::lSSL @@ -732,44 +704,42 @@ METHOD inetErrorCode( SocketCon ) CLASS TIPClient METHOD inetErrorDesc( SocketCon ) CLASS TIPClient - LOCAL cMsg := "" - hb_default( @SocketCon, ::SocketCon ) IF ! Empty( SocketCon ) IF ::lSSL - IF ::lHasSSL - IF ::nSSLError != 0 - cMsg := ERR_error_string( SSL_get_error( ::ssl, ::nSSLError ) ) - ENDIF + IF ::lHasSSL .AND. ::nSSLError != 0 + RETURN ERR_error_string( SSL_get_error( ::ssl, ::nSSLError ) ) ENDIF ELSE - cMsg := hb_inetErrorDesc( SocketCon ) + RETURN hb_inetErrorDesc( SocketCon ) ENDIF ENDIF - RETURN cMsg + RETURN "" -/* BROKEN, should test number of parameters and act accordingly, see doc\inet.txt */ +/* BROKEN, should test number of parameters and act accordingly, see doc/inet.txt */ METHOD inetConnect( cServer, nPort, SocketCon ) CLASS TIPClient hb_inetConnect( cServer, nPort, SocketCon ) - IF hb_inetStatus( SocketCon ) == -1 /* IMPORTANT: if internet connection is off and address is not resolved and it is SSL compliant, then RTE , must be avoided - Pritpal*/ + /* IMPORTANT: if internet connection is off and address is not + resolved and it is SSL compliant, then RTE must + be avoided [pritpal] */ + IF hb_inetStatus( SocketCon ) == -1 RETURN NIL ENDIF - IF ! Empty( ::nDefaultSndBuffSize ) + IF hb_defaultValue( ::nDefaultSndBuffSize, 0 ) > 0 ::InetSndBufSize( SocketCon, ::nDefaultSndBuffSize ) ENDIF - IF ! Empty( ::nDefaultRcvBuffSize ) + IF hb_defaultValue( ::nDefaultRcvBuffSize, 0 ) > 0 ::InetRcvBufSize( SocketCon, ::nDefaultRcvBuffSize ) ENDIF - IF ::lHasSSL .AND. ::lSSL - ActivateSSL(Self) - /* TODO: Add error handling */ + IF ::lSSL .AND. ::lHasSSL + __tip_SSLConnectFD( ::ssl, SocketCon ) ENDIF IF HB_ISEVALITEM( ::bTrace ) @@ -781,7 +751,7 @@ METHOD inetConnect( cServer, nPort, SocketCon ) CLASS TIPClient /* Methods to manage buffers */ METHOD InetRcvBufSize( SocketCon, nSizeBuff ) CLASS TIPClient - IF ! Empty( nSizeBuff ) + IF HB_ISNUMERIC( nSizeBuff ) .AND. nSizeBuff > 0 hb_inetSetRcvBufSize( SocketCon, nSizeBuff ) ENDIF @@ -789,7 +759,7 @@ METHOD InetRcvBufSize( SocketCon, nSizeBuff ) CLASS TIPClient METHOD InetSndBufSize( SocketCon, nSizeBuff ) CLASS TIPClient - IF ! Empty( nSizeBuff ) + IF HB_ISNUMERIC( nSizeBuff ) .AND. nSizeBuff > 0 hb_inetSetSndBufSize( SocketCon, nSizeBuff ) ENDIF @@ -809,8 +779,7 @@ METHOD InetTimeOut( SocketCon, nConnTimeout ) CLASS TIPClient /* Called from another method with list of parameters and, as last parameter, return code of function being logged. Example, I want to log MyFunc( a, b, c ) which returns m, - ::Log( a, b, c, m ) -*/ + ::Log( a, b, c, m ) */ METHOD Log( ... ) CLASS TIPClient LOCAL xVar @@ -825,18 +794,18 @@ METHOD Log( ... ) CLASS TIPClient FOR EACH xVar IN hb_AParams() // Preserves CRLF on result - IF xVar:__enumIndex() < PCount() - cMsg += StrTran( StrTran( AllTrim( hb_CStr( xVar ) ), Chr( 13 ), "" ), Chr( 10 ), "" ) - ELSE + IF xVar:__enumIsLast() cMsg += hb_CStr( xVar ) + ELSE + cMsg += hb_StrReplace( AllTrim( hb_CStr( xVar ) ), Chr( 13 ) + Chr( 10 ), { "", "" } ) ENDIF - cMsg += iif( xVar:__enumIndex() < PCount() - 1, ", ", "" ) - - IF xVar:__enumIndex() == PCount() - 1 - cMsg += " )" + hb_eol() + ">> " - ELSEIF xVar:__enumIndex() == PCount() + IF xVar:__enumIsLast() cMsg += " <<" + hb_eol() + hb_eol() + ELSEIF xVar:__enumIndex() == PCount() - 1 + cMsg += " )" + hb_eol() + ">> " + ELSE + cMsg += ", " ENDIF NEXT @@ -847,25 +816,29 @@ METHOD Log( ... ) CLASS TIPClient METHOD SetProxy( cProxyHost, nProxyPort, cProxyUser, cProxyPassword ) CLASS TIPClient - ::cProxyHost := cProxyHost - ::nProxyPort := nProxyPort - ::cProxyUser := cProxyUser - ::cProxyPassword := cProxyPassword + IF __clsParent( cProxyHost:classH(), "TURL" ) + ::cProxyHost := cProxyHost:cServer + ::nProxyPort := cProxyHost:nPort + ::cProxyUser := cProxyHost:cUserid + ::cProxyPassword := cProxyHost:cPassword + ELSE + ::cProxyHost := hb_defaultValue( cProxyHost, "" ) + ::nProxyPort := hb_defaultValue( nProxyPort, 0 ) + ::cProxyUser := hb_defaultValue( cProxyUser, "" ) + ::cProxyPassword := hb_defaultValue( cProxyPassword, "" ) + ENDIF RETURN Self FUNCTION tip_SSL() RETURN hb_IsFunction( "__HBEXTERN__HBSSL__" ) -FUNCTION ActivateSSL(Self) -LOCAL SocketCon +FUNCTION __tip_SSLConnectFD( ssl, SocketCon ) - Hb_Default(@SocketCon, ::SocketCon ) - - SSL_set_mode( ::ssl, HB_SSL_MODE_AUTO_RETRY ) - SSL_set_fd( ::ssl, hb_inetFD( SocketCon ) ) - SSL_connect( ::ssl ) + SSL_set_mode( ssl, HB_SSL_MODE_AUTO_RETRY ) + SSL_set_fd( ssl, hb_inetFD( SocketCon ) ) + SSL_connect( ssl ) /* TODO: Add error handling */ - RETURN .T. \ No newline at end of file + RETURN .T. diff --git a/contrib/hbtip/encb64.prg b/contrib/hbtip/encb64.prg index 372e52dcfc..ea7f46dc5c 100644 --- a/contrib/hbtip/encb64.prg +++ b/contrib/hbtip/encb64.prg @@ -50,12 +50,12 @@ CREATE CLASS TIPEncoderBase64 FROM TIPEncoder - // Set this to .T. to enable RFC 2068 (HTTP/1.1) exception to - // RFC 2045 (MIME) base64 format. This exception consists in - // not applying CRLF after each 76 output bytes. - VAR bHttpExcept + /* Set this to .T. to enable RFC 2068 (HTTP/1.1) exception to + RFC 2045 (MIME) base64 format. This exception consists in + not applying CRLF after each 76 output bytes. */ + VAR bHttpExcept INIT .F. - METHOD New() Constructor + METHOD New() CONSTRUCTOR METHOD Encode( cData ) METHOD Decode( cData ) @@ -63,33 +63,12 @@ ENDCLASS METHOD New() CLASS TIPEncoderBase64 - ::cName := "Base64" - ::bHttpExcept := .F. + ::cName := "base64" RETURN Self METHOD Encode( cData ) CLASS TIPEncoderBase64 - RETURN tip_Base64Encode( cData, iif( ::bHttpExcept, NIL, 72 ), Chr( 13 ) + Chr( 10 ) ) + RETURN hb_base64Encode( cData, iif( ::bHttpExcept, NIL, 76 ) ) METHOD Decode( cData ) CLASS TIPEncoderBase64 RETURN hb_base64Decode( cData ) - -FUNCTION tip_Base64Encode( cBinary, nLineLength, cCRLF ) - - LOCAL cTextIn := hb_base64Encode( cBinary ) - - LOCAL cText - LOCAL tmp - - IF ! HB_ISNUMERIC( nLineLength ) - RETURN cTextIn - ENDIF - - hb_default( @cCRLF, hb_eol() ) - - cText := "" - FOR tmp := 1 TO Len( cTextIn ) STEP nLineLength - cText += SubStr( cTextIn, tmp, nLineLength ) + cCRLF - NEXT - - RETURN cText diff --git a/contrib/hbtip/encoder.prg b/contrib/hbtip/encoder.prg index 22c4061849..a85ce26944 100644 --- a/contrib/hbtip/encoder.prg +++ b/contrib/hbtip/encoder.prg @@ -58,54 +58,37 @@ #include "fileio.ch" -FUNCTION tip_GetEncoder( cModel ) - - LOCAL oEncoder - - hb_default( @cModel, "as-is" ) - - cModel := Lower( cModel ) - - DO CASE - CASE cModel == "base64" - oEncoder := TIPEncoderBase64():New() - - CASE cModel == "quoted-printable" - oEncoder := TIPEncoderQP():New() - - CASE cModel == "url" .OR. cModel == "urlencoded" - oEncoder := TIPEncoderUrl():New() - - CASE cModel == "7bit" .OR. cModel == "8bit" - oEncoder := TIPEncoder():New( cModel ) - oEncoder:cName := cModel - - OTHERWISE - oEncoder := TIPEncoder():New() - - ENDCASE - - RETURN oEncoder - CREATE CLASS TIPEncoder VAR cName - METHOD New( cModel ) + METHOD New( cMode ) METHOD Encode( cData ) METHOD Decode( cData ) ENDCLASS -METHOD New( cModel ) CLASS TIPEncoder +#define MODE_PASSTHROUGH "as-is" - hb_default( @cModel, "as-is" ) - ::cName := cModel +METHOD New( cMode ) CLASS TIPEncoder + + ::cName := Lower( hb_defaultValue( cMode, MODE_PASSTHROUGH ) ) RETURN Self METHOD Encode( cData ) CLASS TIPEncoder - RETURN cData + RETURN iif( ::cName == MODE_PASSTHROUGH, cData, tip_GetEncoder( ::cName ):Encode( cData ) ) METHOD Decode( cData ) CLASS TIPEncoder - RETURN cData + RETURN iif( ::cName == MODE_PASSTHROUGH, cData, tip_GetEncoder( ::cName ):Decode( cData ) ) + +FUNCTION tip_GetEncoder( cMode ) + + SWITCH Lower( hb_defaultValue( cMode, MODE_PASSTHROUGH ) ) + CASE "base64" ; RETURN TIPEncoderBase64():New() + CASE "quoted-printable" ; RETURN TIPEncoderQP():New() + CASE "url" + CASE "urlencoded" ; RETURN TIPEncoderUrl():New() + ENDSWITCH + + RETURN TIPEncoder():New() diff --git a/contrib/hbtip/encqp.prg b/contrib/hbtip/encqp.prg index b155bf745a..4359d64cd3 100644 --- a/contrib/hbtip/encqp.prg +++ b/contrib/hbtip/encqp.prg @@ -48,14 +48,7 @@ #include "hbclass.ch" -/* TOFIX: Removed TIPEncode as parent class to make it - work from a dynamically loaded hbtip library. - 'VAR cName' was the only inherited item/logic. - This should be reverted once derived classes - work fine from dynamically loaded libs. */ -CREATE CLASS TIPEncoderQP - - VAR cName +CREATE CLASS TIPEncoderQP FROM TIPEncoder METHOD New() CONSTRUCTOR METHOD Encode( cData ) @@ -86,20 +79,24 @@ FUNCTION tip_QPEncode( cData ) nLen := hb_BLen( cData ) FOR nPos := 1 TO nLen c := hb_BSubStr( cData, nPos, 1 ) - IF c == Chr( 13 ) + IF c == Chr( 10 ) cString += Chr( 13 ) + Chr( 10 ) nLineLen := 0 - ELSEIF hb_BCode( c ) > 126 .OR. ; + ELSEIF hb_BCode( c ) >= 127 .OR. ; c $ '=?!"#$@[\]^`{|}~' .OR. ; ( hb_BCode( c ) < 32 .AND. !( c $ Chr( 13 ) + Chr( 10 ) + Chr( 9 ) ) ) .OR. ; ( c $ " " + Chr( 9 ) .AND. hb_BSubStr( cData, nPos + 1, 1 ) $ Chr( 13 ) + Chr( 10 ) ) - IF nLineLen + 3 > 76 + IF nLineLen + 3 > 75 cString += "=" + Chr( 13 ) + Chr( 10 ) nLineLen := 0 ENDIF cString += "=" + hb_NumToHex( hb_BCode( c ), 2 ) nLineLen += 3 - ELSEIF !( c == Chr( 10 ) ) + ELSEIF !( c == Chr( 13 ) ) + IF nLineLen + 3 > 75 + cString += "=" + Chr( 13 ) + Chr( 10 ) + nLineLen := 0 + ENDIF cString += c nLineLen += 1 ENDIF @@ -116,7 +113,7 @@ FUNCTION tip_QPDecode( cData ) /* delete soft line break. */ cData := StrTran( cData, "=" + Chr( 13 ) + Chr( 10 ) ) - cData := StrTran( cData, "=" + Chr( 10 ) ) /* also delete non-standard line breaks */ + cData := StrTran( cData, "=" + Chr( 10 ) ) /* also delete non-standard line breaks */ nLen := hb_BLen( cData ) FOR nPos := 1 TO nLen diff --git a/contrib/hbtip/mail.prg b/contrib/hbtip/mail.prg index 86294b1218..724e423b4e 100644 --- a/contrib/hbtip/mail.prg +++ b/contrib/hbtip/mail.prg @@ -56,6 +56,7 @@ */ #include "hbclass.ch" +#include "fileio.ch" CREATE CLASS TIPMail @@ -746,3 +747,18 @@ FUNCTION tip_GetNameEmail( cAddress ) ENDIF RETURN cAddress + +FUNCTION __tip_FAttrToUmask( nAttr ) + RETURN hb_bitOr( ; + Min( hb_bitAnd( nAttr, HB_FA_SUID ), 1 ) * 0x4000, ; + Min( hb_bitAnd( nAttr, HB_FA_SGID ), 1 ) * 0x2000, ; + Min( hb_bitAnd( nAttr, HB_FA_SVTX ), 1 ) * 0x1000, ; + Min( hb_bitAnd( nAttr, HB_FA_RUSR ), 1 ) * 0x0400, ; + Min( hb_bitAnd( nAttr, HB_FA_WUSR ), 1 ) * 0x0200, ; + Min( hb_bitAnd( nAttr, HB_FA_XUSR ), 1 ) * 0x0100, ; + Min( hb_bitAnd( nAttr, HB_FA_RGRP ), 1 ) * 0x0040, ; + Min( hb_bitAnd( nAttr, HB_FA_WGRP ), 1 ) * 0x0020, ; + Min( hb_bitAnd( nAttr, HB_FA_XGRP ), 1 ) * 0x0010, ; + Min( hb_bitAnd( nAttr, HB_FA_ROTH ), 1 ) * 0x0004, ; + Min( hb_bitAnd( nAttr, HB_FA_WOTH ), 1 ) * 0x0002, ; + Min( hb_bitAnd( nAttr, HB_FA_XOTH ), 1 ) * 0x0001 ) diff --git a/contrib/hbtip/sendmail.prg b/contrib/hbtip/sendmail.prg index 800d007731..08b8967edf 100644 --- a/contrib/hbtip/sendmail.prg +++ b/contrib/hbtip/sendmail.prg @@ -54,34 +54,34 @@ FUNCTION hb_SendMail( cServer, nPort, cFrom, xTo, xCC, xBCC, cBody, cSubject, ; aFiles, cUser, cPass, cPopServer, nPriority, lRead, ; xTrace, lPopAuth, lNoAuth, nTimeOut, cReplyTo, ; lSSL, cSMTPPass, cCharset, cEncoding, cClientHost ) - /* - cServer -> Required. IP or domain name of the mail server - nPort -> Optional. Port used my email server - cFrom -> Required. Email address of the sender - xTo -> Required. Character string or array of email addresses to send the email to - xCC -> Optional. Character string or array of email adresses for CC (Carbon Copy) - xBCC -> Optional. Character string or array of email adresses for BCC (Blind Carbon Copy) - cBody -> Optional. The body message of the email as text, or the filename of the HTML message to send. - cSubject -> Optional. Subject of the sending email - aFiles -> Optional. Array of attachments to the email to send - cUser -> Required. User name for the POP3 server - cPass -> Required. Password for cUser - cPopServer -> Required. POP3 server name or address - nPriority -> Optional. Email priority: 1=High, 3=Normal (Standard), 5=Low - lRead -> Optional. If set to .T., a confirmation request is send. Standard setting is .F. - xTrace -> Optional. If set to .T., a log file is created (smtp-.log). Standard setting is .F. - If a block is passed, it will be called for each log event with the message a string, no param on session close. - lPopAuth -> Optional. Do POP3 authentication before sending mail. - lNoAuth -> Optional. Disable Autentication methods - nTimeOut -> Optional. Number os ms to wait default 10000 (10s) - cReplyTo -> Optional. - lSSl -> Optional. Need SSL at connect time (TLS need this param set to False) - cSMTPPass -> Optional. - cCharset -> Optional. - cEncoding -> Optional. - cClientHost-> Optional. Domain name of the SMTP client in the format smtp.example.com OR client IP surrounded by brackets as in [200.100.100.5] - Note: This parameter is optional for backwards compatibility, but should be provided to comply with RFC 2812. - */ +/* + cServer -> Required. IP or domain name of the mail server + nPort -> Optional. Port used my email server + cFrom -> Required. Email address of the sender + xTo -> Required. Character string or array of email addresses to send the email to + xCC -> Optional. Character string or array of email addresses for CC (Carbon Copy) + xBCC -> Optional. Character string or array of email addresses for BCC (Blind Carbon Copy) + cBody -> Optional. The body message of the email as text, or the filename of the HTML message to send. + cSubject -> Optional. Subject of the sending email + aFiles -> Optional. Array of attachments to the email to send + cUser -> Required. User name for the POP3 server + cPass -> Required. Password for cUser + cPopServer -> Required. POP3 server name or address + nPriority -> Optional. Email priority: 1=High, 3=Normal (Standard), 5=Low + lRead -> Optional. If set to .T., a confirmation request is send. Standard setting is .F. + xTrace -> Optional. If set to .T., a log file is created (smtp-.log). Standard setting is .F. + If a block is passed, it will be called for each log event with the message a string, no param on session close. + lPopAuth -> Optional. Do POP3 authentication before sending mail. + lNoAuth -> Optional. Disable Autentication methods + nTimeOut -> Optional. Number os ms to wait default 10000 (10s) + cReplyTo -> Optional. + lSSL -> Optional. Need SSL at connect time (TLS need this param set to False) + cSMTPPass -> Optional. + cCharset -> Optional. + cEncoding -> Optional. + cClientHost -> Optional. Domain name of the SMTP client in the format smtp.example.com OR client IP surrounded by brackets as in [200.100.100.5] + Note: This parameter is optional for backwards compatibility, but should be provided to comply with RFC 2812. +*/ LOCAL cTmp LOCAL cTo @@ -94,9 +94,6 @@ FUNCTION hb_SendMail( cServer, nPort, cFrom, xTo, xCC, xBCC, cBody, cSubject, ; LOCAL oUrl1 LOCAL lConnectPlain := .F. - LOCAL lReturn := .T. - //LOCAL lAuthLogin := .F. - //LOCAL lAuthPlain := .F. LOCAL lAuthTLS := .F. LOCAL lConnect := .T. LOCAL oPop @@ -126,25 +123,20 @@ FUNCTION hb_SendMail( cServer, nPort, cFrom, xTo, xCC, xBCC, cBody, cSubject, ; hb_ADel( xTo, tmp, .T. ) ENDIF NEXT + IF Empty( xTo ) + RETURN .F. + ENDIF cTo := "" - cTmp := "" - IF Len( xTo ) > 1 - FOR EACH cTo IN xTo - IF cTo:__enumIndex() != 1 - cTmp += tip_GetRawEmail( AllTrim( cTo ) ) + "," - ENDIF - NEXT - cTmp := SubStr( cTmp, 1, Len( cTmp ) - 1 ) - ENDIF - cTo := tip_GetRawEmail( AllTrim( xTo[ 1 ] ) ) - IF Len( cTmp ) > 0 - cTo += "," + cTmp - ENDIF + FOR EACH cTmp IN xTo + cTo += tip_GetRawEmail( AllTrim( cTmp ) ) + IF ! cTmp:__enumIsLast() + cTo += "," + ENDIF + NEXT ELSEIF HB_ISSTRING( xTo ) cTo := tip_GetRawEmail( AllTrim( xTo ) ) ENDIF - // CC (Carbon Copy) IF HB_ISARRAY( xCC ) FOR tmp := Len( xCC ) TO 1 STEP -1 @@ -153,17 +145,16 @@ FUNCTION hb_SendMail( cServer, nPort, cFrom, xTo, xCC, xBCC, cBody, cSubject, ; ENDIF NEXT cCC := "" - IF Len( xCC ) > 0 - FOR EACH cTmp IN xCC - cCC += tip_GetRawEmail( AllTrim( cTmp ) ) + "," - NEXT - cCC := SubStr( cCC, 1, Len( cCC ) - 1 ) - ENDIF + FOR EACH cTmp IN xCC + cCC += tip_GetRawEmail( AllTrim( cTmp ) ) + IF ! cTmp:__enumIsLast() + cCC += "," + ENDIF + NEXT ELSEIF HB_ISSTRING( xCC ) cCC := tip_GetRawEmail( AllTrim( xCC ) ) ENDIF - // BCC (Blind Carbon Copy) IF HB_ISARRAY( xBCC ) FOR tmp := Len( xBCC ) TO 1 STEP -1 @@ -172,89 +163,71 @@ FUNCTION hb_SendMail( cServer, nPort, cFrom, xTo, xCC, xBCC, cBody, cSubject, ; ENDIF NEXT cBCC := "" - IF Len( xBCC ) > 0 - FOR EACH cTmp IN xBCC - cBCC += tip_GetRawEmail( AllTrim( cTmp ) ) + "," - NEXT - cBCC := SubStr( cBCC, 1, Len( cBCC ) - 1 ) - ENDIF + FOR EACH cTmp IN xBCC + cBCC += tip_GetRawEmail( AllTrim( cTmp ) ) + IF ! cTmp:__enumIsLast() + cBCC += "," + ENDIF + NEXT ELSEIF HB_ISSTRING( xBCC ) cBCC := tip_GetRawEmail( AllTrim( xBCC ) ) ENDIF cUser := StrTran( cUser, "@", "&at;" ) - IF cPopServer != NIL .AND. lPopAuth - BEGIN SEQUENCE + IF HB_ISSTRING( cPopServer ) .AND. lPopAuth + + BEGIN SEQUENCE WITH __BreakBlock() oUrl1 := TUrl():New( iif( lSSL, "pop3s://", "pop://" ) + cUser + ":" + cPass + "@" + cPopServer + "/" ) oUrl1:cUserid := StrTran( cUser, "&at;", "@" ) oPop := TIPClientPOP():New( oUrl1, xTrace ) - IF oPop:Open() - oPop:Close() - ELSE - lReturn := .F. - ENDIF RECOVER - lReturn := .F. + RETURN .F. END SEQUENCE + + IF oPop:Open() + oPop:Close() + ELSE + RETURN .F. + ENDIF ENDIF - IF ! lReturn - RETURN .F. - ENDIF - - BEGIN SEQUENCE + BEGIN SEQUENCE WITH __BreakBlock() oUrl := TUrl():New( iif( lSSL, "smtps://", "smtp://" ) + cUser + iif( Empty( cSMTPPass ), "", ":" + cSMTPPass ) + "@" + cServer ) RECOVER - lReturn := .F. - END SEQUENCE - - IF ! lReturn RETURN .F. - ENDIF + END SEQUENCE oUrl:nPort := nPort oUrl:cUserid := StrTran( cUser, "&at;", "@" ) oUrl:cFile := cTo + iif( Empty( cCC ), "", "," + cCC ) + iif( Empty( cBCC ), "", "," + cBCC ) - BEGIN SEQUENCE - oInmail := TIPClientSMTP():New( oUrl, xTrace, NIL, cClientHost ) + BEGIN SEQUENCE WITH __BreakBlock() + oInmail := TIPClientSMTP():New( oUrl, xTrace,, cClientHost ) RECOVER - lReturn := .F. - END SEQUENCE - - IF ! lReturn RETURN .F. - ENDIF + END SEQUENCE oInmail:nConnTimeout := nTimeOut - IF ! lNoAuth + IF ! lNoAuth .AND. oInMail:OpenSecure( , lSSL ) - IF oInMail:OpenSecure( NIL, lSSL) + lAuthTLS := oInMail:lTLS - lAuthTls := oInMail:lTLS - - IF oInMail:lAuthLogin - - IF ! oInMail:Auth( cUser, cSMTPPass ) - lConnect := .F. - ELSE - lConnectPlain := .T. - ENDIF - ENDIF - - IF oInMail:lAuthPlain .AND. ! lConnect - IF ! oInMail:AuthPlain( cUser, cSMTPPass ) - lConnect := .F. - ENDIF + IF oInMail:lAuthLogin + IF oInMail:Auth( cUser, cSMTPPass ) + lConnectPlain := .T. ELSE - IF ! lConnectPlain - lConnect := .F. - ENDIF + lConnect := .F. ENDIF - ELSE + ENDIF + + IF oInMail:lAuthPlain .AND. ! lConnect + IF ! oInMail:AuthPlain( cUser, cSMTPPass ) + lConnect := .F. + ENDIF + ELSEIF ! lConnectPlain lConnect := .F. ENDIF ELSE @@ -267,10 +240,10 @@ FUNCTION hb_SendMail( cServer, nPort, cFrom, xTo, xCC, xBCC, cBody, cSubject, ; oInMail:Close() ENDIF - BEGIN SEQUENCE - oInmail := TIPClientSMTP():New( oUrl, xTrace, NIL, cClientHost ) + BEGIN SEQUENCE WITH __BreakBlock() + oInmail := TIPClientSMTP():New( oUrl, xTrace,, cClientHost ) RECOVER - lReturn := .F. + RETURN .F. END SEQUENCE oInmail:nConnTimeout := nTimeOut @@ -287,11 +260,10 @@ FUNCTION hb_SendMail( cServer, nPort, cFrom, xTo, xCC, xBCC, cBody, cSubject, ; IF oInMail:cReply == NIL EXIT ENDIF - IF Left( oInMail:cReply, 4 ) == "250 " + IF hb_LeftEq( oInMail:cReply, "250 " ) EXIT ENDIF ENDDO - ENDIF oInMail:oUrl:cUserid := tip_GetRawEmail( cFrom ) @@ -300,355 +272,179 @@ FUNCTION hb_SendMail( cServer, nPort, cFrom, xTo, xCC, xBCC, cBody, cSubject, ; oInMail:Commit() oInMail:Close() - RETURN lReturn + RETURN .T. -FUNCTION hb_MailAssemble( cFrom, xTo, xCC, cBody, cSubject, ; - aFiles, nPriority, lRead, ; - cReplyTo, ; - cCharset, cEncoding ) - /* - cFrom -> Required. Email address of the sender - xTo -> Required. Character string or array of email addresses to send the email to - xCC -> Optional. Character string or array of email addresses for CC (Carbon Copy) - cBody -> Optional. The body message of the email as text, or the filename of the HTML message to send. - cSubject -> Optional. Subject of the sending email - aFiles -> Optional. Array of attachments to the email to send - nPriority -> Optional. Email priority: 1=High, 3=Normal (Standard), 5=Low - lRead -> Optional. If set to .T., a confirmation request is send. Standard setting is .F. - cReplyTo -> Optional. - */ +FUNCTION hb_MailAssemble( ; + cFrom, ; /* Required. Email address of the sender */ + xTo, ; /* Required. Character string or array of email addresses to send the email to */ + xCC, ; /* Optional. Character string or array of email addresses for CC (Carbon Copy) */ + cBody, ; /* Optional. The body message of the email as text, or the filename of the HTML message to send. */ + cSubject, ; /* Optional. Subject of the sending email */ + aFiles, ; /* Optional. Array of attachments to the email to send */ + nPriority, ; /* Optional. Email priority: 1=High, 3=Normal (Standard), 5=Low */ + lRead, ; /* Optional. If set to .T., a confirmation request is send. Standard setting is .F. */ + cReplyTo, ; /* Optional. */ + cCharset, ; /* Optional. */ + cEncoding ) /* Optional. */ - LOCAL cBodyTemp LOCAL oMail LOCAL oAttach LOCAL aThisFile - LOCAL cMimeText + LOCAL cMimeType LOCAL cFile - LOCAL cFname - LOCAL cFext LOCAL cData + LOCAL cContentType + LOCAL nAttr + LOCAL lBodyHTML + LOCAL cCharsetCP - hb_default( @aFiles, {} ) - hb_default( @nPriority, 3 ) - hb_default( @lRead, .F. ) - hb_default( @cReplyTo, "" ) - hb_default( @cCharset, "ISO-8859-1" ) - hb_default( @cEncoding, "quoted-printable" ) - - IF !( ( ".htm" $ Lower( cBody ) .OR. ".html" $ Lower( cBody ) ) .AND. hb_FileExists( cBody ) ) - IF !( Right( cBody, 2 ) == Chr( 13 ) + Chr( 10 ) ) - cBody += Chr( 13 ) + Chr( 10 ) - ENDIF + IF Empty( cFrom ) .OR. ! HB_ISSTRING( cFrom ) + RETURN .F. + ENDIF + IF Empty( xTo ) .OR. ( ! HB_ISSTRING( xTo ) .AND. ! HB_ISARRAY( xTo ) ) + RETURN .F. ENDIF - oMail := TIPMail():new() + hb_default( @cBody, "" ) + hb_default( @cSubject, "" ) + hb_default( @aFiles, {} ) + nPriority := Int( hb_defaultValue( nPriority, 3 ) ) + hb_default( @lRead, .F. ) + hb_default( @cReplyTo, "" ) + hb_default( @cCharset, "UTF-8" ) + hb_default( @cEncoding, "quoted-printable" ) + + /* Attempt to convert to selected charset if it's supported + by Harbour (and linked to app). */ + IF Upper( cCharset ) == "UTF-8" + cCharsetCP := "UTF8" + ELSEIF hb_cdpExists( Lower( cCharset ) ) + cCharsetCP := hb_cdpUniID( Lower( cCharset ) ) + ENDIF + + SWITCH Lower( hb_FNameExt( cBody ) ) + CASE ".htm" + CASE ".html" + IF hb_FileExists( cBody ) + cBody := MemoRead( cBody ) + lBodyHTML := .T. + EXIT + ENDIF + OTHERWISE + lBodyHTML := .F. + ENDSWITCH + + cContentType := iif( lBodyHTML, "text/html", "text/plain" ) + "; charset=" + cCharset + + /* add ending EOL to body, if there wasn't any */ + IF !( Right( cBody, 2 ) == Chr( 13 ) + Chr( 10 ) ) + cBody += Chr( 13 ) + Chr( 10 ) + ENDIF + + /* Convert input to the CP of the e-mail */ + IF ! Empty( cCharsetCP ) + xTo := s_TransCP( xTo, cCharsetCP ) + xCC := s_TransCP( xCC, cCharsetCP ) + cFrom := s_TransCP( cFrom, cCharsetCP ) + cBody := s_TransCP( cBody, cCharsetCP ) + cSubject := s_TransCP( cSubject, cCharsetCP ) + ENDIF + + oMail := TIPMail():New() oMail:SetEncoder( cEncoding ) oMail:SetCharset( cCharset ) + IF Empty( aFiles ) + oMail:hHeaders[ "Content-Type" ] := cContentType + oMail:SetBody( cBody ) + ELSE + oAttach := TIPMail():New() + oAttach:SetEncoder( cEncoding ) + oAttach:SetCharset( cCharset ) + oAttach:hHeaders[ "Content-Type" ] := cContentType + oAttach:SetBody( cBody ) + oMail:Attach( oAttach ) + + FOR EACH aThisFile IN aFiles + + cMimeType := NIL + nAttr := 0 + + IF HB_ISSTRING( aThisFile ) + cFile := aThisFile + cData := hb_MemoRead( cFile ) + hb_FGetAttr( cFile, @nAttr ) + ELSEIF HB_ISARRAY( aThisFile ) .AND. Len( aThisFile ) >= 2 + cFile := aThisFile[ 1 ] + IF HB_ISSTRING( aThisFile[ 2 ] ) + cData := aThisFile[ 2 ] + hb_default( @cFile, "unnamed" ) + ELSEIF HB_ISSTRING( cFile ) + cData := hb_MemoRead( cFile ) + hb_FGetAttr( cFile, @nAttr ) + ELSE + LOOP /* No filename and no content. */ + ENDIF + IF Len( aThisFile ) >= 3 .AND. HB_ISSTRING( aThisFile[ 3 ] ) + cMimeType := aThisFile[ 3 ] + ENDIF + ELSE + LOOP + ENDIF + + IF cMimeType == NIL + cMimeType := tip_FileNameMimeType( cFile, "application/octet-stream" ) + ENDIF + cFile := s_TransCP( cFile, cCharsetCP ) + + oAttach := TIPMail():New() + oAttach:SetCharset( cCharset ) + oAttach:SetEncoder( iif( hb_LeftEq( cMimeType, "text/" ), cEncoding, "base64" ) ) + + IF cMimeType == "text/html" + cMimeType += "; charset=" + cCharset + IF !( Right( cData, 2 ) == Chr( 13 ) + Chr( 10 ) ) + cData += Chr( 13 ) + Chr( 10 ) + ENDIF + ENDIF + // Some e-mail clients use Content-Type to check for filename + cMimeType += "; name=" + '"' + hb_FNameNameExt( cFile ) + '"' + IF ( nAttr := __tip_FAttrToUmask( nAttr ) ) != 0 + cMimeType += "; x-unix-mode=" + '"' + hb_NumToHex( nAttr, 4 ) + '"' + ENDIF + oAttach:hHeaders[ "Content-Type" ] := cMimeType + // Usually, original filename is set here + oAttach:hHeaders[ "Content-Disposition" ] := "attachment; filename=" + '"' + hb_FNameNameExt( cFile ) + '"' + oAttach:SetBody( cData ) + oMail:Attach( oAttach ) + NEXT + ENDIF + oMail:SetHeader( cSubject, cFrom, xTo, xCC ) oMail:hHeaders[ "Date" ] := tip_TimeStamp() IF ! Empty( cReplyTo ) oMail:hHeaders[ "Reply-to" ] := cReplyTo ENDIF - - IF ! Empty( aFiles ) - oAttach := TIPMail():new() - oAttach:SetEncoder( cEncoding ) - oAttach:SetCharset( cCharset ) - - IF ( ".htm" $ Lower( cBody ) .OR. ".html" $ Lower( cBody ) ) .AND. hb_FileExists( cBody ) - cMimeText := "text/html; charset=" + cCharset - oAttach:hHeaders[ "Content-Type" ] := cMimeText - cBodyTemp := cBody - cBody := MemoRead( cBodyTemp ) + Chr( 13 ) + Chr( 10 ) - ELSE - oAttach:hHeaders[ "Content-Type" ] := "text/plain; charset=" + cCharset - ENDIF - oAttach:SetBody( cBody ) - oMail:Attach( oAttach ) - ELSE - IF ( ".htm" $ Lower( cBody ) .OR. ".html" $ Lower( cBody ) ) .AND. hb_FileExists( cBody ) - cMimeText := "text/html ; charset=" + cCharset - oMail:hHeaders[ "Content-Type" ] := cMimeText - cBodyTemp := cBody - cBody := MemoRead( cBodyTemp ) + Chr( 13 ) + Chr( 10 ) - ELSE - oMail:hHeaders[ "Content-Type" ] := "text/plain; charset=" + cCharset - ENDIF - oMail:SetBody( cBody ) - ENDIF - - FOR EACH aThisFile IN aFiles - - IF HB_ISSTRING( aThisFile ) - cFile := aThisFile - cData := hb_MemoRead( cFile ) - ELSEIF HB_ISARRAY( aThisFile ) .AND. Len( aThisFile ) >= 2 - cFile := aThisFile[ 1 ] - IF HB_ISSTRING( aThisFile[ 2 ] ) - cData := aThisFile[ 2 ] - hb_default( @cFile, "unnamed" ) - ELSE - IF ! HB_ISSTRING( cFile ) - LOOP /* No filename and no content. */ - ELSE - cData := hb_MemoRead( cFile ) - ENDIF - ENDIF - ELSE - LOOP - ENDIF - - cData += Chr( 13 ) + Chr( 10 ) - - oAttach := TIPMail():New() - oAttach:SetCharset( cCharset ) - - hb_FNameSplit( cFile,, @cFname, @cFext ) - cFile := Lower( cFile ) - - IF ( cFile LIKE ".+\.(vbd|asn|asz|asd|pqi|tsp|exe|sml|ofml)" ) .OR. ; - ( cFile LIKE ".+\.(pfr|frl|spl|gz||stk|ips|ptlk|hqx|mbd)" ) .OR. ; - ( cFile LIKE ".+\.(mfp|pot|pps|ppt|ppz|doc|n2p|bin|class)" ) .OR. ; - ( cFile LIKE ".+\.(lha|lzh|lzx|dbf|cdx|dbt|fpt|ntx|oda)" ) .OR. ; - ( cFile LIKE ".+\.(axs|zpa|pdf|ai|eps|ps|shw|qrt|rtc|rtf)" ) .OR. ; - ( cFile LIKE ".+\.(smp|dst|talk|tbk|vmd|vmf|wri|wid|rrf)" ) .OR. ; - ( cFile LIKE ".+\.(wis|ins|tmv|arj|asp|aabaam|aas|bcpio)" ) .OR. ; - ( cFile LIKE ".+\.(vcd|chat|cnc|coda|page|z|con|cpio|pqf)" ) .OR. ; - ( cFile LIKE ".+\.(csh|cu|csm|dcr|dir|dxr|swa|dvi|evy|ebk)" ) .OR. ; - ( cFile LIKE ".+\.(gtar|hdf|map|phtml|php3|ica|ipx|ips|js)" ) .OR. ; - ( cFile LIKE ".+\.(latex|bin|mif|mpl|mpire|adr|wlt|nc|cdf)" ) .OR. ; - ( cFile LIKE ".+\.(npx|nsc|pgp|css|sh||shar|swf|spr|sprite)" ) .OR. ; - ( cFile LIKE ".+\.(sit|sca|sv4cpio|sv4crc|tar|tcl|tex)" ) .OR. ; - ( cFile LIKE ".+\.(texinfo|texi|tlk|t|tr|roff|man|mems)" ) .OR. ; - ( cFile LIKE ".+\.(alt|che|ustar|src|xls|xlt|zip|au|snd)" ) .OR. ; - ( cFile LIKE ".+\.(es|gsm|gsd|rmf|tsi|vox|wtx|aif|aiff)" ) .OR. ; - ( cFile LIKE ".+\.(aifc|cht|dus|mid|midi|mp3|mp2|m3u|ram)" ) .OR. ; - ( cFile LIKE ".+\.(ra|rpm|stream|rmf|vqf|vql|vqe|wav|wtx)" ) .OR. ; - ( cFile LIKE ".+\.(mol|pdb|dwf|ivr|cod|cpi|fif|gif|ief)" ) .OR. ; - ( cFile LIKE ".+\.(jpeg|jpg|jpe|rip|svh|tiff|tif|mcf|svf)" ) .OR. ; - ( cFile LIKE ".+\.(dwg|dxf|wi|ras|etf|fpx|fh5|fh4|fhc|dsf)" ) .OR. ; - ( cFile LIKE ".+\.(pnm|pbm|pgm|ppm|rgb|xbm|xpm|xwd|dig)" ) .OR. ; - ( cFile LIKE ".+\.(push|wan|waf||afl|mpeg|mpg|mpe|qt|mov)" ) .OR. ; - ( cFile LIKE ".+\.(viv|vivo|asf|asx|avi|movie|vgm|vgx)" ) .OR. ; - ( cFile LIKE ".+\.(xdr|vgp|vts|vtts|3dmf|3dm|qd3d|qd3)" ) .OR. ; - ( cFile LIKE ".+\.(svr|wrl|wrz|vrt|xml)" ) .OR. Empty( cFExt ) - oAttach:SetEncoder( "base64" ) - ELSE - oAttach:SetEncoder( cEncoding ) - ENDIF - - cMimeText := hb_SetMimeType( cFile, cFname, cFext ) - // Some EMAIL readers use Content-Type to check for filename - - IF ".html" $ Lower( cFext ) .OR. ".htm" $ Lower( cFext ) - cMimeText += "; charset=" + cCharset - ENDIF - - oAttach:hHeaders[ "Content-Type" ] := cMimeText - // But usually, original filename is set here - oAttach:hHeaders[ "Content-Disposition" ] := "attachment; filename=" + '"' + cFname + cFext + '"' - oAttach:SetBody( cData ) - oMail:Attach( oAttach ) - NEXT - IF lRead oMail:hHeaders[ "Disposition-Notification-To" ] := tip_GetRawEmail( cFrom ) ENDIF - IF nPriority != 3 - oMail:hHeaders[ "X-Priority" ] := Str( nPriority, 1 ) + oMail:hHeaders[ "X-Priority" ] := hb_ntos( nPriority ) ENDIF RETURN oMail:ToString() -FUNCTION hb_SetMimeType( cFile, cFname, cFext ) +STATIC FUNCTION s_TransCP( xData, cCP ) - cFile := Lower( cFile ) + LOCAL tmp - DO CASE - CASE ( cFile LIKE ".+\.vbd" ); RETURN "application/activexdocument; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.(asn|asz|asd)" ); RETURN "application/astound; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.pqi" ); RETURN "application/cprplayer; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.tsp" ); RETURN "application/dsptype; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.exe" ); RETURN "application/exe; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.(sml|ofml)" ); RETURN "application/fml; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.pfr" ); RETURN "application/font-tdpfr; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.frl" ); RETURN "application/freeloader; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.spl" ); RETURN "application/futuresplash; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.gz" ); RETURN "application/gzip; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.stk" ); RETURN "application/hstu; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.ips" ); RETURN "application/ips; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.ptlk" ); RETURN "application/listenup; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.hqx" ); RETURN "application/mac-binhex40; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.mbd" ); RETURN "application/mbedlet; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.mfp" ); RETURN "application/mirage; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.(pot|pps|ppt|ppz)" ); RETURN "application/mspowerpoint; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.doc" ); RETURN "application/msword; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.n2p" ); RETURN "application/n2p; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.(bin|class|lha|lzh|lzx|dbf)" ); RETURN "application/octet-stream; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.oda" ); RETURN "application/oda; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.axs" ); RETURN "application/olescript; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.zpa" ); RETURN "application/pcphoto; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.pdf" ); RETURN "application/pdf; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.(ai|eps|ps)" ); RETURN "application/postscript; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.shw" ); RETURN "application/presentations; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.qrt" ); RETURN "application/quest; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.rtc" ); RETURN "application/rtc; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.rtf" ); RETURN "application/rtf; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.smp" ); RETURN "application/studiom; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.dst" ); RETURN "application/tajima; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.talk" ); RETURN "application/talker; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.tbk" ); RETURN "application/toolbook; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.vmd" ); RETURN "application/vocaltec-media-desc; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.vmf" ); RETURN "application/vocaltec-media-file; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.wri" ); RETURN "application/write; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.wid" ); RETURN "application/x-DemoShield; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.rrf" ); RETURN "application/x-InstallFromTheWeb; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.wis" ); RETURN "application/x-InstallShield; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.ins" ); RETURN "application/x-NET-Install; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.tmv" ); RETURN "application/x-Parable-Thing; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.arj" ); RETURN "application/x-arj; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.asp" ); RETURN "application/x-asap; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.aab" ); RETURN "application/x-authorware-bin; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.(aam|aas)" ); RETURN "application/x-authorware-map; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.bcpio" ); RETURN "application/x-bcpio; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.vcd" ); RETURN "application/x-cdlink; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.chat" ); RETURN "application/x-chat; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.cnc" ); RETURN "application/x-cnc; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.(coda|page)" ); RETURN "application/x-coda; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.z" ); RETURN "application/x-compress; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.con" ); RETURN "application/x-connector; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.cpio" ); RETURN "application/x-cpio; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.pqf" ); RETURN "application/x-cprplayer; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.csh" ); RETURN "application/x-csh; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.(cu|csm)" ); RETURN "application/x-cu-seeme; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.(dcr|dir|dxr|swa)" ); RETURN "application/x-director; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.dvi" ); RETURN "application/x-dvi; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.evy" ); RETURN "application/x-envoy; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.ebk" ); RETURN "application/x-expandedbook; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.gtar" ); RETURN "application/x-gtar; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.hdf" ); RETURN "application/x-hdf; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.map" ); RETURN "application/x-httpd-imap; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.phtml" ); RETURN "application/x-httpd-php; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.php3" ); RETURN "application/x-httpd-php3; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.ica" ); RETURN "application/x-ica; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.ipx" ); RETURN "application/x-ipix; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.ips" ); RETURN "application/x-ipscript; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.js" ); RETURN "application/x-javascript; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.latex" ); RETURN "application/x-latex; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.bin" ); RETURN "application/x-macbinary; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.mif" ); RETURN "application/x-mif; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.(mpl|mpire)" ); RETURN "application/x-mpire; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.adr" ); RETURN "application/x-msaddr; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.wlt" ); RETURN "application/x-mswallet; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.(nc|cdf)" ); RETURN "application/x-netcdf; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.npx" ); RETURN "application/x-netfpx; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.nsc" ); RETURN "application/x-nschat; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.pgp" ); RETURN "application/x-pgp-plugin; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.css" ); RETURN "application/x-pointplus; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.sh" ); RETURN "application/x-sh; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.shar" ); RETURN "application/x-shar; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.swf" ); RETURN "application/x-shockwave-flash; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.spr" ); RETURN "application/x-sprite; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.sprite" ); RETURN "application/x-sprite; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.sit" ); RETURN "application/x-stuffit; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.sca" ); RETURN "application/x-supercard; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.sv4cpio" ); RETURN "application/x-sv4cpio; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.sv4crc" ); RETURN "application/x-sv4crc; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.tar" ); RETURN "application/x-tar; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.tcl" ); RETURN "application/x-tcl; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.tex" ); RETURN "application/x-tex; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.(texinfo|texi)" ); RETURN "application/x-texinfo; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.tlk" ); RETURN "application/x-tlk; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.(t|tr|roff)" ); RETURN "application/x-troff; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.man" ); RETURN "application/x-troff-man; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.me" ); RETURN "application/x-troff-me; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.ms" ); RETURN "application/x-troff-ms; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.alt" ); RETURN "application/x-up-alert; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.che" ); RETURN "application/x-up-cacheop; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.ustar" ); RETURN "application/x-ustar; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.src" ); RETURN "application/x-wais-source; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.xls" ); RETURN "application/xls; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.xlt" ); RETURN "application/xlt; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.zip" ); RETURN "application/zip; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.(au|snd)" ); RETURN "audio/basic; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.es" ); RETURN "audio/echospeech; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.(gsm|gsd)" ); RETURN "audio/gsm; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.rmf" ); RETURN "audio/rmf; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.tsi" ); RETURN "audio/tsplayer; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.vox" ); RETURN "audio/voxware; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.wtx" ); RETURN "audio/wtx; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.(aif|aiff|aifc)" ); RETURN "audio/x-aiff; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.(cht|dus)" ); RETURN "audio/x-dspeech; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.(mid|midi)" ); RETURN "audio/x-midi; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.mp3" ); RETURN "audio/x-mpeg; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.mp2" ); RETURN "audio/x-mpeg; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.m3u" ); RETURN "audio/x-mpegurl; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.(ram|ra)" ); RETURN "audio/x-pn-realaudio; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.rpm" ); RETURN "audio/x-pn-realaudio-plugin; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.stream" ); RETURN "audio/x-qt-stream; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.rmf" ); RETURN "audio/x-rmf; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.(vqf|vql)" ); RETURN "audio/x-twinvq; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.vqe" ); RETURN "audio/x-twinvq-plugin; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.wav" ); RETURN "audio/x-wav; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.wtx" ); RETURN "audio/x-wtx; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.mol" ); RETURN "chemical/x-mdl-molfile; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.pdb" ); RETURN "chemical/x-pdb; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.dwf" ); RETURN "drawing/x-dwf; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.ivr" ); RETURN "i-world/i-vrml; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.cod" ); RETURN "image/cis-cod; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.cpi" ); RETURN "image/cpi; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.fif" ); RETURN "image/fif; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.gif" ); RETURN "image/gif; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.ief" ); RETURN "image/ief; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.(jpeg|jpg|jpe)" ); RETURN "image/jpeg; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.rip" ); RETURN "image/rip; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.svh" ); RETURN "image/svh; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.(tiff|tif)" ); RETURN "image/tiff; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.mcf" ); RETURN "image/vasa; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.(svf|dwg|dxf)" ); RETURN "image/vnd; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.wi" ); RETURN "image/wavelet; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.ras" ); RETURN "image/x-cmu-raster; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.etf" ); RETURN "image/x-etf; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.fpx" ); RETURN "image/x-fpx; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.(fh5|fh4|fhc)" ); RETURN "image/x-freehand; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.dsf" ); RETURN "image/x-mgx-dsf; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.pnm" ); RETURN "image/x-portable-anymap; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.pbm" ); RETURN "image/x-portable-bitmap; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.pgm" ); RETURN "image/x-portable-graymap; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.ppm" ); RETURN "image/x-portable-pixmap; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.rgb" ); RETURN "image/x-rgb; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.xbm" ); RETURN "image/x-xbitmap; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.xpm" ); RETURN "image/x-xpixmap; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.xwd" ); RETURN "image/x-xwindowdump; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.dig" ); RETURN "multipart/mixed; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.push" ); RETURN "multipart/x-mixed-replace; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.(wan|waf)" ); RETURN "plugin/wanimate; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.ccs" ); RETURN "text/ccs; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.(htm|html)" ); RETURN "text/html; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.pgr" ); RETURN "text/parsnegar-document; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.xml" ); RETURN "text/xml; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.txt" ); RETURN "text/plain; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.rtx" ); RETURN "text/richtext; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.tsv" ); RETURN "text/tab-separated-values; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.hdml" ); RETURN "text/x-hdml; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.etx" ); RETURN "text/x-setext; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.(talk|spc)" ); RETURN "text/x-speech; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.afl" ); RETURN "video/animaflex; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.(mpeg|mpg|mpe)" ); RETURN "video/mpeg; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.(qt|mov)" ); RETURN "video/quicktime; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.(viv|vivo)" ); RETURN "video/vnd.vivo; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.(asf|asx)" ); RETURN "video/x-ms-asf; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.avi" ); RETURN "video/x-msvideo; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.movie" ); RETURN "video/x-sgi-movie; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.(vgm|vgx|xdr)" ); RETURN "video/x-videogram; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.vgp" ); RETURN "video/x-videogram-plugin; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.vts" ); RETURN "workbook/formulaone; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.vtts" ); RETURN "workbook/formulaone; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.(3dmf|3dm|qd3d|qd3)" ); RETURN "x-world/x-3dmf; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.svr" ); RETURN "x-world/x-svr; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.(wrl|wrz)" ); RETURN "x-world/x-vrml; name=" + cFname + cFext - CASE ( cFile LIKE ".+\.vrt" ); RETURN "x-world/x-vrt; name=" + cFname + cFext - ENDCASE + IF ! Empty( cCP ) + IF HB_ISSTRING( xData ) + RETURN hb_Translate( xData,, cCP ) + ELSEIF HB_ISARRAY( xData ) + FOR EACH tmp IN xData + tmp := hb_Translate( tmp,, cCP ) + NEXT + ENDIF + ENDIF - RETURN "text/plain; name=" + cFname + cFext + RETURN xData diff --git a/doc/xhb-diff.txt b/doc/xhb-diff.txt index cabeafc360..31c1940a3b 100644 --- a/doc/xhb-diff.txt +++ b/doc/xhb-diff.txt @@ -551,14 +551,14 @@ generate runtime error Error BASE/1002 Alias does not exist: TABLE for the second QOUT() call. It means that it correctly recognized scope of both variables and also bound alias TABLE with field F though it was -declared two lines below codeblock initialization. +declared one line below codeblock initialization. In fact Clipper probably does not make two passes but parsing declarations which have to be at the beginning of function or module it stores names of variables which should be initialized with the initialization expressions. Then when all declarations are processed for each line with declared and initialized variables it generates code which pushes on VM stack results -of initialization expressions and then code which pops it initializing +of initialization expressions and then code which pops them initializing variables. As result in Clipper this code cannot work: local x := 10, y := x + 2 because Clipper generate PCODE like: @@ -602,13 +602,14 @@ initialization expressions but then it generates slightly different code initializing variables one by one without line groping like in Clipper. Please also note that in Clipper PRIVATE and PUBLIC declarations are -executable statements so they are not used used as declarations by +executable statements so they are not used as declarations by Clipper compiler even if -a compiler switch is used. So when we talk about initialization then it means that we are talking about LOCAL variables. STATIC variables are initialized in different way at -application startup so cannot use local variables though due to but -in Clipper in some cases compiler can accept local variables and then -it may cause VM crash or runtime error, i.e. this code: +application startup so cannot use local variables as initializers though +due to bug in Clipper in some cases compiler can accept local variables +in such context and then it may cause VM crash or error at runtime, +i.e. this code: proc main() local n